Planeten- bzw. Massepunktsimulation, Gravitationssimulation

Übersicht

BlitzBasic

Codearchiv

	Hawkins Betreff: Planeten- bzw. Massepunktsimulation, Gravitationssimulation	Mi, Feb 20, 2008 21:46 Antworten mit Zitat
Hmm als ich die KometenSimulation https://www.blitzforum.de/foru...hp?t=16457 sah, dachte ich, das ist ja meinem Programm nicht unähnlich udn koennte auch für andere Interessant sein: Allerdings in der Funktion "Bounce" ist noch kein richtiges Ergebnis zu erwarten. Ich bekomme einfach keine Abprallfunktion hin. Code: [AUSKLAPPEN] [EINKLAPPEN] AppTitle "Massparticle Simulator" Const width=800,height=600 Graphics width,height,16,2 SetBuffer BackBuffer() SeedRnd MilliSecs() EndMsg$ = "Escape to Quit, H for Helpmenu " Global scale# = 0.5,xoffset=0,yoffset=0 Global help = 0 Global xmasstotal=0, ymasstotal=0, xpulstotal=0, ypulstotal=0,masstotal=0 Global red=255,green=255,blue=255,newmass = 50 Global colorcycle Type Masspoint Field x#=0,y#=0,vx#=0,vy#=0,mass=10,r=255,g=255,b=255,status = 0 End Type ;Status 1 = fixed;2 = can't absorb Initmass() While Not KeyDown(1) Cls Control() Update() Visualize() Color $FF,$FF,$FF If help=1 Then showhelp() Text width-StringWidth(EndMsg$),height-StringHeight(EndMsg$), EndMsg$ Text 16,height-15,"Mass: " + newmass Oval 2,height-14,12,12,1 Color red,green,blue Oval 3,height-13,10,10,1 ;Delay 100 Flip Wend End Function Showhelp() Local y=100 Text 100,y," num + Zoom in":y=y+StringHeight("I")+5 Text 100,y," num - Zoom out":y=y+StringHeight("I")+5 Text 100,y," up Scroll Up":y=y+StringHeight("I")+5 Text 100,y," down Scroll Down":y=y+StringHeight("I")+5 Text 100,y," left Scroll Left":y=y+StringHeight("I")+5 Text 100,y," right Scroll Right":y=y+StringHeight("I")+5 Text 100,y," pos1 Center Scroll":y=y+StringHeight("I")+5 Text 100,y," H Toggle Help":y=y+StringHeight("I")+5 Text 100,y," Space Restart":y=y+StringHeight("I")+5 Text 100,y," Enter Add Masspoints":y=y+StringHeight("I")+5 Text 100,y," BackSpace Delete all Masspoints":y=y+StringHeight("I")+5 Text 100,y," Q Create simple Sunsystem (for debug)":y=y+StringHeight("I")+5 Text 100,y,"Mousebutton 1 Set Masspoints":y=y+StringHeight("I")+5 Text 100,y,"Mousebutton 2 Change Masspointcolor":y=y+StringHeight("I")+5 Text 100,y,"Mousebutton 3 Set Virtual-Masspoint":y=y+StringHeight("I")+5 Text 100,y," , - Mass ":y=y+StringHeight("I")+5 Text 100,y," . + Mass ":y=y+StringHeight("I")+5 Text 100,y," A Calibrate Inertial-System ":y=y+StringHeight("I")+5 me$="by M. Schuster (hallegang@gmx.de)" Text width-StringWidth(me$)-5,height-StringHeight(me$)2-5,me$ End Function Function Control() If KeyHit(57) Then :Delete Each masspoint:Initmass():End If ; Space -> Neu Initialisierung If KeyHit(28) Then Initmass() ; neue Massepunkte If KeyDown(74) Then scale# = scale#/1.0499 ;Minus Zoom Out If KeyDown(78) Then scale# = scale#1.05 ;Plus Zoom In If KeyDown(200) Then yoffset = yoffset + 10/scale# If KeyDown(208) Then yoffset = yoffset - 10/scale# If KeyDown(203) Then xoffset = xoffset + 10/scale# If KeyDown(205) Then xoffset = xoffset - 10/scale# If KeyHit(199) Then xoffset=0:yoffset=0:scale=0.5:ResetInertial() If KeyHit(35) Then help = 1-help If KeyHit(14) Then Delete Each masspoint If KeyHit(16) Then Debuginit() If KeyHit(30) Then ResetInertial() If MouseHit(2) Then nextcolor() If MouseDown(1) Then createmasspoint() If MouseHit(3) Then createmasspoint(3) If KeyDown(51) And newmass >= 100 Then newmass=newmass/1.009 If KeyDown(52) And Newmass >= 100 Then newmass=newmass1.01 If KeyDown(51) And newmass < 100 Then newmass=newmass-1 If KeyDown(52) And Newmass < 100 Then newmass=newmass+1 If newmass<=0 Then newmass=1 End Function Function ResetInertial() For m.masspoint = Each masspoint m\vx# = m\vx# - xpulstotal/masstotal m\vy# = m\vy# - ypulstotal/masstotal m\x# = m\x# - xmasstotal/masstotal m\y# = m\y# - xmasstotal/masstotal Next End Function Function nextcolor() colorcycle = (colorcycle + 1) Mod 8 Select colorcycle Case 0:red=0:green=0:blue=0 Case 1:red=255:green=0:blue=0 Case 2:red=255:green=255:blue=0 Case 3:red=0:green=255:blue=0 Case 4:red=0:green=255:blue=255 Case 5:red=0:green=0:blue=255 Case 6:red=255:green=0:blue=255 Case 7:red=255:green=255:blue=255 End Select End Function Function createmasspoint(stat = 0) mass.masspoint=New masspoint mass\x#= (MouseX()-width/2)/scale# - xoffset mass\y#= (MouseY()-height/2)/scale# - yoffset mass\mass=newmass mass\r=red mass\g=green mass\b=blue mass\status = stat End Function Function Debuginit() mass.masspoint=New masspoint mass\mass=5000 mass\r=255 mass\g=240 mass\b=64 mass.masspoint=New masspoint mass\y#= -50 mass\vx#=10 mass\mass#=5 mass\r=255 mass\g=0 mass\b=0 mass.masspoint=New masspoint mass\y#= -100 mass\vx#=7 mass\mass=100 mass\r=255 mass\g=127 mass\b=127 mass.masspoint=New masspoint mass\y#= 420 mass\vx#=-3 mass\mass=470 mass\r=0 mass\g=255 mass\b=255 mass.masspoint=New masspoint mass\y#= 450 mass\vx#=-6.8 mass\mass=30 mass\r=255 mass\g=255 mass\b=255 End Function Function Initmass() For i = 0 To 100 mass.masspoint=New masspoint radius# = Rnd(1,1000) angle# = Rnd(0,360) mass\x#= radius#Sin(angle#) mass\y#= radius#Cos(angle#) mass\vx#=-Cos(angle#)+Rnd(-3,3) mass\vy#=Sin(angle#) +Rnd(-3,3) mass\mass=Rnd(5,100) mass\r=Rnd(0,255) mass\g=Rnd(0,255) mass\b=Rnd(0,255) Next End Function Function Update() xmasstotal=0:ymasstotal=0 xpulstotal=0:ypulstotal=0 masstotal=0 For m1.masspoint = Each masspoint If Not(m1\status And 1) Then m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy# radius1# = Sqr(m1\mass/Pi) For m2.masspoint = Each masspoint If m1<>m2 Then dx# = m2\x#-m1\x#:dy# = m2\y#-m1\y# radius2# = Sqr(m2\mass/Pi) distance# = (dx#)^2 + (dy#)^2 angle#=ATan2(dy#,dx#) If Sqr(distance#) < (radius1#+radius2#) Then If (m1\status Or m2\status)And 2 Then f# = (m1\massm2\mass#)Sqr(distance#)/(radius1#+radius2#)^3 Else fusion(m1,m2) End If Else f# = (m1\massm2\mass#)/(distance#) End If fx# = f# * Cos(angle#):fy#=f#Sin(angle#) m1\vx# = m1\vx# + fx#/m1\mass:m1\vy# = m1\vy# + fy#/m1\mass End If Next xmasstotal=xmasstotal + m1\x#m1\mass:ymasstotal=ymasstotal + m1\y#m1\mass xpulstotal=xpulstotal + m1\vx#m1\mass:ypulstotal=ypulstotal + m1\vy#m1\mass masstotal=masstotal+m1\mass Next End Function Function Bounce(m1.masspoint, m2.masspoint);-------------------------------------------------------------------- angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#) radius1# = Sqr(m1\mass/Pi):radius2# = Sqr(m2\mass/Pi) distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2) m1\x#=m1\x#-m1\vx#:m1\y#=m1\y#-m1\vy# ;hier Routine rein m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy# End Function Function Fusion(m1.masspoint, m2.masspoint) m1\vx#=(m1\vx# m1\mass + m2\vx# * m2\mass)/(m1\mass + m2\mass) m1\vy#=(m1\vy# * m1\mass + m2\vy# * m2\mass)/(m1\mass + m2\mass) m1\x# = m1\x# + (m2\x#-m1\x#)m2\mass/(m1\mass+m2\mass) m1\y# = m1\y# + (m2\y#-m1\y#)m2\mass/(m1\mass+m2\mass) m1\r= (m1\rm1\mass + m2\rm2\mass)/(m1\mass + m2\mass) m1\g= (m1\gm1\mass + m2\gm2\mass)/(m1\mass + m2\mass) m1\b= (m1\bm1\mass + m2\bm2\mass)/(m1\mass + m2\mass) m1\mass=m1\mass+m2\mass m1\status = m1\status Or m2\status Delete m2 End Function Function Visualize() For mass.masspoint = Each masspoint size= Sqr(mass\mass/Pi)scale#:If size < 1 Then size = 1 xscreen=width/2 + (xoffset + mass\x#)scale# yscreen=height/2 + (yoffset + mass\y#)scale# Color mass\r, mass\g, mass\b Oval xscreen-size,yscreen-size,size2,size2,1 Color 255,255,255 If (mass\status And 2) Then Oval xscreen-size,yscreen-size,size2,size*2,0 Next End Function Vielleicht kann da jemand helfen.

Hawkins

Betreff: Planeten- bzw. Massepunktsimulation, Gravitationssimulation

Mi, Feb 20, 2008 21:46
Antworten mit Zitat

Hmm als ich die KometenSimulation https://www.blitzforum.de/foru...hp?t=16457 sah, dachte ich, das ist ja meinem Programm nicht unähnlich udn koennte auch für andere Interessant sein:
Allerdings in der Funktion "Bounce" ist noch kein richtiges Ergebnis zu erwarten. Ich bekomme einfach keine Abprallfunktion hin.

Code: [AUSKLAPPEN]

AppTitle "Massparticle Simulator"
Const width=800,height=600
Graphics width,height,16,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
EndMsg$ = "Escape to Quit, H for Helpmenu "
Global scale# = 0.5,xoffset=0,yoffset=0
Global help = 0
Global xmasstotal=0, ymasstotal=0, xpulstotal=0, ypulstotal=0,masstotal=0
Global red=255,green=255,blue=255,newmass = 50
Global colorcycle

Type Masspoint
Field x#=0,y#=0,vx#=0,vy#=0,mass=10,r=255,g=255,b=255,status = 0
End Type
;Status 1 = fixed;2 = can't absorb

Initmass()
While Not KeyDown(1)
Cls
Control()
Update()
Visualize()
Color $FF,$FF,$FF
If help=1 Then showhelp()
Text width-StringWidth(EndMsg$),height-StringHeight(EndMsg$), EndMsg$
Text 16,height-15,"Mass: " + newmass
Oval 2,height-14,12,12,1
Color red,green,blue
Oval 3,height-13,10,10,1
;Delay 100
Flip
Wend
End

Function Showhelp()
Local y=100
Text 100,y," num + Zoom in":y=y+StringHeight("I")+5
Text 100,y," num - Zoom out":y=y+StringHeight("I")+5
Text 100,y," up Scroll Up":y=y+StringHeight("I")+5
Text 100,y," down Scroll Down":y=y+StringHeight("I")+5
Text 100,y," left Scroll Left":y=y+StringHeight("I")+5
Text 100,y," right Scroll Right":y=y+StringHeight("I")+5
Text 100,y," pos1 Center Scroll":y=y+StringHeight("I")+5
Text 100,y," H Toggle Help":y=y+StringHeight("I")+5
Text 100,y," Space Restart":y=y+StringHeight("I")+5
Text 100,y," Enter Add Masspoints":y=y+StringHeight("I")+5
Text 100,y," BackSpace Delete all Masspoints":y=y+StringHeight("I")+5
Text 100,y," Q Create simple Sunsystem (for debug)":y=y+StringHeight("I")+5
Text 100,y,"Mousebutton 1 Set Masspoints":y=y+StringHeight("I")+5
Text 100,y,"Mousebutton 2 Change Masspointcolor":y=y+StringHeight("I")+5
Text 100,y,"Mousebutton 3 Set Virtual-Masspoint":y=y+StringHeight("I")+5
Text 100,y," , - Mass ":y=y+StringHeight("I")+5
Text 100,y," . + Mass ":y=y+StringHeight("I")+5
Text 100,y," A Calibrate Inertial-System ":y=y+StringHeight("I")+5
me$="by M. Schuster (hallegang@gmx.de)"
Text width-StringWidth(me$)-5,height-StringHeight(me$)*2-5,me$
End Function

Function Control()
If KeyHit(57) Then :Delete Each masspoint:Initmass():End If ; Space -> Neu Initialisierung
If KeyHit(28) Then Initmass() ; neue Massepunkte
If KeyDown(74) Then scale# = scale#/1.0499 ;Minus Zoom Out
If KeyDown(78) Then scale# = scale#*1.05 ;Plus Zoom In
If KeyDown(200) Then yoffset = yoffset + 10/scale#
If KeyDown(208) Then yoffset = yoffset - 10/scale#
If KeyDown(203) Then xoffset = xoffset + 10/scale#
If KeyDown(205) Then xoffset = xoffset - 10/scale#
If KeyHit(199) Then xoffset=0:yoffset=0:scale=0.5:ResetInertial()
If KeyHit(35) Then help = 1-help
If KeyHit(14) Then Delete Each masspoint
If KeyHit(16) Then Debuginit()
If KeyHit(30) Then ResetInertial()
If MouseHit(2) Then nextcolor()
If MouseDown(1) Then createmasspoint()
If MouseHit(3) Then createmasspoint(3)
If KeyDown(51) And newmass >= 100 Then newmass=newmass/1.009
If KeyDown(52) And Newmass >= 100 Then newmass=newmass*1.01
If KeyDown(51) And newmass < 100 Then newmass=newmass-1
If KeyDown(52) And Newmass < 100 Then newmass=newmass+1
If newmass<=0 Then newmass=1
End Function

Function ResetInertial()
For m.masspoint = Each masspoint
   m\vx# = m\vx# - xpulstotal/masstotal
   m\vy# = m\vy# - ypulstotal/masstotal
   m\x# = m\x# - xmasstotal/masstotal
   m\y# = m\y# - xmasstotal/masstotal
Next
End Function

Function nextcolor()
colorcycle = (colorcycle + 1) Mod 8
Select colorcycle
   Case 0:red=0:green=0:blue=0
   Case 1:red=255:green=0:blue=0
   Case 2:red=255:green=255:blue=0
   Case 3:red=0:green=255:blue=0
   Case 4:red=0:green=255:blue=255
   Case 5:red=0:green=0:blue=255
   Case 6:red=255:green=0:blue=255
   Case 7:red=255:green=255:blue=255
   End Select
End Function

Function createmasspoint(stat = 0)
mass.masspoint=New masspoint
mass\x#= (MouseX()-width/2)/scale# - xoffset
mass\y#= (MouseY()-height/2)/scale# - yoffset
mass\mass=newmass
mass\r=red
mass\g=green
mass\b=blue
mass\status = stat
End Function

Function Debuginit()
mass.masspoint=New masspoint
mass\mass=5000
mass\r=255
mass\g=240
mass\b=64

mass.masspoint=New masspoint
mass\y#= -50
mass\vx#=10
mass\mass#=5
mass\r=255
mass\g=0
mass\b=0

mass.masspoint=New masspoint
mass\y#= -100
mass\vx#=7
mass\mass=100
mass\r=255
mass\g=127
mass\b=127

mass.masspoint=New masspoint
mass\y#= 420
mass\vx#=-3
mass\mass=470
mass\r=0
mass\g=255
mass\b=255

mass.masspoint=New masspoint
mass\y#= 450
mass\vx#=-6.8
mass\mass=30
mass\r=255
mass\g=255
mass\b=255
End Function

Function Initmass()
For i = 0 To 100
   mass.masspoint=New masspoint
   radius# = Rnd(1,1000)
   angle# = Rnd(0,360)
   mass\x#= radius#*Sin(angle#)
   mass\y#= radius#*Cos(angle#)
   mass\vx#=-Cos(angle#)+Rnd(-3,3)
   mass\vy#=Sin(angle#) +Rnd(-3,3)
   mass\mass=Rnd(5,100)
   mass\r=Rnd(0,255)
   mass\g=Rnd(0,255)
   mass\b=Rnd(0,255)
Next
End Function

Function Update()
xmasstotal=0:ymasstotal=0
xpulstotal=0:ypulstotal=0
masstotal=0
For m1.masspoint = Each masspoint
   If Not(m1\status And 1) Then m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy#
   radius1# = Sqr(m1\mass/Pi)
   For m2.masspoint = Each masspoint
      If m1<>m2 Then
         dx# = m2\x#-m1\x#:dy# = m2\y#-m1\y#
         radius2# = Sqr(m2\mass/Pi)
         distance# = (dx#)^2 + (dy#)^2
         angle#=ATan2(dy#,dx#)
         If Sqr(distance#) < (radius1#+radius2#) Then
            If (m1\status Or m2\status)And 2 Then
               f# = (m1\mass*m2\mass#)*Sqr(distance#)/(radius1#+radius2#)^3
         Else
               fusion(m1,m2)

            End If
         Else
            f# = (m1\mass*m2\mass#)/(distance#)
         End If
         fx# = f# * Cos(angle#):fy#=f#*Sin(angle#)
         m1\vx# = m1\vx# + fx#/m1\mass:m1\vy# = m1\vy# + fy#/m1\mass
      End If
   Next
   xmasstotal=xmasstotal + m1\x#*m1\mass:ymasstotal=ymasstotal + m1\y#*m1\mass
   xpulstotal=xpulstotal + m1\vx#*m1\mass:ypulstotal=ypulstotal + m1\vy#*m1\mass
   masstotal=masstotal+m1\mass
Next
End Function

Function Bounce(m1.masspoint, m2.masspoint);--------------------------------------------------------------------
angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#)
radius1# = Sqr(m1\mass/Pi):radius2# = Sqr(m2\mass/Pi)
distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2)
m1\x#=m1\x#-m1\vx#:m1\y#=m1\y#-m1\vy#

;hier Routine rein

m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy#
End Function

Function Fusion(m1.masspoint, m2.masspoint)
m1\vx#=(m1\vx# * m1\mass + m2\vx# * m2\mass)/(m1\mass + m2\mass)
m1\vy#=(m1\vy# * m1\mass + m2\vy# * m2\mass)/(m1\mass + m2\mass)
m1\x# = m1\x# + (m2\x#-m1\x#)*m2\mass/(m1\mass+m2\mass)
m1\y# = m1\y# + (m2\y#-m1\y#)*m2\mass/(m1\mass+m2\mass)
m1\r= (m1\r*m1\mass + m2\r*m2\mass)/(m1\mass + m2\mass)
m1\g= (m1\g*m1\mass + m2\g*m2\mass)/(m1\mass + m2\mass)
m1\b= (m1\b*m1\mass + m2\b*m2\mass)/(m1\mass + m2\mass)
m1\mass=m1\mass+m2\mass
m1\status = m1\status Or m2\status
Delete m2
End Function

Function Visualize()
For mass.masspoint = Each masspoint
   size= Sqr(mass\mass/Pi)*scale#:If size < 1 Then size = 1
   xscreen=width/2 + (xoffset + mass\x#)*scale#
   yscreen=height/2 + (yoffset + mass\y#)*scale#
   Color mass\r, mass\g, mass\b
   Oval xscreen-size,yscreen-size,size*2,size*2,1
   Color 255,255,255
   If (mass\status And 2) Then Oval xscreen-size,yscreen-size,size*2,size*2,0
Next
End Function

Vielleicht kann da jemand helfen.

	the FR3AK	Mi, Feb 20, 2008 22:18 Antworten mit Zitat
Das läuft bei mir mit max. 3 FPS Oo ( wenn ich FLIP 0 mache ) Da kann was nicht stimmen oder?

the FR3AK

Mi, Feb 20, 2008 22:18
Antworten mit Zitat

Das läuft bei mir mit max. 3 FPS Oo ( wenn ich FLIP 0 mache )
Da kann was nicht stimmen oder?

	TheProgrammer	Mi, Feb 20, 2008 22:44 Antworten mit Zitat
Bis dahin siehts doch schomal sehr gut aus. In 3D würde mich das mal interessieren.. ^^ gerade, weil Revolutionsbewegungen von Planeten nur in einer 3. Dimension richtig möglich sind...
aktuelles Projekt: The last day of human being

TheProgrammer

Mi, Feb 20, 2008 22:44
Antworten mit Zitat

Bis dahin siehts doch schomal sehr gut aus. Smile

In 3D würde mich das mal interessieren.. ^^ gerade, weil Revolutionsbewegungen von Planeten nur in einer 3. Dimension richtig möglich sind...

aktuelles Projekt: The last day of human being

	Hawkins	Do, Feb 21, 2008 9:56 Antworten mit Zitat
Schonma danke für die Antworten. Das es beim einen oder anderen langsam läuft könnte daran liegen, dass ja wirklich JEDER Massepartikel mit JEDEM wechselwirkt und deshalb ein doppelter Schleifendurchlauf nötig war. das sind bei 100 Partikeln dann 100 mal 99 (nicht 100 mal 100 da der Partikel nicht mit sich selbst wechselwirkt) = 9900 Und dabei werden jedesmal die Kräfte neu ausgerechnet die wirken sowie die beschleunigung. Das sind schon viele Berechnungen. Ich habe einige Dinge zur Geschwindigkeitsoptimierung gelesen, habe aber nur jene angewandt, die das Programm nicht unübersichtlicher machen. Also wenn es geht, möchte ich Funktionen NICHT durch Gosub ersetzen. Tips empfange ich gerne und Kritik auch (sofern sie konstruktiv ist). Das ist ja der hauptgrund wieso ich das Programm hier veröffentliche. In 3D wäre zwar auch Interessant aber mit viel mehr Aufwand verbunden, was die Visualisierung angeht. Ich wüsste nicht wo die Kamera hin soll etc. Aber die Umdrehungbewegungen sind schon real, auch ohne tiefen-dimension, da ja alle Massen deshalb auch auf der gleichen Ebene liegen. Auch die Masse ist Flächenbezogen, nicht Volumen bezogen. Da ich die Dichte konstant habe, spare ich mir diesen Faktor und nehme die Fläche als Dichte. somit ist bei mir die Dichte (radius^2)pi , also handelt es sich auch um ein 2D universum. Ich habe auch schon testweise versucht die masse als (4/3)radius^3*pi anzunehmen, also so, als wäre es 3d nur von der Seite angesehen und auf einer Ebene. Aber das erschien mir dann doch nicht sinnvoll.

Hawkins

Do, Feb 21, 2008 9:56
Antworten mit Zitat

Schonma danke für die Antworten.
Das es beim einen oder anderen langsam läuft könnte daran liegen, dass ja wirklich JEDER Massepartikel mit JEDEM wechselwirkt und deshalb ein doppelter Schleifendurchlauf nötig war. das sind bei 100 Partikeln dann 100 mal 99 (nicht 100 mal 100 da der Partikel nicht mit sich selbst wechselwirkt)
= 9900
Und dabei werden jedesmal die Kräfte neu ausgerechnet die wirken sowie die beschleunigung. Das sind schon viele Berechnungen.
Ich habe einige Dinge zur Geschwindigkeitsoptimierung gelesen, habe aber nur jene angewandt, die das Programm nicht unübersichtlicher machen.
Also wenn es geht, möchte ich Funktionen NICHT durch Gosub ersetzen.
Tips empfange ich gerne und Kritik auch (sofern sie konstruktiv ist).
Das ist ja der hauptgrund wieso ich das Programm hier veröffentliche.

In 3D wäre zwar auch Interessant aber mit viel mehr Aufwand verbunden, was die Visualisierung angeht. Ich wüsste nicht wo die Kamera hin soll etc.
Aber die Umdrehungbewegungen sind schon real, auch ohne tiefen-dimension, da ja alle Massen deshalb auch auf der gleichen Ebene liegen.
Auch die Masse ist Flächenbezogen, nicht Volumen bezogen. Da ich die Dichte konstant habe, spare ich mir diesen Faktor und nehme die Fläche als Dichte. somit ist bei mir die Dichte (radius^2)*pi , also handelt es sich auch um ein 2D universum. Ich habe auch schon testweise versucht die masse als (4/3)*radius^3*pi anzunehmen, also so, als wäre es 3d nur von der Seite angesehen und auf einer Ebene. Aber das erschien mir dann doch nicht sinnvoll.

	Tpro	Do, Feb 21, 2008 16:02 Antworten mit Zitat
ich konnte dein Programm leider nicht testen, aber: Es mach kaum Sinn ein Planentensystem als 3D darzustellen! Wer im Physikunterricht aufgepasst hatt weis das wegen der Drehimpulserhaltung sich die Planeten nur in einer Ebene bewegen können. Also sollange du keine Kraft von außen auf einen Planeten einwirken lässt passiert in der 3. Dimension eh nichts! Und mit Kraft ist da schon ein bischen mehr als ein kleines Meteroidchen gemeint! Ziemlich nettes Program... Was genau soll beim "Bounce" passieren?! sollen die einfach nur wie Flumies voneinander abprallen? Wenn ja dann sollteste du dir mal Unelastischen Stoß mit Vektoren anschauen... Die Geschwindigkeit und Masse hast du ja, ein Bewegungsvektor kannst du dir auch zusammenbasteln... Wenn der getroffene zerplatzen soll müsstest du ihn in viele kleine Massepkt aufteilen und dan jedem einzelnen abhängig von seiner Position zum Auftreffpkt einen Bewegungsvektor verpassen. Und die Masse als teil der gesammtmasse! Das dürfte aber ein Echtzeitrendern kaum noch möglich machen... viel spaß dabei, hört sich echt innteresant an!
Der Optimist: "Das Glas ist halb voll" Der Pessimist: "Das Glas ist halb leer" Der Ingenieur: "Das Glas ist doppelt so groß wie es sein müsste"

Tpro

Do, Feb 21, 2008 16:02
Antworten mit Zitat

ich konnte dein Programm leider nicht testen, aber:

Es mach kaum Sinn ein Planentensystem als 3D darzustellen!
Wer im Physikunterricht aufgepasst hatt weis das wegen der Drehimpulserhaltung sich die Planeten nur in einer Ebene bewegen können. Also sollange du keine Kraft von außen auf einen Planeten einwirken lässt passiert in der 3. Dimension eh nichts! Und mit Kraft ist da schon ein bischen mehr als ein kleines Meteroidchen gemeint!

Ziemlich nettes Program...

Was genau soll beim "Bounce" passieren?! sollen die einfach nur wie Flumies voneinander abprallen?

Wenn ja dann sollteste du dir mal Unelastischen Stoß mit Vektoren anschauen...
Die Geschwindigkeit und Masse hast du ja, ein Bewegungsvektor kannst du dir auch zusammenbasteln...

Wenn der getroffene zerplatzen soll müsstest du ihn in viele kleine Massepkt aufteilen und dan jedem einzelnen abhängig von seiner Position zum Auftreffpkt einen Bewegungsvektor verpassen. Und die Masse als teil der gesammtmasse!

Das dürfte aber ein Echtzeitrendern kaum noch möglich machen...

viel spaß dabei, hört sich echt innteresant an!

Der Optimist: "Das Glas ist halb voll"
Der Pessimist: "Das Glas ist halb leer"
Der Ingenieur: "Das Glas ist doppelt so groß wie es sein müsste"

	D2006 Administrator	Do, Feb 21, 2008 16:15 Antworten mit Zitat
Tpro hat Folgendes geschrieben: Wer im Physikunterricht aufgepasst hatt weis das wegen der Drehimpulserhaltung sich die Planeten nur in einer Ebene bewegen können. Das mag für einen Planeten gelten ja, aber wer sagt denn, dass alle Planeten eines System in der selben Ebene sind? Nehmen wir mal den Ex-Planeten Pluto. Er hat relativ zur Erde eine geneigte Umlaufbahn. Nur so als kleiner Einwurf von mir.
Intel Core i5 2500 \| 16 GB DDR3 RAM dualchannel \| ATI Radeon HD6870 (1024 MB RAM) \| Windows 7 Home Premium Intel Core 2 Duo 2.4 GHz \| 2 GB DDR3 RAM dualchannel \| Nvidia GeForce 9400M (256 MB shared RAM) \| Mac OS X Snow Leopard Intel Pentium Dual-Core 2.4 GHz \| 3 GB DDR2 RAM dualchannel \| ATI Radeon HD3850 (1024 MB RAM) \| Windows 7 Home Premium Chaos Interactive :: GoBang :: BB-Poker :: ChaosBreaker :: Hexagon :: ChaosRacer 2

D2006

Administrator

Do, Feb 21, 2008 16:15
Antworten mit Zitat

Tpro hat Folgendes geschrieben:

Wer im Physikunterricht aufgepasst hatt weis das wegen der Drehimpulserhaltung sich die Planeten nur in einer Ebene bewegen können.

Das mag für einen Planeten gelten ja, aber wer sagt denn, dass alle Planeten eines System in der selben Ebene sind? Nehmen wir mal den Ex-Planeten Pluto. Er hat relativ zur Erde eine geneigte Umlaufbahn.

Nur so als kleiner Einwurf von mir.

	Hawkins	Do, Feb 21, 2008 16:36 Antworten mit Zitat
Ja bei diesem programm sind ja alle Massepunkte in einer Ebene. Es soll ja auch nicht unser Sonnensystem abgebildet werden, sondern einfach nur prinzipiell das Verhalten von Massen simuliert werden. Ja die Funktion Bounce sollte eigentlich dafür sorgen dass die Massen voneinander abprallen wie beim unelastischen Stoß. Ich habe auch schon sehr viel dazu versucht, aber kein gescheites Ergebnis hinbekommen. Code: [AUSKLAPPEN] [EINKLAPPEN] Function testBounce(m1.masspoint, m2.masspoint);---------------------------------------------------------------- angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#) radius1# = Sqr(m1\mass#/Pi):radius2# = Sqr(m2\mass#/Pi) distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2) timecorr# = (radius1#+radius2#-distance#)/(Sqr(m2\vx#^2+m2\vy#^2)+Sqr(m1\vx#^2+m1\vy#^2)) m1\x# = m1\x# - timecorr#m1\vx#:m1\y# = m1\y# - timecorr#m1\vy# m2\x# = m2\x# - timecorr#m2\vx#:m2\y# = m2\y# - timecorr#m2\vy# v2#=((m2\mass-m1\mass)m2\vx# + 2m1\massm1\vx#)/(m1\mass+m2\mass) m1\vx# = ((m1\mass-m2\mass)m1\vx# + 2m2\massm2\vx#)/(m1\mass+m2\mass) * Cos(angle#) m1\vy# = ((m1\mass-m2\mass)m1\vy# + 2m2\massm2\vy#)/(m1\mass+m2\mass) Sin(angle#) m2\vx# =-((m2\mass-m1\mass)m2\vx# + 2m1\massm1\vx#)/(m1\mass+m2\mass) Cos(angle#) m2\vy# =-((m2\mass-m1\mass)m2\vy# + 2m1\massm1\vy#)/(m1\mass+m2\mass) Sin(angle#) m1\x# = m1\x# + timecorr#m1\vx#:m1\y# = m1\y# + timecorr#m1\vy# m2\x# = m2\x# + timecorr#m2\vx#:m2\y# = m2\y# + timecorr#m2\vy# End Function das war ein versuch. Dieses Timecorr ist eine Korrektur, da ja in dieser Abfrage nicht exakt die Massen sich berühren sondern schon ineinander sind. Deshlab wollte ich damit soweit zurückrechnen, wo sich die massen gerade berühren udn dass dann nach der vektorberechnung wieder draufrechnen.

Hawkins

Do, Feb 21, 2008 16:36
Antworten mit Zitat

Ja bei diesem programm sind ja alle Massepunkte in einer Ebene.
Es soll ja auch nicht unser Sonnensystem abgebildet werden, sondern einfach nur prinzipiell das Verhalten von Massen simuliert werden.
Ja die Funktion Bounce sollte eigentlich dafür sorgen dass die Massen voneinander abprallen wie beim unelastischen Stoß. Ich habe auch schon sehr viel dazu versucht, aber kein gescheites Ergebnis hinbekommen.

Code: [AUSKLAPPEN]

Function testBounce(m1.masspoint, m2.masspoint);----------------------------------------------------------------
angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#)
radius1# = Sqr(m1\mass#/Pi):radius2# = Sqr(m2\mass#/Pi)
distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2)

timecorr# = (radius1#+radius2#-distance#)/(Sqr(m2\vx#^2+m2\vy#^2)+Sqr(m1\vx#^2+m1\vy#^2))
m1\x# = m1\x# - timecorr#*m1\vx#:m1\y# = m1\y# - timecorr#*m1\vy#
m2\x# = m2\x# - timecorr#*m2\vx#:m2\y# = m2\y# - timecorr#*m2\vy#

v2#=((m2\mass-m1\mass)*m2\vx# + 2*m1\mass*m1\vx#)/(m1\mass+m2\mass)

m1\vx# = ((m1\mass-m2\mass)*m1\vx# + 2*m2\mass*m2\vx#)/(m1\mass+m2\mass) * Cos(angle#)
m1\vy# = ((m1\mass-m2\mass)*m1\vy# + 2*m2\mass*m2\vy#)/(m1\mass+m2\mass) * Sin(angle#)
m2\vx# =-((m2\mass-m1\mass)*m2\vx# + 2*m1\mass*m1\vx#)/(m1\mass+m2\mass) * Cos(angle#)
m2\vy# =-((m2\mass-m1\mass)*m2\vy# + 2*m1\mass*m1\vy#)/(m1\mass+m2\mass) * Sin(angle#)

m1\x# = m1\x# + timecorr#*m1\vx#:m1\y# = m1\y# + timecorr#*m1\vy#
m2\x# = m2\x# + timecorr#*m2\vx#:m2\y# = m2\y# + timecorr#*m2\vy#
End Function

das war ein versuch.
Dieses Timecorr ist eine Korrektur, da ja in dieser Abfrage nicht exakt die Massen sich berühren sondern schon ineinander sind. Deshlab wollte ich damit soweit zurückrechnen, wo sich die massen gerade berühren udn dass dann nach der vektorberechnung wieder draufrechnen.

	Hawkins Betreff: So, das ist ne bessere Version mit GUI und neuer Physik	Mi, Feb 27, 2008 13:56 Antworten mit Zitat
Ich habe die Physik-Routune überarbeitet. Ich werde wohl nicht mehr weiter dran arbeiten weil ich ich einfach resigniert habe. Ich weiss einfach nicht wie ich das Problem lösen soll, das schnelle Massen andere erst garnicht berühren, aber im nächsten moment schon drüber hinaus sind. Ich müsste die Zeitabschnitte unendlich klein wählen (Zeitkontinuität), aber ich weiss einfach nicht wie. Bzw. Wie man das gut annähern kann Hier der Code Code: [AUSKLAPPEN] [EINKLAPPEN] Const width=600,height=600 SeedRnd MilliSecs() EndMsg$ = "Escape to Quit, H for Helpmenu " Global scale# = 0.5,xoffset=0,yoffset=0 Global t# = 1 ;Time Quantizsation Global bits = 0 ;1=Help 2=Mouse over Graph Global xmasstotal=0, ymasstotal=0, xpulstotal=0, ypulstotal=0,masstotal=0 Global red=255,green=255,blue=255,newmass = 200 Global colorcycle Type Masspoint Field x#=0,y#=0,vx#=0,vy#=0,ax#=0,ay#=0 Field mass=10,r=255,g=255,b=255,status = 0 Field oldx#=0,oldy#=0 End Type ;status: 1=fixed 2=can't absorb ;---------------------------- SETUP GUI ------------------------------- Global Main = CreateWindow ("Massparticle Simulator",100,100,800,600+34,0,3) Global graph = CreateCanvas (0,0,600,600,Main) SetGadgetLayout (graph,1,1,1,1) SetBuffer CanvasBuffer(graph) Global label1 = CreateLabel ("Set new Mass:",width+15,10,100,15,Main) SetGadgetFont (label1,LoadFont("Arial",15,1)) SetGadgetLayout (CreateLabel ("Mass:",width+15,40,30,20,main),0,1,1,0) Global massfield = CreateTextField (width+50,39,50,18,main) SetGadgetLayout (CreateLabel ("Color:",width+115,40,30,20,main),0,1,1,0) Global colorfield = CreateCanvas(width+150,39,19,16,main) Global status1 = CreateButton("fixed",width+15,70,100,15,Main,2) Global status2 = CreateButton("can't absorb",width+15,90,100,15,Main,2) Global clear = CreateButton("clear",width+15,height-30,100,20,main,1) Global addbang = CreateButton("add Random",width+15,height-60,100,20,main,1) Global restart = CreateButton("Restart",width+15,height-90,100,20,main,1) SetGadgetLayout (label1,0,1,1,0) SetGadgetLayout (status1,0,1,1,0) SetGadgetLayout (status2,0,1,1,0) SetGadgetLayout (massfield,0,1,1,0) SetGadgetLayout (colorfield,0,1,1,0) SetGadgetLayout (clear,0,1,0,1) SetGadgetLayout (addbang,0,1,0,1) SetGadgetLayout (Restart,0,1,0,1) Global id Global timer = CreateTimer(1000) SetGadgetText (massfield,newmass) Initmass() HidePointer(graph) Repeat Cls GuiControl() Control() TimeAdapt() Gravitate() Visualize() Color $FF,$FF,$FF If (bits And 1) Then showhelp() Text width-StringWidth(EndMsg$),height-StringHeight(EndMsg$), EndMsg$ FlipCanvas (graph,1) id=WaitEvent(0) Until ((id = $101 And (EventData() = 1)) Or (id = $803));Escape or CloseWindow End Function TimeAdapt() runtime = TimerTicks(timer) ResetTimer(timer) Delay 20-runtime ;t# = runtime/2 End Function Function Showhelp() y=100 Text 100,y," num + Zoom in":y=y+StringHeight("I")+5 Text 100,y," num - Zoom out":y=y+StringHeight("I")+5 Text 100,y," up Scroll Up":y=y+StringHeight("I")+5 Text 100,y," down Scroll Down":y=y+StringHeight("I")+5 Text 100,y," left Scroll Left":y=y+StringHeight("I")+5 Text 100,y," right Scroll Right":y=y+StringHeight("I")+5 Text 100,y," pos1 Center Scroll":y=y+StringHeight("I")+5 Text 100,y," H Toggle Help":y=y+StringHeight("I")+5 Text 100,y," Space Restart":y=y+StringHeight("I")+5 Text 100,y," Enter Add Masspoints":y=y+StringHeight("I")+5 Text 100,y," BackSpace Delete all Masspoints":y=y+StringHeight("I")+5 Text 100,y," Q Create simple Sunsystem (for debug)":y=y+StringHeight("I")+5 Text 100,y,"Mousebutton 1 Set New Masspoints":y=y+StringHeight("I")+5 Text 100,y,"Mousebutton 2 Change Masspointcolor":y=y+StringHeight("I")+5 Text 100,y," , - Mass ":y=y+StringHeight("I")+5 Text 100,y," . + Mass ":y=y+StringHeight("I")+5 Text 100,y," A Calibrate Inertial-System ":y=y+StringHeight("I")+5 autor$="by M. Schuster" Text width-StringWidth(autor$)-5,height-StringHeight(autor$)2-5,autor$ End Function Function Control() If KeyHit(57) Then Delete Each masspoint:Initmass(); Space -> Neu Initialisierung If KeyHit(28) Then Initmass() ; neue Massepunkte If KeyDown(74) Then scale# = scale#/1.049 ;Minus Zoom Out If KeyDown(78) Then scale# = scale#1.05 ;Plus Zoom In If KeyDown(200) Then yoffset = yoffset + 10/scale# If KeyDown(208) Then yoffset = yoffset - 10/scale# If KeyDown(203) Then xoffset = xoffset + 10/scale# If KeyDown(205) Then xoffset = xoffset - 10/scale# If KeyHit(199) Then xoffset=0:yoffset=0:scale=0.5;:ResetInertial() If KeyHit(35) Then bits = bits Xor 1 If KeyHit(14) Then Delete Each masspoint:Cls If KeyHit(16) Then Debuginit() If KeyHit(30) Then ResetInertial() If KeyDown(51) And newmass >= 100 Then newmass=newmass/1.009 If KeyDown(52) And Newmass >= 100 Then newmass=newmass1.01 If KeyDown(51) And newmass < 100 Then newmass=newmass-1 If KeyDown(52) And Newmass < 100 Then newmass=newmass+1 If newmass<=0 Then newmass=1 End Function Function GuiControl() stat = ButtonState(status1) + 2ButtonState(status2) If id=$401 And EventSource()=clear Then Delete Each masspoint:Cls If id=$401 And EventSource()=addbang Then Initmass() If id=$401 And EventSource()=restart Then Delete Each masspoint:Initmass():xoffset=0:yoffset=0:scale=0.5 If (bits And 2)SetGadgetText (massfield,newmass) newmass = Int(TextFieldText(massfield)) If id=$204 And (newmass>10) Then newmass = newmass * 1.05^EventData() If id=$204 And (newmass<=10) Then newmass=newmass + EventData() If id=$201 And EventData()=1 Then CreateMasspoint(stat) If id=$201 And EventData()=2 Then NextColor() If id=$205 Then bits = bits Or 2:ActivateGadget(graph) If id=$206 Then bits = bits And (Not 2) End Function Function ResetInertial() For m.masspoint = Each masspoint m\vx# = m\vx# - xpulstotal/masstotal m\vy# = m\vy# - ypulstotal/masstotal m\x# = m\x# - xmasstotal/masstotal m\y# = m\y# - ymasstotal/masstotal Next End Function Function NextColor() colorcycle = (colorcycle + 1) Mod 8 Select colorcycle Case 0:red=0:green=0:blue=0 Case 1:red=255:green=0:blue=0 Case 2:red=255:green=255:blue=0 Case 3:red=0:green=255:blue=0 Case 4:red=0:green=255:blue=255 Case 5:red=0:green=0:blue=255 Case 6:red=255:green=0:blue=255 Case 7:red=255:green=255:blue=255 End Select SetBuffer(CanvasBuffer(colorfield)) Color(0,0,0) Rect(0,0,ClientWidth(colorfield),ClientHeight(colorfield),0) Color(red,green,blue) Rect(1,1,ClientWidth(colorfield)-2,ClientHeight(colorfield)-2,1) FlipCanvas(colorfield) SetBuffer(CanvasBuffer(graph)) End Function Function CreateMasspoint(stat = 0) If (id=$201) Then xset=EventX():yset=EventY() If (bits And 2) Then mass.masspoint=New masspoint mass\x#= (xset-width/2)/scale# - xoffset mass\y#= (yset-height/2)/scale# - yoffset mass\mass=newmass mass\r=red mass\g=green mass\b=blue mass\status = stat End If End Function Function Debuginit() mass.masspoint=New masspoint mass\x# = -100 mass\mass=500 mass\r=255 mass\g=240 mass\b=64 mass.masspoint=New masspoint mass\x#= 100 mass\vx#=0 mass\mass#=500 mass\r=255 mass\g=0 mass\b=0 End Function Function Initmass() For i = 0 To 99 mass.masspoint=New masspoint radius# = Rand(10,1000) angle# = Rnd(0,360) mass\x#= radius#Sin(angle#) mass\y#= radius#Cos(angle#) mass\vx#=Sin(angle#)Rnd(0,3) mass\vy#=Cos(angle#) Rnd(0,3) mass\mass=Rand(10,100) mass\r=Rand(0,255) mass\g=Rand(0,255) mass\b=Rand(0,255) Next End Function Function Gravitate() For m1.masspoint = Each masspoint If Not(m1\status And 1) Then radius1# = Sqr(m1\mass/Pi) For m2.masspoint = Each masspoint If (m1<>m2) Then dx# = m2\x#-m1\x#:dy# = m2\y#-m1\y# dmin = Sqr(m2\mass/Pi)+radius1# angle#=ATan2(dy#,dx#) dsquare#=dx#^2+dy#^2 If (Sqr(dsquare#) > dmin) Then m1\ax# = m1\ax# + Cos(angle#)m2\mass/dsquare# m1\ay# = m1\ay# + Sin(angle#)m2\mass/dsquare# Else If ((m1\status And 2) Or (m2\status And 2)) Then ;m1\vx# = m1\vx#/1.005:m1\vy#=m1\vy#/1.005 ;m1\ax# = m1\ax# + Cos(angle#)(m2\mass/(radius1#+radius2#))Sqr(distance#)/-radius1# ;m1\ay# = m1\ay# + Sin(angle#)(m2\mass/(radius1#+radius2#))Sqr(distance#)/-radius1# Else Fusion(m1,m2) ;testbounce(m1,m2) End If End If End If Next End If Next Update() End Function Function Update() xmasstotal=0:ymasstotal=0 xpulstotal=0:ypulstotal=0 masstotal=0 For m1.masspoint= Each masspoint m1\oldx#=m1\x#:m1\oldy#=m1\y# If Not(m1\status And 1) Then m1\x# = m1\ax#/2 * t#^2 + m1\vx# * t# + m1\x# m1\y# = m1\ay#/2 * t#^2 + m1\vy# * t# + m1\y# m1\vx# = m1\ax# * t# + m1\vx# m1\vy# = m1\ay# * t# + m1\vy# m1\ax# = 0:m1\ay#=0 End If xmasstotal=xmasstotal + m1\x#m1\mass:ymasstotal=ymasstotal + m1\y#m1\mass xpulstotal=xpulstotal + m1\vx#m1\mass:ypulstotal=ypulstotal + m1\vy#m1\mass masstotal=masstotal+m1\mass Next End Function Function testBounce(m1.masspoint, m2.masspoint);---------------------------------------------------------------- angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#) radius1# = Sqr(m1\mass#/Pi):radius2# = Sqr(m2\mass#/Pi) distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2) timecorr# = (radius1#+radius2#-distance#)/(Sqr(m2\vx#^2+m2\vy#^2)+Sqr(m1\vx#^2+m1\vy#^2)) m1\x# = m1\x# - timecorr#m1\vx#:m1\y# = m1\y# - timecorr#m1\vy# m2\x# = m2\x# - timecorr#m2\vx#:m2\y# = m2\y# - timecorr#m2\vy# v2#=((m2\mass-m1\mass)m2\vx# + 2m1\massm1\vx#)/(m1\mass+m2\mass) m1\vx# = ((m1\mass-m2\mass)m1\vx# + 2m2\massm2\vx#)/(m1\mass+m2\mass) * Cos(angle#) m1\vy# = ((m1\mass-m2\mass)m1\vy# + 2m2\massm2\vy#)/(m1\mass+m2\mass) Sin(angle#) m2\vx# =-((m2\mass-m1\mass)m2\vx# + 2m1\massm1\vx#)/(m1\mass+m2\mass) Cos(angle#) m2\vy# =-((m2\mass-m1\mass)m2\vy# + 2m1\massm1\vy#)/(m1\mass+m2\mass) Sin(angle#) m1\x# = m1\x# + timecorr#m1\vx#:m1\y# = m1\y# + timecorr#m1\vy# m2\x# = m2\x# + timecorr#m2\vx#:m2\y# = m2\y# + timecorr#m2\vy# End Function Function Bounce(m1.masspoint, m2.masspoint);-------------------------------------------------------------------- angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#) radius1# = Sqr(m1\mass/Pi):radius2# = Sqr(m2\mass/Pi) distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2) m1\x#=m1\x#-m1\vx#:m1\y#=m1\y#-m1\vy# ;hier Routine rein m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy# End Function Function Fusion(m1.masspoint, m2.masspoint);---------------------------------------- If (m2\status And 1)Or(m1\status And 1) Then If (m2\status And 1) Then m1\x#=m2\x#:m1\y#=m2\y# Else m1\vx#=(m1\vx# * m1\mass + m2\vx# * m2\mass)/(m1\mass + m2\mass) m1\vy#=(m1\vy# * m1\mass + m2\vy# * m2\mass)/(m1\mass + m2\mass) m1\x# = m1\x# + (m2\x#-m1\x#)m2\mass/(m1\mass+m2\mass) m1\y# = m1\y# + (m2\y#-m1\y#)m2\mass/(m1\mass+m2\mass) End If m1\r= (m1\rm1\mass + m2\rm2\mass)/(m1\mass + m2\mass) m1\g= (m1\gm1\mass + m2\gm2\mass)/(m1\mass + m2\mass) m1\b= (m1\bm1\mass + m2\bm2\mass)/(m1\mass + m2\mass) m1\mass=m1\mass+m2\mass m1\status = m1\status Or m2\status Delete m2 End Function Function Visualize() For mass.masspoint = Each masspoint size= Sqr(mass\mass/Pi)scale#:If size < 1 Then size = 1 xscreen=width/2 + (xoffset + mass\x#)scale# yscreen=height/2 + (yoffset + mass\y#)scale# Color mass\r, mass\g, mass\b Oval xscreen-size,yscreen-size,size2,size2,1 Color 255,255,255 If (mass\status And 2) Then Oval xscreen-size,yscreen-size,size2,size2,0 Next If (bits And 2) Then xset=MouseX(graph):yset=MouseY(graph) size=Sqr(newmass/Pi)scale#:If size < 1 Then size = 1 Oval xset-size,yset-size,size2,size2,0 End If End Function Ach alles mist Achja, blitzplus wird dafür benötigt

Hawkins

Betreff: So, das ist ne bessere Version mit GUI und neuer Physik

Mi, Feb 27, 2008 13:56
Antworten mit Zitat

Ich habe die Physik-Routune überarbeitet.
Ich werde wohl nicht mehr weiter dran arbeiten weil ich ich einfach resigniert habe.
Ich weiss einfach nicht wie ich das Problem lösen soll, das schnelle Massen andere erst garnicht berühren, aber im nächsten moment schon drüber hinaus sind.
Ich müsste die Zeitabschnitte unendlich klein wählen (Zeitkontinuität), aber ich weiss einfach nicht wie. Bzw. Wie man das gut annähern kann

Hier der Code
Code: [AUSKLAPPEN]

Const width=600,height=600
SeedRnd MilliSecs()
EndMsg$ = "Escape to Quit, H for Helpmenu "
Global scale# = 0.5,xoffset=0,yoffset=0
Global t# = 1 ;Time Quantizsation
Global bits = 0 ;1=Help 2=Mouse over Graph
Global xmasstotal=0, ymasstotal=0, xpulstotal=0, ypulstotal=0,masstotal=0
Global red=255,green=255,blue=255,newmass = 200
Global colorcycle

Type Masspoint
Field x#=0,y#=0,vx#=0,vy#=0,ax#=0,ay#=0
Field mass=10,r=255,g=255,b=255,status = 0
Field oldx#=0,oldy#=0
End Type

;status: 1=fixed 2=can't absorb

;---------------------------- SETUP GUI -------------------------------
Global Main = CreateWindow ("Massparticle Simulator",100,100,800,600+34,0,3)
Global graph = CreateCanvas (0,0,600,600,Main)
SetGadgetLayout (graph,1,1,1,1)
SetBuffer CanvasBuffer(graph)
Global label1 = CreateLabel ("Set new Mass:",width+15,10,100,15,Main)
SetGadgetFont (label1,LoadFont("Arial",15,1))
SetGadgetLayout (CreateLabel ("Mass:",width+15,40,30,20,main),0,1,1,0)
Global massfield = CreateTextField (width+50,39,50,18,main)
SetGadgetLayout (CreateLabel ("Color:",width+115,40,30,20,main),0,1,1,0)
Global colorfield = CreateCanvas(width+150,39,19,16,main)
Global status1 = CreateButton("fixed",width+15,70,100,15,Main,2)
Global status2 = CreateButton("can't absorb",width+15,90,100,15,Main,2)
Global clear = CreateButton("clear",width+15,height-30,100,20,main,1)
Global addbang = CreateButton("add Random",width+15,height-60,100,20,main,1)
Global restart = CreateButton("Restart",width+15,height-90,100,20,main,1)

SetGadgetLayout (label1,0,1,1,0)
SetGadgetLayout (status1,0,1,1,0)
SetGadgetLayout (status2,0,1,1,0)
SetGadgetLayout (massfield,0,1,1,0)
SetGadgetLayout (colorfield,0,1,1,0)
SetGadgetLayout (clear,0,1,0,1)
SetGadgetLayout (addbang,0,1,0,1)
SetGadgetLayout (Restart,0,1,0,1)

Global id
Global timer = CreateTimer(1000)

SetGadgetText (massfield,newmass)
Initmass()
HidePointer(graph)
Repeat
Cls
GuiControl()
Control()
TimeAdapt()
Gravitate()
Visualize()
Color $FF,$FF,$FF
If (bits And 1) Then showhelp()
Text width-StringWidth(EndMsg$),height-StringHeight(EndMsg$), EndMsg$
FlipCanvas (graph,1)
id=WaitEvent(0)
Until ((id = $101 And (EventData() = 1)) Or (id = $803));Escape or CloseWindow
End

Function TimeAdapt()
runtime = TimerTicks(timer)
ResetTimer(timer)
Delay 20-runtime
;t# = runtime/2
End Function

Function Showhelp()
y=100
Text 100,y," num + Zoom in":y=y+StringHeight("I")+5
Text 100,y," num - Zoom out":y=y+StringHeight("I")+5
Text 100,y," up Scroll Up":y=y+StringHeight("I")+5
Text 100,y," down Scroll Down":y=y+StringHeight("I")+5
Text 100,y," left Scroll Left":y=y+StringHeight("I")+5
Text 100,y," right Scroll Right":y=y+StringHeight("I")+5
Text 100,y," pos1 Center Scroll":y=y+StringHeight("I")+5
Text 100,y," H Toggle Help":y=y+StringHeight("I")+5
Text 100,y," Space Restart":y=y+StringHeight("I")+5
Text 100,y," Enter Add Masspoints":y=y+StringHeight("I")+5
Text 100,y," BackSpace Delete all Masspoints":y=y+StringHeight("I")+5
Text 100,y," Q Create simple Sunsystem (for debug)":y=y+StringHeight("I")+5
Text 100,y,"Mousebutton 1 Set New Masspoints":y=y+StringHeight("I")+5
Text 100,y,"Mousebutton 2 Change Masspointcolor":y=y+StringHeight("I")+5
Text 100,y," , - Mass ":y=y+StringHeight("I")+5
Text 100,y," . + Mass ":y=y+StringHeight("I")+5
Text 100,y," A Calibrate Inertial-System ":y=y+StringHeight("I")+5
autor$="by M. Schuster"
Text width-StringWidth(autor$)-5,height-StringHeight(autor$)*2-5,autor$
End Function

Function Control()
If KeyHit(57) Then Delete Each masspoint:Initmass(); Space -> Neu Initialisierung
If KeyHit(28) Then Initmass() ; neue Massepunkte
If KeyDown(74) Then scale# = scale#/1.049 ;Minus Zoom Out
If KeyDown(78) Then scale# = scale#*1.05 ;Plus Zoom In
If KeyDown(200) Then yoffset = yoffset + 10/scale#
If KeyDown(208) Then yoffset = yoffset - 10/scale#
If KeyDown(203) Then xoffset = xoffset + 10/scale#
If KeyDown(205) Then xoffset = xoffset - 10/scale#
If KeyHit(199) Then xoffset=0:yoffset=0:scale=0.5;:ResetInertial()
If KeyHit(35) Then bits = bits Xor 1
If KeyHit(14) Then Delete Each masspoint:Cls
If KeyHit(16) Then Debuginit()
If KeyHit(30) Then ResetInertial()
If KeyDown(51) And newmass >= 100 Then newmass=newmass/1.009
If KeyDown(52) And Newmass >= 100 Then newmass=newmass*1.01
If KeyDown(51) And newmass < 100 Then newmass=newmass-1
If KeyDown(52) And Newmass < 100 Then newmass=newmass+1
If newmass<=0 Then newmass=1
End Function

Function GuiControl()
stat = ButtonState(status1) + 2*ButtonState(status2)
If id=$401 And EventSource()=clear Then Delete Each masspoint:Cls
If id=$401 And EventSource()=addbang Then Initmass()
If id=$401 And EventSource()=restart Then Delete Each masspoint:Initmass():xoffset=0:yoffset=0:scale=0.5
If (bits And 2)SetGadgetText (massfield,newmass)
newmass = Int(TextFieldText(massfield))
If id=$204 And (newmass>10) Then newmass = newmass * 1.05^EventData()
If id=$204 And (newmass<=10) Then newmass=newmass + EventData()
If id=$201 And EventData()=1 Then CreateMasspoint(stat)
If id=$201 And EventData()=2 Then NextColor()
If id=$205 Then bits = bits Or 2:ActivateGadget(graph)
If id=$206 Then bits = bits And (Not 2)
End Function

Function ResetInertial()
For m.masspoint = Each masspoint
   m\vx# = m\vx# - xpulstotal/masstotal
   m\vy# = m\vy# - ypulstotal/masstotal
   m\x# = m\x# - xmasstotal/masstotal
   m\y# = m\y# - ymasstotal/masstotal
Next
End Function

Function NextColor()
colorcycle = (colorcycle + 1) Mod 8
Select colorcycle
   Case 0:red=0:green=0:blue=0
   Case 1:red=255:green=0:blue=0
   Case 2:red=255:green=255:blue=0
   Case 3:red=0:green=255:blue=0
   Case 4:red=0:green=255:blue=255
   Case 5:red=0:green=0:blue=255
   Case 6:red=255:green=0:blue=255
   Case 7:red=255:green=255:blue=255
   End Select
SetBuffer(CanvasBuffer(colorfield))
Color(0,0,0)
Rect(0,0,ClientWidth(colorfield),ClientHeight(colorfield),0)
Color(red,green,blue)
Rect(1,1,ClientWidth(colorfield)-2,ClientHeight(colorfield)-2,1)
FlipCanvas(colorfield)
SetBuffer(CanvasBuffer(graph))
End Function

Function CreateMasspoint(stat = 0)
If (id=$201) Then xset=EventX():yset=EventY()
If (bits And 2) Then
   mass.masspoint=New masspoint
   mass\x#= (xset-width/2)/scale# - xoffset
   mass\y#= (yset-height/2)/scale# - yoffset
   mass\mass=newmass
   mass\r=red
   mass\g=green
   mass\b=blue
   mass\status = stat
End If
End Function

Function Debuginit()
mass.masspoint=New masspoint
mass\x# = -100
mass\mass=500
mass\r=255
mass\g=240
mass\b=64

mass.masspoint=New masspoint
mass\x#= 100
mass\vx#=0
mass\mass#=500
mass\r=255
mass\g=0
mass\b=0
End Function

Function Initmass()
For i = 0 To 99
   mass.masspoint=New masspoint
   radius# = Rand(10,1000)
   angle# = Rnd(0,360)
   mass\x#= radius#*Sin(angle#)
   mass\y#= radius#*Cos(angle#)
   mass\vx#=Sin(angle#)*Rnd(0,3)
   mass\vy#=Cos(angle#) *Rnd(0,3)
   mass\mass=Rand(10,100)
   mass\r=Rand(0,255)
   mass\g=Rand(0,255)
   mass\b=Rand(0,255)
Next
End Function

Function Gravitate()
For m1.masspoint = Each masspoint
   If Not(m1\status And 1) Then
      radius1# = Sqr(m1\mass/Pi)
      For m2.masspoint = Each masspoint
         If (m1<>m2) Then
            dx# = m2\x#-m1\x#:dy# = m2\y#-m1\y#
            dmin = Sqr(m2\mass/Pi)+radius1#
            angle#=ATan2(dy#,dx#)
            dsquare#=dx#^2+dy#^2
            If (Sqr(dsquare#) > dmin) Then
               m1\ax# = m1\ax# + Cos(angle#)*m2\mass/dsquare#
               m1\ay# = m1\ay# + Sin(angle#)*m2\mass/dsquare#
            Else
               If ((m1\status And 2) Or (m2\status And 2)) Then
                  ;m1\vx# = m1\vx#/1.005:m1\vy#=m1\vy#/1.005
                  ;m1\ax# = m1\ax# + Cos(angle#)*(m2\mass/(radius1#+radius2#))*Sqr(distance#)/-radius1#
                  ;m1\ay# = m1\ay# + Sin(angle#)*(m2\mass/(radius1#+radius2#))*Sqr(distance#)/-radius1#
               Else
                  Fusion(m1,m2)
                  ;testbounce(m1,m2)
               End If
            End If
         End If
      Next
   End If
Next
Update()
End Function

Function Update()
xmasstotal=0:ymasstotal=0
xpulstotal=0:ypulstotal=0
masstotal=0
For m1.masspoint= Each masspoint
   m1\oldx#=m1\x#:m1\oldy#=m1\y#
   If Not(m1\status And 1) Then
      m1\x# = m1\ax#/2 * t#^2 + m1\vx# * t# + m1\x#
      m1\y# = m1\ay#/2 * t#^2 + m1\vy# * t# + m1\y#
      m1\vx# = m1\ax# * t# + m1\vx#
      m1\vy# = m1\ay# * t# + m1\vy#
      m1\ax# = 0:m1\ay#=0
      End If
   xmasstotal=xmasstotal + m1\x#*m1\mass:ymasstotal=ymasstotal + m1\y#*m1\mass
   xpulstotal=xpulstotal + m1\vx#*m1\mass:ypulstotal=ypulstotal + m1\vy#*m1\mass
   masstotal=masstotal+m1\mass
Next
End Function

Function testBounce(m1.masspoint, m2.masspoint);----------------------------------------------------------------
angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#)
radius1# = Sqr(m1\mass#/Pi):radius2# = Sqr(m2\mass#/Pi)
distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2)
timecorr# = (radius1#+radius2#-distance#)/(Sqr(m2\vx#^2+m2\vy#^2)+Sqr(m1\vx#^2+m1\vy#^2))
m1\x# = m1\x# - timecorr#*m1\vx#:m1\y# = m1\y# - timecorr#*m1\vy#
m2\x# = m2\x# - timecorr#*m2\vx#:m2\y# = m2\y# - timecorr#*m2\vy#
v2#=((m2\mass-m1\mass)*m2\vx# + 2*m1\mass*m1\vx#)/(m1\mass+m2\mass)
m1\vx# = ((m1\mass-m2\mass)*m1\vx# + 2*m2\mass*m2\vx#)/(m1\mass+m2\mass) * Cos(angle#)
m1\vy# = ((m1\mass-m2\mass)*m1\vy# + 2*m2\mass*m2\vy#)/(m1\mass+m2\mass) * Sin(angle#)
m2\vx# =-((m2\mass-m1\mass)*m2\vx# + 2*m1\mass*m1\vx#)/(m1\mass+m2\mass) * Cos(angle#)
m2\vy# =-((m2\mass-m1\mass)*m2\vy# + 2*m1\mass*m1\vy#)/(m1\mass+m2\mass) * Sin(angle#)
m1\x# = m1\x# + timecorr#*m1\vx#:m1\y# = m1\y# + timecorr#*m1\vy#
m2\x# = m2\x# + timecorr#*m2\vx#:m2\y# = m2\y# + timecorr#*m2\vy#
End Function

Function Bounce(m1.masspoint, m2.masspoint);--------------------------------------------------------------------
angle#=ATan2(m2\y#-m1\y#,m2\x#-m1\x#)
radius1# = Sqr(m1\mass/Pi):radius2# = Sqr(m2\mass/Pi)
distance# = Sqr((m2\y#-m1\y#)^2+(m2\x#-m1\x#)^2)
m1\x#=m1\x#-m1\vx#:m1\y#=m1\y#-m1\vy#

;hier Routine rein

m1\x#=m1\x#+m1\vx#:m1\y#=m1\y#+m1\vy#
End Function

Function Fusion(m1.masspoint, m2.masspoint);----------------------------------------
If (m2\status And 1)Or(m1\status And 1) Then
   If (m2\status And 1) Then m1\x#=m2\x#:m1\y#=m2\y#
   Else
   m1\vx#=(m1\vx# * m1\mass + m2\vx# * m2\mass)/(m1\mass + m2\mass)
   m1\vy#=(m1\vy# * m1\mass + m2\vy# * m2\mass)/(m1\mass + m2\mass)
   m1\x# = m1\x# + (m2\x#-m1\x#)*m2\mass/(m1\mass+m2\mass)
   m1\y# = m1\y# + (m2\y#-m1\y#)*m2\mass/(m1\mass+m2\mass)
   End If
m1\r= (m1\r*m1\mass + m2\r*m2\mass)/(m1\mass + m2\mass)
m1\g= (m1\g*m1\mass + m2\g*m2\mass)/(m1\mass + m2\mass)
m1\b= (m1\b*m1\mass + m2\b*m2\mass)/(m1\mass + m2\mass)
m1\mass=m1\mass+m2\mass
m1\status = m1\status Or m2\status
Delete m2
End Function

Function Visualize()
For mass.masspoint = Each masspoint
   size= Sqr(mass\mass/Pi)*scale#:If size < 1 Then size = 1
   xscreen=width/2 + (xoffset + mass\x#)*scale#
   yscreen=height/2 + (yoffset + mass\y#)*scale#
   Color mass\r, mass\g, mass\b
   Oval xscreen-size,yscreen-size,size*2,size*2,1
   Color 255,255,255
   If (mass\status And 2) Then Oval xscreen-size,yscreen-size,size*2,size*2,0
Next
If (bits And 2) Then
   xset=MouseX(graph):yset=MouseY(graph)
   size=Sqr(newmass/Pi)*scale#:If size < 1 Then size = 1
   Oval xset-size,yset-size,size*2,size*2,0
   End If
End Function

Ach alles mist

Achja, blitzplus wird dafür benötigt

	#Reaper Newsposter	Mi, Feb 27, 2008 18:21 Antworten mit Zitat
Also, ich weiß nun nicht genau, ob es dir Hilft, aber es gibt solche Problem häufiger. Ich weiß nun nicht genau, wie sich so etwas nennt, aber du musst "einfach" nur eine Kollisionserkennung (eine Art Linienkollision) zwischen der alten Position von einem Objekt bis zu der neuen Position mit anderen Objekten durchführen. Ist zwar nun nicht sonderlich gut erklärt, aber hier im Forum sollte es einige Themen dazu geben. MfG #Reaper
AMD Athlon 64 3500+, ATI AX800 Pro/TD, 2048 MB DRR 400 von Infineon, ♥RIP♥ (2005 - Juli 2015 -> sic!) Blitz3D, BlitzMax, MaxGUI, Monkey X; Win7

#Reaper

Newsposter

Mi, Feb 27, 2008 18:21
Antworten mit Zitat

Also, ich weiß nun nicht genau, ob es dir Hilft, aber es gibt solche Problem häufiger.
Ich weiß nun nicht genau, wie sich so etwas nennt, aber du musst "einfach" nur eine Kollisionserkennung (eine Art Linienkollision) zwischen der alten Position von einem Objekt bis zu der neuen Position mit anderen Objekten durchführen.
Ist zwar nun nicht sonderlich gut erklärt, aber hier im Forum sollte es einige Themen dazu geben.

MfG
#Reaper

AMD Athlon 64 3500+, ATI AX800 Pro/TD, 2048 MB DRR 400 von Infineon, ♥RIP♥ (2005 - Juli 2015 -> sic!)
Blitz3D, BlitzMax, MaxGUI, Monkey X; Win7

	Hawkins Betreff: aahhh	Do, Feb 28, 2008 11:03 Antworten mit Zitat
Hi danke für deine ANtwort. Ich glaube ich weiss was Du meinst und habe auch schon diesen Ansatz gehabt. Ich sehe gerade, dass im Type Masspoint sogar immer noch oldx und oldy drin sind. da wollte ich die vorherigen werte speichern und genau das machen wovon du redest (denke ich mal). Genau genommen hatte ich vor, auszurechnen, wie groß die zeit sein müsste bis zur Kollision. Da beim programmdurchlauf ja immer ganze Zeiteinheiten verstreichen, wollte ich damit den bruchteil der zeit bis zur kollision berechnen, das ereignis zurückrechnen, die kollision durchführen und die restzeit bis eine zeiteinheit voll ist draufrechnen was nach der kollision ist. Ach, ist schwer zu erklären.. Gruß Hawkins

Hawkins

Betreff: aahhh

Do, Feb 28, 2008 11:03
Antworten mit Zitat

Hi danke für deine ANtwort.
Ich glaube ich weiss was Du meinst und habe auch schon diesen Ansatz gehabt. Ich sehe gerade, dass im Type Masspoint sogar immer noch oldx und oldy drin sind. da wollte ich die vorherigen werte speichern und genau das machen wovon du redest (denke ich mal).
Genau genommen hatte ich vor, auszurechnen, wie groß die zeit sein müsste bis zur Kollision. Da beim programmdurchlauf ja immer ganze Zeiteinheiten verstreichen, wollte ich damit den bruchteil der zeit bis zur kollision berechnen, das ereignis zurückrechnen, die kollision durchführen und die restzeit bis eine zeiteinheit voll ist draufrechnen was nach der kollision ist.
Ach, ist schwer zu erklären..
Gruß
Hawkins

	Chrise Betreff: Re: aahhh	So, Jun 29, 2008 19:46 Antworten mit Zitat
Hallo Hawkins! Ich hatte da mal bevor ich deinen Skript gefunden habe auch mal bisschen rumprobiert: Code: [AUSKLAPPEN] [EINKLAPPEN] Type objekt Field nummer Field mesh Field parent Field textur Field rotation# Field bewegung# Field masse# End Type Graphics3D 1024,768,0,2 SetBuffer BackBuffer() SeedRnd MilliSecs() Bildtimer=CreateTimer(30) Global dichte#=1,geschw#=60,fakt#=0.001,x#=0 Local planet.objekt,move.objekt For i = 1 To 50 planet.objekt=New objekt planet\mesh=CreateSphere(32) planet\nummer=i planet\parent=0 planet\textur=0 planet\rotation#=Rnd(-0.05,0.05) scale#=Rnd(0.3,1) ScaleMesh planet\mesh,scale#,scale#,scale# planet\masse=MeshWidth(planet\mesh)MeshHeight(planet\mesh)MeshDepth(planet\mesh)dichte# PositionEntity planet\mesh,Rnd(-30,30),Rnd(-30,30),Rnd(10,30) RotateEntity planet\mesh,0,0,Rnd(-45,45) EntityRadius planet\mesh,scale# EntityType planet\mesh,3 Next camera = CreateCamera() light = CreateLight() RotateEntity light,40,-60,90 PositionEntity light,-10000,1000,100 AmbientLight 0,0,0 While Not KeyHit(1) Collisions 3, 3, 1, 2 UpdateWorld RenderWorld y=0 For planet.objekt = Each objekt y=y+1 For move.objekt = Each objekt y=y+1 dist#=EntityDistance(planet\mesh,move\mesh) xdist#=EntityX(move\mesh)-EntityX(planet\mesh) ydist#=EntityY(move\mesh)-EntityY(planet\mesh) zdist#=EntityZ(move\mesh)-EntityZ(planet\mesh) If ((move\masse)/dist#) <> "Infinity" Then TranslateEntity planet\mesh,((xdist#)((move\masse)/dist#)/(dist#planet\masse))fakt#geschw#,((ydist#)((move\masse)/dist#)/(dist#planet\masse))fakt#geschw#,((zdist#)((move\masse)/dist#)/(dist#planet\masse))fakt#*geschw#,1 EndIf TurnEntity planet\mesh,0,planet\rotation,0 If ((planet\masse)/dist#) <> "Infinity" Then Else EndIf Next Next For planet.objekt = Each objekt Color 255,255,255 CameraProject camera, EntityX(planet\mesh, 1), EntityY(planet\mesh, 1), EntityZ(planet\mesh, 1) Next Flip WaitTimer Bildtimer Ich finde deinen Skript um einiges besser und ausserdem ist meiner physikalisch total falsch. Vielleicht hast du ja lust ihn auszubauen Aufjedenfall großes Lob an deinen Skript, der ist allein schon ein ganz nettes Spielzeug^^
Llama 1 Llama 2 Llama 3 Vielen Dank an Pummelie, der mir auf seinem Server einen Platz für LlamaNet bietet.

Chrise

Betreff: Re: aahhh

So, Jun 29, 2008 19:46
Antworten mit Zitat

Hallo Hawkins!

Ich hatte da mal bevor ich deinen Skript gefunden habe auch mal bisschen rumprobiert:
Code: [AUSKLAPPEN]

Type objekt
Field nummer
Field mesh
Field parent
Field textur
Field rotation#
Field bewegung#
Field masse#
End Type

Graphics3D 1024,768,0,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Bildtimer=CreateTimer(30)
Global dichte#=1,geschw#=60,fakt#=0.001,x#=0
Local planet.objekt,move.objekt

For i = 1 To 50
planet.objekt=New objekt
planet\mesh=CreateSphere(32)
planet\nummer=i
planet\parent=0
planet\textur=0
planet\rotation#=Rnd(-0.05,0.05)
scale#=Rnd(0.3,1)
ScaleMesh planet\mesh,scale#,scale#,scale#
planet\masse=MeshWidth(planet\mesh)*MeshHeight(planet\mesh)*MeshDepth(planet\mesh)*dichte#
PositionEntity planet\mesh,Rnd(-30,30),Rnd(-30,30),Rnd(10,30)
RotateEntity planet\mesh,0,0,Rnd(-45,45)
EntityRadius planet\mesh,scale#
EntityType planet\mesh,3
Next

camera = CreateCamera()
light = CreateLight()
RotateEntity light,40,-60,90
PositionEntity light,-10000,1000,100
AmbientLight 0,0,0

While Not KeyHit(1)

Collisions 3, 3, 1, 2
UpdateWorld
RenderWorld

y=0

For planet.objekt = Each objekt
y=y+1
For move.objekt = Each objekt
   y=y+1
   dist#=EntityDistance(planet\mesh,move\mesh)
   xdist#=EntityX(move\mesh)-EntityX(planet\mesh)
   ydist#=EntityY(move\mesh)-EntityY(planet\mesh)
   zdist#=EntityZ(move\mesh)-EntityZ(planet\mesh)
   If ((move\masse)/dist#) <> "Infinity" Then
      TranslateEntity planet\mesh,((xdist#)*((move\masse)/dist#)/(dist#*planet\masse))*fakt#*geschw#,((ydist#)*((move\masse)/dist#)/(dist#*planet\masse))*fakt#*geschw#,((zdist#)*((move\masse)/dist#)/(dist#*planet\masse))*fakt#*geschw#,1
   EndIf
   TurnEntity planet\mesh,0,planet\rotation,0
   If ((planet\masse)/dist#) <> "Infinity" Then
   Else
   EndIf
Next
Next

For planet.objekt = Each objekt
Color 255,255,255
CameraProject camera, EntityX(planet\mesh, 1), EntityY(planet\mesh, 1), EntityZ(planet\mesh, 1)
Next

Flip
WaitTimer Bildtimer

Ich finde deinen Skript um einiges besser und ausserdem ist meiner physikalisch total falsch.
Vielleicht hast du ja lust ihn auszubauen Razz

Aufjedenfall großes Lob an deinen Skript, der ist allein schon ein ganz nettes Spielzeug^^

Llama 1 Llama 2 Llama 3
Vielen Dank an Pummelie, der mir auf seinem Server einen Platz für LlamaNet bietet.

	Hawkins Betreff: :)))	So, Jun 29, 2008 20:21 Antworten mit Zitat
Vielen dank fürs Lob. Leider ist die Sache mit dieser Simulation erstmal auf Eis gelegt. Ich muss mich fürs Studium voll auf C/C++ konzentrieren und hab' da leider eh keine Zeit mehr. Ich hoffe, dass es bald weniger Stressig ist und ich überhaqupt mal wieder was mit blitz machen kann. Hmm das mit Blitz3d hatte ich mir mal überlegt anzufangen, aber hab dann gemerkt dass es selbst 2d schon kompliziert genug ist ^^

Hawkins

Betreff: :)))

So, Jun 29, 2008 20:21
Antworten mit Zitat

Vielen dank fürs Lob.
Leider ist die Sache mit dieser Simulation erstmal auf Eis gelegt. Ich muss mich fürs Studium voll auf C/C++ konzentrieren und hab' da leider eh keine Zeit mehr.
Ich hoffe, dass es bald weniger Stressig ist und ich überhaqupt mal wieder was mit blitz machen kann.
Hmm das mit Blitz3d hatte ich mir mal überlegt anzufangen, aber hab dann gemerkt dass es selbst 2d schon kompliziert genug ist ^^

	Noobody	Mo, Jun 30, 2008 14:12 Antworten mit Zitat
Ich habe mir heute morgen erlaubt, das ganze mal auf 3D umzuschreiben. Sieht ganz spassig aus, läuft auch ein wenig schneller, weil Oval grausig langsam ist. Das ganze läuft mit einem Singlesurface - Partikelsystem (Kugeln wären hier reiner Performance - Selbstmord). Code: [AUSKLAPPEN] [EINKLAPPEN] Const GWIDTH = 800 Const GHEIGHT = 600 Graphics3D GWIDTH, GHEIGHT, 0, 2 SetBuffer BackBuffer() Const INNER_FRICTION# = 1 SeedRnd MilliSecs() Global EndMsg$ = "Escape to Quit, H for Helpmenu " Global Scale# = 10, XOffset, YOffset Global Help Global XMasstotal, YMasstotal, XPulstotal, YPulstotal, Masstotal Global Red = 255, Green = 255, Blue = 255, Newmass = 50 Global Colorcycle Global Counter = MilliSecs() Global Cam = CreateCamera() Global ParticleMesh, ParticleSurface CameraRange Cam, 0.1, 10000 Type Masspoint Field X# Field Y# Field Z# Field VX# Field VY# Field VZ# Field Mass = 10 Field R = 255 Field G = 255 Field B = 255 Field Status ; Status: 1 = Fixiert, 2 = Kann keine anderen aufnehmen Field Radius# Field Vertex End Type InitParticles( Cam ) InitMass() Timer = CreateTimer( 60 ) While Not KeyHit(1) Cls MoveEntity Cam, KeyDown( 205 ) - KeyDown( 203 ), 0, KeyDown( 200 ) - KeyDown( 208 ) TurnEntity Cam, MouseYSpeed(), -MouseXSpeed(), MouseDown( 1 ) MoveMouse 400, 300 UpdateParticles() RenderWorld Control() Update() DrawInterface() WaitTimer Timer Flip 0 Wend End Function InitParticles( Camera ) ParticleMesh = CreateMesh() ParticleSurface = CreateSurface( ParticleMesh ) EntityParent ParticleMesh, Camera EntityFX ParticleMesh, 2 ; Bild erstellen, abspeichern, als Textur mit Alpha laden und wieder löschen. Wegen Problemen mit gewissen Grafikkarten ; (u.a. meiner) ist das On-the-fly erstellen von Texturen mit Alpha nicht möglich. TempImage = CreateImage( 64, 64 ) SetBuffer ImageBuffer( TempImage ) Oval 0, 0, 64, 64 SetBuffer BackBuffer() SaveBuffer ImageBuffer( TempImage ), "Temp.bmp" ParticleTexture = LoadTexture( "Temp.bmp", 4 ) EntityTexture ParticleMesh, ParticleTexture DeleteFile "Temp.bmp" End Function Function DrawInterface() Color 255, 255, 255 If Help Then ShowHelp() Text GWIDTH - StringWidth( EndMsg$ ), GHEIGHT - StringHeight( EndMsg$ ), EndMsg$ Text 16, GHEIGHT - 15, "Mass: " + Newmass Oval 2, GHEIGHT - 14, 12, 12, 1 Color Red, Green, Blue Oval 3, GHEIGHT - 13, 10, 10, 1 End Function Function Showhelp() Local Y = 100, LineHeight = StringHeight( "I" ) Text 100, Y + 0LineHeight, " num + Zoom in" Text 100, Y + 1LineHeight," num - Zoom out" Text 100, Y + 2LineHeight," up Scroll Up" Text 100, Y + 3LineHeight," down Scroll Down" Text 100, Y + 4LineHeight," left Scroll Left" Text 100, Y + 5LineHeight," right Scroll Right" Text 100, Y + 6LineHeight," pos1 Center Scroll" Text 100, Y + 7LineHeight," H Toggle Help" Text 100, Y + 8LineHeight," Space Restart" Text 100, Y + 9LineHeight," Enter Add Masspoints" Text 100, Y + 10LineHeight," BackSpace Delete all Masspoints" Text 100, Y + 11LineHeight," Q Create simple Sunsystem (for debug)" Text 100, Y + 12LineHeight,"Mousebutton 1 Set Masspoints" Text 100, Y + 13LineHeight,"Mousebutton 2 Change Masspointcolor" Text 100, Y + 14LineHeight,"Mousebutton 3 Set Virtual-Masspoint" Text 100, Y + 15LineHeight," , - Mass " Text 100, Y + 16LineHeight," . + Mass " Text 100, Y + 17LineHeight," A Calibrate Inertial-System " Me$ = "by M. Schuster (hallegang@gmx.de) and Noobody (Please@DontEMailMe.com)" Text GWIDTH - StringWidth( Me$ ) - 5, GHEIGHT - StringHeight( Me$ )2 - 5, Me$ End Function Function Control() If KeyHit( 57 ) Then Delete Each Masspoint Initmass() ; Space -> Initialisierung EndIf If KeyHit( 28 ) Then Initmass() ; Neue Massepunkte If KeyDown( 74 ) Then Scale# = Scale#/1.0499 ;Minus Zoom Out If KeyDown( 78 ) Then Scale# = Scale#1.05 ;Plus Zoom In If KeyDown( 200 ) Then YOffset = YOffset + 10/Scale# If KeyDown( 208 ) Then YOffset = YOffset - 10/Scale# If KeyDown( 203 ) Then XOffset = XOffset + 10/Scale# If KeyDown( 205 ) Then XOffset = XOffset - 10/Scale# If KeyHit( 199 ) Then XOffset = 0 YOffset = 0 Scale# = 0.5 ResetInertial() EndIf If KeyHit( 35 ) Then Help = Not Help If KeyHit( 14 ) Then Delete Each Masspoint ClearSurface ParticleSurface EndIf If KeyHit( 16 ) Then Debuginit() If KeyHit( 30 ) Then ResetInertial() If MouseHit( 2 ) Then NextColor() If MouseHit( 1 ) Then CreateMasspoint() If MouseHit( 3 ) Then CreateMasspoint( 3 ) If KeyDown( 51 ) And Newmass >= 100 Then Newmass = Newmass/1.009 If KeyDown( 52 ) And Newmass >= 100 Then Newmass = Newmass1.01 If KeyDown( 51 ) And Newmass < 100 Then Newmass = Newmass - 1 If KeyDown( 52 ) And Newmass < 100 Then Newmass = Newmass + 1 If Newmass <= 0 Then Newmass = 1 End Function Function ResetInertial() ; Ich hab keine Ahnung, für was das gut sein soll, darum hab ichs nicht an 3D angepasst :) For M.Masspoint = Each Masspoint M\VX# = M\VX# - XPulstotal/Masstotal M\VY# = M\VX# - YPulstotal/Masstotal M\X# = M\X# - XMasstotal/Masstotal M\Y# = M\Y# - XMasstotal/Masstotal Next End Function Function NextColor() ColorCycle = ( ColorCycle + 1 ) Mod 8 Select ColorCycle Case 0 Red=0 Green=0 Blue=0 Case 1 Red = 255 Green = 0 Blue = 0 Case 2 Red = 255 Green = 255 Blue = 0 Case 3 Red = 0 Green = 255 Blue = 0 Case 4 Red = 0 Green = 255 Blue = 255 Case 5 Red = 0 Green = 0 Blue = 255 Case 6 Red = 255 Green = 0 Blue = 255 Case 7 Red = 255 Green = 255 Blue = 255 End Select End Function Function CreateMasspoint( Stat = 0 ) M.Masspoint = New Masspoint M\x# = ( MouseX() - GWIDTH/2 )/Scale# - XOffset M\y# = ( MouseY() - GHEIGHT/2 )/Scale# - YOffset M\Mass = Newmass M\R = Red M\G = Green M\B = Blue M\Status = Stat M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 ) AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 ) AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 ) End Function Function DebugInit() M.Masspoint = New Masspoint M\Mass = 5000 M\R = 255 M\G = 240 M\B = 64 M.Masspoint = New Masspoint M\Y# = -50 M\VX# = 10 M\Mass# = 5 M\R = 255 M\G = 0 M\B = 0 M.Masspoint = New Masspoint M\Y# = -100 M\VX# = 7 M\Mass = 100 M\R = 255 M\G = 127 M\B = 127 M.Masspoint = New Masspoint M\Y# = 420 M\VX# = -3 M\Mass = 470 M\R = 0 M\G = 255 M\B = 255 M.Masspoint = New Masspoint M\Y# = 450 M\VX# = -6.8 M\Mass = 30 M\R = 255 M\G = 255 M\B = 255 Counter = MilliSecs() - 10000 ; Wir gaukeln der UpdateParticles - Funktion vor, es müsse die Oberfläche neu erstellen. Dadurch ; sparen wir hier die paar Befehle zum hinzufügen des Quads (ja, ich bin faul heute) End Function Function Initmass() For i = 0 To 300 M.Masspoint = New Masspoint M\X# = Rnd( -300, 300 ) M\Y# = Rnd( -300, 300 ) M\Z# = Rnd( -300, 300 ) M\VX# = Rnd( -5, 5 ) M\VY# = Rnd( -5, 5 ) M\VZ# = Rnd( -5, 5 ) M\Mass = Rnd( 5, 100 ) M\R = Rnd( 0, 255 ) M\G = Rnd( 0, 255 ) M\B = Rnd( 0, 255 ) M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 ) VertexColor ParticleSurface, M\Vertex + 0, M\R, M\G, M\B VertexColor ParticleSurface, M\Vertex + 1, M\R, M\G, M\B AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 ) AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 ) Next End Function Function Update() XMasstotal = 0 YMasstotal = 0 XPulstotal = 0 YPulstotal = 0 Masstotal = 0 For M1.Masspoint = Each Masspoint If Not( M1\Status And 1 ) Then M1\X# = M1\X# + M1\VX# M1\Y# = M1\Y# + M1\VY# M1\Z# = M1\Z# + M1\VZ# EndIf If Not M1\Radius# Then M1\Radius# = Sqr( M1\Mass/Pi ) ; Weil die Dichte des Planeten ja eins ist For M2.Masspoint = Each Masspoint If M1 <> M2 Then DX# = M2\X# - M1\X# DY# = M2\Y# - M1\Y# DZ# = M2\Z# - M1\Z# If Not M2\Radius# Then M2\Radius# = Sqr( M2\Mass/Pi ) Distance# = Sqr( DX#DX# + DY#DY# + DZ#DZ# ) If Distance# < ( M1\Radius# + M2\Radius# ) Then If ( M1\Status Or M2\Status ) And 2 Then F# = M1\MassM2\MassDistance#/( ( M1\Radius# + M2\Radius# )( M1\Radius# + M2\Radius# )( M1\Radius# + M2\Radius# ) ) Else Fusion( M1, M2 ) ;Bounce( M1, M2 ) ; Ziemlich Buggy und hässlich und so End If Else F# = ( M1\MassM2\Mass )/( Distance#Distance# ) EndIf FX# = F#( DX#/Distance# ) FY# = F#( DY#/Distance# ) FZ# = F#( DZ#/Distance# ) M1\VX# = M1\VX# + FX#/M1\Mass M1\VY# = M1\VY# + FY#/M1\Mass M1\VZ# = M1\VZ# + FZ#/M1\Mass EndIf Next XMasstotal = XMasstotal + M1\X#M1\Mass YMasstotal = YMasstotal + M1\Y#M1\Mass XPulstotal = XPulstotal + M1\VX#M1\Mass YPulstotal = YPulstotal + M1\VY#M1\Mass Masstotal = Masstotal + M1\Mass Next End Function Function Bounce( M1.Masspoint, M2.Masspoint) M1\X# = M1\X# - M1\VX# M1\Y# = M1\Y# - M1\VY# M1\Z# = M1\Z# - M1\VZ# M2\X# = M2\X# - M2\VX# M2\Y# = M2\Y# - M2\VY# M2\Z# = M2\Z# - M2\VZ# Factor# = M1\Mass/M2\Mass FactorInv# = M2\Mass/M1\Mass TempX# = M1\VX# TempY# = M1\VY# TempZ# = M1\VZ# M1\VX# = M2\VX#FactorInv#INNER_FRICTION# M1\VY# = M2\VY#FactorInv#INNER_FRICTION# M1\VZ# = M2\VZ#FactorInv#INNER_FRICTION# M2\VX# = TempX#Factor#INNER_FRICTION# M2\VY# = TempY#Factor#INNER_FRICTION# M2\VZ# = TempZ#Factor#INNER_FRICTION# M1\X# = M1\X# + M1\VX# M1\Y# = M1\Y# + M1\VY# M1\Z# = M1\Z# + M1\VZ# M2\X# = M2\X# + M2\VX# M2\Y# = M2\Y# + M2\VY# M2\Z# = M2\Z# + M2\VZ# End Function Function Fusion( M1.Masspoint, M2.Masspoint ) M1\VX# = ( M1\VX# M1\Mass + M2\VX# * M2\Mass )/( M1\Mass + M2\Mass ) M1\VY# = ( M1\VY# * M1\Mass + M2\VY# * M2\Mass )/( M1\Mass + M2\Mass ) M1\VZ# = ( M1\VZ# * M1\Mass + M2\VZ# * M2\Mass )/( M1\Mass + M2\Mass ) M1\X# = M1\X# + ( M2\X# - M1\X#)M2\Mass/( M1\Mass + M2\Mass ) M1\Y# = M1\Y# + ( M2\Y# - M1\Y#)M2\Mass/( M1\Mass + M2\Mass ) M1\Z# = M1\Z# + ( M2\Z# - M1\Z#)M2\Mass/( M1\Mass + M2\Mass ) M1\R = ( M1\RM1\Mass + M2\RM2\Mass )/( M1\Mass + M2\Mass) M1\G = ( M1\GM1\Mass + M2\GM2\Mass )/( M1\Mass + M2\Mass) M1\B = ( M1\BM1\Mass + M2\BM2\Mass )/( M1\Mass + M2\Mass) M1\Mass = M1\Mass + M2\Mass M1\Status = M1\Status Or M2\Status M1\Radius# = Sqr( M1\Mass/Pi ) VertexCoords ParticleSurface, M2\Vertex + 0, -5000, -5000, -5000 VertexCoords ParticleSurface, M2\Vertex + 1, -5000, -5000, -5000 VertexCoords ParticleSurface, M2\Vertex + 2, -5000, -5000, -5000 VertexCoords ParticleSurface, M2\Vertex + 3, -5000, -5000, -5000 VertexColor ParticleSurface, M1\Vertex + 0, M1\R, M1\G, M1\B VertexColor ParticleSurface, M1\Vertex + 1, M1\R, M1\G, M1\B Delete M2 End Function Function UpdateParticles() If MilliSecs() - Counter > 10000 Then ClearSurface ParticleSurface For M.Masspoint = Each Masspoint M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 ) AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 ) VertexColor ParticleSurface, M\Vertex + 0, M\R, M\G, M\B VertexColor ParticleSurface, M\Vertex + 1, M\R, M\G, M\B AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 ) AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 ) Next Counter = MilliSecs() EndIf For Particle.Masspoint = Each Masspoint TFormPoint Particle\X#/Scale#, Particle\Y#/Scale#, Particle\Z#/Scale#, 0, ParticleMesh VertexCoords ParticleSurface, Particle\Vertex + 0, TFormedX() - Particle\Radius/( 2Scale# ), TFormedY() - Particle\Radius/( 2Scale# ), TFormedZ() VertexCoords ParticleSurface, Particle\Vertex + 1, TFormedX() + Particle\Radius/( 2Scale# ), TFormedY() - Particle\Radius/( 2Scale# ), TFormedZ() VertexCoords ParticleSurface, Particle\Vertex + 2, TFormedX() + Particle\Radius/( 2Scale# ), TFormedY() + Particle\Radius/( 2Scale# ), TFormedZ() VertexCoords ParticleSurface, Particle\Vertex + 3, TFormedX() - Particle\Radius/( 2Scale# ), TFormedY() + Particle\Radius/( 2*Scale# ), TFormedZ() Next End Function Ich hab ausserdem versucht, eine Bouncefunktion einzubauen, aber sie funktioniert nicht wirklich (es bilden sich mit der Zeit nur noch zuckende Kugelhaufen). Weil beim Codepasten Tabulatoren druch Leerzeichen entfernt werden, kann man sich das ganze hier im Originalzustand herunterladen. Viel Spass damit.
Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun

Noobody

Mo, Jun 30, 2008 14:12
Antworten mit Zitat

Ich habe mir heute morgen erlaubt, das ganze mal auf 3D umzuschreiben.
Sieht ganz spassig aus, läuft auch ein wenig schneller, weil Oval grausig langsam ist.
Das ganze läuft mit einem Singlesurface - Partikelsystem (Kugeln wären hier reiner Performance - Selbstmord).

Code: [AUSKLAPPEN]

Const GWIDTH = 800
Const GHEIGHT = 600
Graphics3D GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Const INNER_FRICTION# = 1

SeedRnd MilliSecs()
Global EndMsg$ = "Escape to Quit, H for Helpmenu "
Global Scale# = 10, XOffset, YOffset
Global Help
Global XMasstotal, YMasstotal, XPulstotal, YPulstotal, Masstotal
Global Red = 255, Green = 255, Blue = 255, Newmass = 50
Global Colorcycle
Global Counter = MilliSecs()

Global Cam = CreateCamera()
Global ParticleMesh, ParticleSurface

CameraRange Cam, 0.1, 10000

Type Masspoint
Field X#
Field Y#
Field Z#
Field VX#
Field VY#
Field VZ#
Field Mass = 10
Field R = 255
Field G = 255
Field B = 255
Field Status ; Status: 1 = Fixiert, 2 = Kann keine anderen aufnehmen

Field Radius#
Field Vertex
End Type

InitParticles( Cam )
InitMass()

Timer = CreateTimer( 60 )

While Not KeyHit(1)
Cls

MoveEntity Cam, KeyDown( 205 ) - KeyDown( 203 ), 0, KeyDown( 200 ) - KeyDown( 208 )
TurnEntity Cam, MouseYSpeed(), -MouseXSpeed(), MouseDown( 1 )
MoveMouse 400, 300

UpdateParticles()

RenderWorld

Control()
Update()
DrawInterface()

WaitTimer Timer
Flip 0
Wend

End

Function InitParticles( Camera )
ParticleMesh = CreateMesh()
ParticleSurface = CreateSurface( ParticleMesh )

EntityParent ParticleMesh, Camera
EntityFX ParticleMesh, 2

; Bild erstellen, abspeichern, als Textur mit Alpha laden und wieder löschen. Wegen Problemen mit gewissen Grafikkarten
; (u.a. meiner) ist das On-the-fly erstellen von Texturen mit Alpha nicht möglich.
TempImage = CreateImage( 64, 64 )

SetBuffer ImageBuffer( TempImage )
Oval 0, 0, 64, 64
SetBuffer BackBuffer()
SaveBuffer ImageBuffer( TempImage ), "Temp.bmp"

ParticleTexture = LoadTexture( "Temp.bmp", 4 )
EntityTexture ParticleMesh, ParticleTexture

DeleteFile "Temp.bmp"
End Function

Function DrawInterface()
Color 255, 255, 255

If Help Then ShowHelp()

Text GWIDTH - StringWidth( EndMsg$ ), GHEIGHT - StringHeight( EndMsg$ ), EndMsg$
Text 16, GHEIGHT - 15, "Mass: " + Newmass
Oval 2, GHEIGHT - 14, 12, 12, 1
Color Red, Green, Blue
Oval 3, GHEIGHT - 13, 10, 10, 1
End Function

Function Showhelp()
Local Y = 100, LineHeight = StringHeight( "I" )
Text 100, Y + 0*LineHeight, " num + Zoom in"
Text 100, Y + 1*LineHeight," num - Zoom out"
Text 100, Y + 2*LineHeight," up Scroll Up"
Text 100, Y + 3*LineHeight," down Scroll Down"
Text 100, Y + 4*LineHeight," left Scroll Left"
Text 100, Y + 5*LineHeight," right Scroll Right"
Text 100, Y + 6*LineHeight," pos1 Center Scroll"
Text 100, Y + 7*LineHeight," H Toggle Help"
Text 100, Y + 8*LineHeight," Space Restart"
Text 100, Y + 9*LineHeight," Enter Add Masspoints"
Text 100, Y + 10*LineHeight," BackSpace Delete all Masspoints"
Text 100, Y + 11*LineHeight," Q Create simple Sunsystem (for debug)"
Text 100, Y + 12*LineHeight,"Mousebutton 1 Set Masspoints"
Text 100, Y + 13*LineHeight,"Mousebutton 2 Change Masspointcolor"
Text 100, Y + 14*LineHeight,"Mousebutton 3 Set Virtual-Masspoint"
Text 100, Y + 15*LineHeight," , - Mass "
Text 100, Y + 16*LineHeight," . + Mass "
Text 100, Y + 17*LineHeight," A Calibrate Inertial-System "
Me$ = "by M. Schuster (hallegang@gmx.de) and Noobody (Please@DontEMailMe.com)"
Text GWIDTH - StringWidth( Me$ ) - 5, GHEIGHT - StringHeight( Me$ )*2 - 5, Me$
End Function

Function Control()
If KeyHit( 57 ) Then
   Delete Each Masspoint
   Initmass() ; Space -> Initialisierung
EndIf
If KeyHit( 28 ) Then Initmass() ; Neue Massepunkte
If KeyDown( 74 ) Then Scale# = Scale#/1.0499 ;Minus Zoom Out
If KeyDown( 78 ) Then Scale# = Scale#*1.05    ;Plus Zoom In
If KeyDown( 200 ) Then YOffset = YOffset + 10/Scale#
If KeyDown( 208 ) Then YOffset = YOffset - 10/Scale#
If KeyDown( 203 ) Then XOffset = XOffset + 10/Scale#
If KeyDown( 205 ) Then XOffset = XOffset - 10/Scale#
If KeyHit( 199 ) Then
   XOffset = 0
   YOffset = 0
   Scale# = 0.5
   ResetInertial()
EndIf
If KeyHit( 35 ) Then Help = Not Help
If KeyHit( 14 ) Then
   Delete Each Masspoint
   ClearSurface ParticleSurface
EndIf
If KeyHit( 16 ) Then Debuginit()
If KeyHit( 30 ) Then ResetInertial()
If MouseHit( 2 ) Then NextColor()
If MouseHit( 1 ) Then CreateMasspoint()
If MouseHit( 3 ) Then CreateMasspoint( 3 )
If KeyDown( 51 ) And Newmass >= 100 Then Newmass = Newmass/1.009
If KeyDown( 52 ) And Newmass >= 100 Then Newmass = Newmass*1.01
If KeyDown( 51 ) And Newmass < 100 Then Newmass = Newmass - 1
If KeyDown( 52 ) And Newmass < 100 Then Newmass = Newmass + 1
If Newmass <= 0 Then Newmass = 1
End Function

Function ResetInertial() ; Ich hab keine Ahnung, für was das gut sein soll, darum hab ichs nicht an 3D angepasst :)
For M.Masspoint = Each Masspoint
   M\VX# = M\VX# - XPulstotal/Masstotal
   M\VY# = M\VX# - YPulstotal/Masstotal
   M\X# = M\X# - XMasstotal/Masstotal
   M\Y# = M\Y# - XMasstotal/Masstotal
Next
End Function

Function NextColor()
ColorCycle = ( ColorCycle + 1 ) Mod 8
Select ColorCycle
   Case 0
      Red=0
      Green=0
      Blue=0
   Case 1
      Red = 255
      Green = 0
      Blue = 0
   Case 2
      Red = 255
      Green = 255
      Blue = 0
   Case 3
      Red = 0
      Green = 255
      Blue = 0
   Case 4
      Red = 0
      Green = 255
      Blue = 255
   Case 5
      Red = 0
      Green = 0
      Blue = 255
   Case 6
      Red = 255
      Green = 0
      Blue = 255
   Case 7
      Red = 255
      Green = 255
      Blue = 255
End Select
End Function

Function CreateMasspoint( Stat = 0 )
M.Masspoint = New Masspoint
M\x# = ( MouseX() - GWIDTH/2 )/Scale# - XOffset
M\y# = ( MouseY() - GHEIGHT/2 )/Scale# - YOffset
M\Mass = Newmass
M\R = Red
M\G = Green
M\B = Blue
M\Status = Stat
M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 )
         AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 )
         AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 )
         AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 )
AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 )
AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 )
End Function

Function DebugInit()
M.Masspoint = New Masspoint
M\Mass = 5000
M\R = 255
M\G = 240
M\B = 64

M.Masspoint = New Masspoint
M\Y# = -50
M\VX# = 10
M\Mass# = 5
M\R = 255
M\G = 0
M\B = 0

M.Masspoint = New Masspoint
M\Y# = -100
M\VX# = 7
M\Mass = 100
M\R = 255
M\G = 127
M\B = 127

M.Masspoint = New Masspoint
M\Y# = 420
M\VX# = -3
M\Mass = 470
M\R = 0
M\G = 255
M\B = 255

M.Masspoint = New Masspoint
M\Y# = 450
M\VX# = -6.8
M\Mass = 30
M\R = 255
M\G = 255
M\B = 255

Counter = MilliSecs() - 10000 ; Wir gaukeln der UpdateParticles - Funktion vor, es müsse die Oberfläche neu erstellen. Dadurch
                        ; sparen wir hier die paar Befehle zum hinzufügen des Quads (ja, ich bin faul heute)
End Function

Function Initmass()
For i = 0 To 300
   M.Masspoint = New Masspoint
   M\X# = Rnd( -300, 300 )
   M\Y# = Rnd( -300, 300 )
   M\Z# = Rnd( -300, 300 )

   M\VX# = Rnd( -5, 5 )
   M\VY# = Rnd( -5, 5 )
   M\VZ# = Rnd( -5, 5 )
   M\Mass = Rnd( 5, 100 )
   M\R = Rnd( 0, 255 )
   M\G = Rnd( 0, 255 )
   M\B = Rnd( 0, 255 )

   M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 )
            AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 )
            AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 )
            AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 )

   VertexColor ParticleSurface, M\Vertex + 0, M\R, M\G, M\B
   VertexColor ParticleSurface, M\Vertex + 1, M\R, M\G, M\B

   AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 )
   AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 )
Next
End Function

Function Update()
XMasstotal = 0
YMasstotal = 0
XPulstotal = 0
YPulstotal = 0
Masstotal = 0
For M1.Masspoint = Each Masspoint
   If Not( M1\Status And 1 ) Then
      M1\X# = M1\X# + M1\VX#
      M1\Y# = M1\Y# + M1\VY#
      M1\Z# = M1\Z# + M1\VZ#
   EndIf

   If Not M1\Radius# Then M1\Radius# = Sqr( M1\Mass/Pi ) ; Weil die Dichte des Planeten ja eins ist
   For M2.Masspoint = Each Masspoint
      If M1 <> M2 Then
         DX# = M2\X# - M1\X#
         DY# = M2\Y# - M1\Y#
         DZ# = M2\Z# - M1\Z#
         If Not M2\Radius# Then M2\Radius# = Sqr( M2\Mass/Pi )
         Distance# = Sqr( DX#*DX# + DY#*DY# + DZ#*DZ# )

         If Distance# < ( M1\Radius# + M2\Radius# ) Then
            If ( M1\Status Or M2\Status ) And 2 Then
               F# = M1\Mass*M2\Mass*Distance#/( ( M1\Radius# + M2\Radius# )*( M1\Radius# + M2\Radius# )*( M1\Radius# + M2\Radius# ) )
            Else
               Fusion( M1, M2 )
               ;Bounce( M1, M2 ) ; Ziemlich Buggy und hässlich und so
            End If
         Else
            F# = ( M1\Mass*M2\Mass )/( Distance#*Distance# )
         EndIf
         FX# = F#*( DX#/Distance# )
         FY# = F#*( DY#/Distance# )
         FZ# = F#*( DZ#/Distance# )
         M1\VX# = M1\VX# + FX#/M1\Mass
         M1\VY# = M1\VY# + FY#/M1\Mass
         M1\VZ# = M1\VZ# + FZ#/M1\Mass
      EndIf
   Next
   XMasstotal = XMasstotal + M1\X#*M1\Mass
   YMasstotal = YMasstotal + M1\Y#*M1\Mass
   XPulstotal = XPulstotal + M1\VX#*M1\Mass
   YPulstotal = YPulstotal + M1\VY#*M1\Mass
   Masstotal = Masstotal + M1\Mass
Next
End Function

Function Bounce( M1.Masspoint, M2.Masspoint)
M1\X# = M1\X# - M1\VX#
M1\Y# = M1\Y# - M1\VY#
M1\Z# = M1\Z# - M1\VZ#
M2\X# = M2\X# - M2\VX#
M2\Y# = M2\Y# - M2\VY#
M2\Z# = M2\Z# - M2\VZ#

Factor# = M1\Mass/M2\Mass
FactorInv# = M2\Mass/M1\Mass
TempX# = M1\VX#
TempY# = M1\VY#
TempZ# = M1\VZ#
M1\VX# = M2\VX#*FactorInv#*INNER_FRICTION#
M1\VY# = M2\VY#*FactorInv#*INNER_FRICTION#
M1\VZ# = M2\VZ#*FactorInv#*INNER_FRICTION#
M2\VX# = TempX#*Factor#*INNER_FRICTION#
M2\VY# = TempY#*Factor#*INNER_FRICTION#
M2\VZ# = TempZ#*Factor#*INNER_FRICTION#

M1\X# = M1\X# + M1\VX#
M1\Y# = M1\Y# + M1\VY#
M1\Z# = M1\Z# + M1\VZ#
M2\X# = M2\X# + M2\VX#
M2\Y# = M2\Y# + M2\VY#
M2\Z# = M2\Z# + M2\VZ#
End Function

Function Fusion( M1.Masspoint, M2.Masspoint )
M1\VX# = ( M1\VX# * M1\Mass + M2\VX# * M2\Mass )/( M1\Mass + M2\Mass )
M1\VY# = ( M1\VY# * M1\Mass + M2\VY# * M2\Mass )/( M1\Mass + M2\Mass )
M1\VZ# = ( M1\VZ# * M1\Mass + M2\VZ# * M2\Mass )/( M1\Mass + M2\Mass )
M1\X# = M1\X# + ( M2\X# - M1\X#)*M2\Mass/( M1\Mass + M2\Mass )
M1\Y# = M1\Y# + ( M2\Y# - M1\Y#)*M2\Mass/( M1\Mass + M2\Mass )
M1\Z# = M1\Z# + ( M2\Z# - M1\Z#)*M2\Mass/( M1\Mass + M2\Mass )
M1\R = ( M1\R*M1\Mass + M2\R*M2\Mass )/( M1\Mass + M2\Mass)
M1\G = ( M1\G*M1\Mass + M2\G*M2\Mass )/( M1\Mass + M2\Mass)
M1\B = ( M1\B*M1\Mass + M2\B*M2\Mass )/( M1\Mass + M2\Mass)
M1\Mass = M1\Mass + M2\Mass
M1\Status = M1\Status Or M2\Status
M1\Radius# = Sqr( M1\Mass/Pi )

VertexCoords ParticleSurface, M2\Vertex + 0, -5000, -5000, -5000
VertexCoords ParticleSurface, M2\Vertex + 1, -5000, -5000, -5000
VertexCoords ParticleSurface, M2\Vertex + 2, -5000, -5000, -5000
VertexCoords ParticleSurface, M2\Vertex + 3, -5000, -5000, -5000

VertexColor ParticleSurface, M1\Vertex + 0, M1\R, M1\G, M1\B
VertexColor ParticleSurface, M1\Vertex + 1, M1\R, M1\G, M1\B

Delete M2
End Function

Function UpdateParticles()
If MilliSecs() - Counter > 10000 Then
   ClearSurface ParticleSurface

   For M.Masspoint = Each Masspoint
      M\Vertex = AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 1 )
               AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 1 )
               AddVertex( ParticleSurface, -5000, -5000, -5000, 1, 0 )
               AddVertex( ParticleSurface, -5000, -5000, -5000, 0, 0 )

      VertexColor ParticleSurface, M\Vertex + 0, M\R, M\G, M\B
      VertexColor ParticleSurface, M\Vertex + 1, M\R, M\G, M\B

      AddTriangle( ParticleSurface, M\Vertex + 0, M\Vertex + 2, M\Vertex + 1 )
      AddTriangle( ParticleSurface, M\Vertex + 3, M\Vertex + 2, M\Vertex + 0 )
   Next

   Counter = MilliSecs()
EndIf

For Particle.Masspoint = Each Masspoint
   TFormPoint Particle\X#/Scale#, Particle\Y#/Scale#, Particle\Z#/Scale#, 0, ParticleMesh

   VertexCoords ParticleSurface, Particle\Vertex + 0, TFormedX() - Particle\Radius/( 2*Scale# ), TFormedY() - Particle\Radius/( 2*Scale# ), TFormedZ()
   VertexCoords ParticleSurface, Particle\Vertex + 1, TFormedX() + Particle\Radius/( 2*Scale# ), TFormedY() - Particle\Radius/( 2*Scale# ), TFormedZ()
   VertexCoords ParticleSurface, Particle\Vertex + 2, TFormedX() + Particle\Radius/( 2*Scale# ), TFormedY() + Particle\Radius/( 2*Scale# ), TFormedZ()
   VertexCoords ParticleSurface, Particle\Vertex + 3, TFormedX() - Particle\Radius/( 2*Scale# ), TFormedY() + Particle\Radius/( 2*Scale# ), TFormedZ()
Next
End Function

Ich hab ausserdem versucht, eine Bouncefunktion einzubauen, aber sie funktioniert nicht wirklich (es bilden sich mit der Zeit nur noch zuckende Kugelhaufen).
Weil beim Codepasten Tabulatoren druch Leerzeichen entfernt werden, kann man sich das ganze hier im Originalzustand herunterladen.
Viel Spass damit.

Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun

	Chrise	Mo, Jun 30, 2008 14:44 Antworten mit Zitat
Okay Hawkins, viel Erfolg @Noobody: Sieht nett aus ja^^ Leider verliert man etwas den Überblick, was auch logisch ist, aber man merkt eben nicht mehr so stark, wie alle Punkte an einen größeren gezogen werden.nice isses trotzdem Gute Arbeit
Llama 1 Llama 2 Llama 3 Vielen Dank an Pummelie, der mir auf seinem Server einen Platz für LlamaNet bietet.

Chrise

Mo, Jun 30, 2008 14:44
Antworten mit Zitat

Okay Hawkins, viel Erfolg Smile

@Noobody:
Sieht nett aus ja^^
Leider verliert man etwas den Überblick, was auch logisch ist, aber man merkt eben nicht mehr so stark, wie alle Punkte an einen größeren gezogen werden.nice isses trotzdem Wink

Gute Arbeit

Llama 1 Llama 2 Llama 3
Vielen Dank an Pummelie, der mir auf seinem Server einen Platz für LlamaNet bietet.

	Hawkins	Mo, Jun 30, 2008 17:05 Antworten mit Zitat
Oh absolut interessant. Es bilden sich viel viel mehr stabile umlaufbahnen. Ist ja eigentlich logisch, da in die 3te Dimension ja nun auch noch Platz frei ist, während bei 2d die kollisionen ja übermäßig stark sind. aber das wird mir erst jetzt bewusst wo ich das in 3d sehe, wie groß der unterschied ist. Ach, die FUnction ResetInertial war dazu da, um den gesamt-impuls des systems auf null zu setzen. also am besten kann man es erklären an einem extremfall: würde alle planeten nach links fliegen (einer mit 200m/s und der andere mit 210m/s)(beide gleiche masse) dann würde sie nach dem ausführen der funktion anders fliegen. der eine mit 5m/s nach rechts und der andere mit 5m/s nach links.

Hawkins

Mo, Jun 30, 2008 17:05
Antworten mit Zitat

Oh absolut interessant.
Es bilden sich viel viel mehr stabile umlaufbahnen. Ist ja eigentlich logisch, da in die 3te Dimension ja nun auch noch Platz frei ist, während bei 2d die kollisionen ja übermäßig stark sind. aber das wird mir erst jetzt bewusst wo ich das in 3d sehe, wie groß der unterschied ist.
Ach, die FUnction ResetInertial war dazu da, um den gesamt-impuls des systems auf null zu setzen.
also am besten kann man es erklären an einem extremfall: würde alle planeten nach links fliegen (einer mit 200m/s und der andere mit 210m/s)(beide gleiche masse) dann würde sie nach dem ausführen der funktion anders fliegen. der eine mit 5m/s nach rechts und der andere mit 5m/s nach links.

Übersicht

BlitzBasic

Codearchiv

Nach Oben

BlitzBasic Portal

Planeten- bzw. Massepunktsimulation, Gravitationssimulation

Betreff: Planeten- bzw. Massepunktsimulation, Gravitationssimulation

Betreff: So, das ist ne bessere Version mit GUI und neuer Physik

Betreff: aahhh

Betreff: Re: aahhh

Betreff: :)))