PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Simulation von Massen und Anziehungskräften (ohne flackern)

https://www.purebasic.fr/german/viewtopic.php?t=18125

Seite 1 von 2

Simulation von Massen und Anziehungskräften (ohne flackern)

Verfasst: 03.11.2008 09:19
von Kukulkan
Hallo,

Ich habe am Wochenende mal ein wenig mit PB rumgespielt und da mir das Ergebnis einfach Freude gemacht hat, will ich es nicht vorenthalten. Wichtig: Das hat keinerlei Ansprüche an echte Physik oder sowas. Ist nur Spass.

Code: Alles auswählen

Structure strElement
  PosX.f
  PosY.f
  VectorX.f
  VectorY.f
  Color.l
EndStructure

#Image = 2

; Werte 
MaxEntfernung.l = 25       ; if distance is greater, there is no effect 
GravityConstant.f = 0.010  ; (0 = no gravity   >0 = falling   <0 = raising) 
Anzahl.l = 50             ; number of elements in game 
SlowDownConstant.f = 0.990 ; 1 = no force   <1 = slowdown   >1 = dont try! 
SpecialEffect.l = 1 
FaktDivisor.l = 100

Dim Elements.strElement(1000)

If OpenWindow(0, 100, 100, 400, 400, "Test", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
  
  CreateImage(#Image, WindowWidth(0), WindowHeight(0))
  
  CreateGadgetList(WindowID(0))
  ImageGadget(1,1,1,WindowWidth(0), WindowHeight(0), ImageOutput(#Image))
  
  ;SmartWindowRefresh(0, 1)
  StartDrawing(ImageOutput(#Image))
  Box(0, 0, WindowWidth(0), WindowHeight(0), #White) ; clear
  StopDrawing()

  For x.l = 1 To Anzahl.l
    Elements(x.l)\PosX = Random(WindowWidth(0))
    Elements(x.l)\PosY = Random(WindowHeight(0))
    Elements(x.l)\VectorX = 0
    Elements(x.l)\VectorY = 0
    Elements(x.l)\Color = RGB(Random(200), Random(200), Random(200))
  Next

  Repeat
  
    ; calculate attraction
    For x.l = 1 To Anzahl.l
      For y.l = 1 To Anzahl.l
        If x.l <> y.l
          WidX.l = Elements(x.l)\PosX - Elements(y.l)\PosX
          WidY.l = Elements(x.l)\PosY - Elements(y.l)\PosY
          Distance.l = Sqr(Pow(Abs(WidX.l), 2) + Pow(Abs(WidY.l), 2))
          If Distance.l <= MaxEntfernung.l
            ; only affected if distance < MaxEntfernung.l
            Faktor.f = ((MaxEntfernung.l * SpecialEffect.l) - Distance.l) / FaktDivisor.l
            If WidX.l > 0
              FakX.f = Faktor.f
            Else
              FakX.f = -Faktor.f
            EndIf
            If WidY.l > 0
              FakY.f = Faktor.f
            Else
              FakY.f = -Faktor.f
            EndIf
            Elements(x.l)\VectorX = Elements(x.l)\VectorX + FakX.f
            Elements(x.l)\VectorY = Elements(x.l)\VectorY + FakY.f
          EndIf
        EndIf
      Next
    Next
    
    For x.l = 1 To Anzahl.l
      ; final movement with vector
      Elements(x.l)\PosX = Elements(x.l)\PosX + Elements(x.l)\VectorX
      Elements(x.l)\PosY = Elements(x.l)\PosY + Elements(x.l)\VectorY
      ; bounce on border?
      If Elements(x.l)\PosX > WindowWidth(0) - 1 Or Elements(x.l)\PosX < 1: Elements(x.l)\VectorX = - Elements(x.l)\VectorX: EndIf
      If Elements(x.l)\PosY > WindowHeight(0) - 1 Or Elements(x.l)\PosY < 1: Elements(x.l)\VectorY = - Elements(x.l)\VectorY: EndIf
      ; too fast?
      If Abs(Elements(x.l)\VectorX) > 10: Elements(x.l)\VectorX = Elements(x.l)\VectorX / 2: EndIf
      If Abs(Elements(x.l)\VectorY) > 10: Elements(x.l)\VectorY = Elements(x.l)\VectorY / 2: EndIf
      ; slowdown
      Elements(x.l)\VectorX = Elements(x.l)\VectorX * SlowDownConstant.f
      Elements(x.l)\VectorY = Elements(x.l)\VectorY * SlowDownConstant.f
      ; gravity
      Elements(x.l)\VectorY = Elements(x.l)\VectorY + GravityConstant.f
      ; out?
      If Elements(x.l)\PosX > WindowWidth(0): Elements(x.l)\PosX = WindowWidth(0): EndIf
      If Elements(x.l)\PosY > WindowHeight(0): Elements(x.l)\PosY = WindowHeight(0): EndIf
      If Elements(x.l)\PosX < 1: Elements(x.l)\PosX = 1: Elements(x.l)\VectorX = 0.3: EndIf
      If Elements(x.l)\PosY < 1: Elements(x.l)\PosY = 1: Elements(x.l)\VectorY = 0.3:  EndIf
    Next
    
    ; draw
    StartDrawing(ImageOutput(#Image))
    Box(0, 0, WindowWidth(0), WindowHeight(0), #White) ; clear
    For x.l = 1 To Anzahl.l
      If Elements(x.l)\PosX > 0 And Elements(x.l)\PosY > 0
        Circle(Elements(x.l)\PosX, Elements(x.l)\PosY, 10, Elements(x.l)\Color)
      EndIf
    Next
    StopDrawing()
    SetGadgetState(1, ImageID(#Image))
    
    
    ; one for the mouse!
    If WindowMouseX(0) > 0 And WindowMouseY(0) > 0 And WindowMouseX(0) < WindowWidth(0) And WindowMouseY(0) < WindowHeight(0)
      Elements(1)\PosX = WindowMouseX(0)
      Elements(1)\PosY = WindowMouseY(0)
      Elements(1)\VectorX = 0
      Elements(1)\VectorY = 0
    EndIf
    
    Delay(1)
  
    EventID.l = WindowEvent()

    If EventID.l = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit.l = 1
    EndIf
    
    If EventID.l = #PB_Event_SizeWindow
      ResizeImage(#Image, WindowWidth(0), WindowHeight(0))
      ResizeGadget(1,1,1,WindowWidth(0), WindowHeight(0))
    EndIf

  Until Quit.l = 1
  
EndIf
Mit der Maus kann man einen Ball manuell bewegen! Parameter sind alle oben.

Auch schön ist diese Parameterversion (Fluidial Movement):

Code: Alles auswählen

; Werte
MaxEntfernung.l = 40       ; if distance is greater, there is no effect
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising)
Anzahl.l = 100               ; number of elements in game
SlowDownConstant.f = 1.0000 ; 1 = no force   <1 = slowdown   >1 = dont try!
SpecialEffect.l = 1.5
FaktDivisor.l = 10000
Oder das hier (Swarm):

Code: Alles auswählen

; Werte
MaxEntfernung.l = 40       ; if distance is greater, there is no effect
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising)
Anzahl.l = 100               ; number of elements in game
SlowDownConstant.f = 1.000 ; 1 = no force   <1 = slowdown   >1 = dont try!
SpecialEffect.l = 0.6
FaktDivisor.l = 5000
Spassiges neues Werte-Set (Billard):

Code: Alles auswählen

; Werte
MaxEntfernung.l = 20       ; if distance is greater, there is no effect
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising)
Anzahl.l = 140               ; number of elements in game
SlowDownConstant.f = 0.990 ; 1 = no force   <1 = slowdown   >1 = dont try!
SpecialEffect.l = 1
FaktDivisor.l = 100
Am besten mit der Maus im Fenster rumfahren...

Oder das hier (Gelee):

Code: Alles auswählen

; Werte 
MaxEntfernung.l = 100       ; if distance is greater, there is no effect 
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising) 
Anzahl.l = 40               ; number of elements in game 
SlowDownConstant.f = 0.970  ; 1 = no force   <1 = slowdown   >1 = dont try! 
SpecialEffect.l = 1.1 
FaktDivisor.l = 1000
Mit der Maus im Fenster rumfahren...

Mit Sprites und weniger Flimmern würde das schicker aussehen. Aber für meine Neugierde war es genug. Viel Spass.

Volker

Verfasst: 03.11.2008 09:50
von STARGÅTE
Swarm sieht interessant aus.

Wenn man dort eine art "PlasmaSprite" als Kugel benutzt und n Additionsblendingmode, kann man dort bestimmt richtig keine Effekte erzeugen :

Verfasst: 03.11.2008 12:16
von c4s
Klasse :allright:
Sieht echt nett aus. Werde es mir später nochmal genauer angucken..

STARGÅTE hat geschrieben:..bestimmt richtig keine Effekte erzeugen
:lol:

Verfasst: 03.11.2008 18:03
von Kaeru Gaman
sehr chique!

... und es ist Beispielcode, also ab ins C,T&T... :D

Verfasst: 03.11.2008 18:15
von milan1612
Ganz nett, aber flackert das nur bei mir wie die Hölle? Da kriegt man ja Augenkrebs!

Verfasst: 03.11.2008 18:27
von Kukulkan
Hi milan,

Ja, das flackert, weil mich das nicht interessiert hat. Wie schon geschrieben wäre das mit Sprites auf einem Screen sicher schöner anzusehen. Für meine Testzwecke hat das aber gereicht. Ich will daraus evtl. mal ein Spiel machen. Aber das Spielprinzip muss ich mir noch genauer "austüfteln"...

Spassiges neues Werte-Set (Billard):

Code: Alles auswählen

; Werte
MaxEntfernung.l = 20       ; if distance is greater, there is no effect
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising)
Anzahl.l = 140               ; number of elements in game
SlowDownConstant.f = 0.990 ; 1 = no force   <1 = slowdown   >1 = dont try!
SpecialEffect.l = 1
FaktDivisor.l = 100
Am besten mit der Maus im Fenster rumfahren. Fenstergrösse etwas verkleinern und ein bisschen warten bringt eine "ordentliche" Überraschung...

Oder das hier (Gelee):

Code: Alles auswählen

; Werte
MaxEntfernung.l = 100       ; if distance is greater, there is no effect
GravityConstant.f = 0.000   ; (0 = no gravity   >0 = falling   <0 = raising)
Anzahl.l = 40               ; number of elements in game
SlowDownConstant.f = 0.970  ; 1 = no force   <1 = slowdown   >1 = dont try!
SpecialEffect.l = 1.1
FaktDivisor.l = 1000
Mit der Maus im Fenster rumfahren...

Volker

Verfasst: 03.11.2008 19:17
von Kaeru Gaman
das Flackern kannst du schnell unterbinden, wenn du auf ein Image zeichnest und das in ein Fensterfüllendes ImageGadget setzt.

das ist schnell gemacht.

Verfasst: 03.11.2008 23:46
von Little John
Titel hat geschrieben:Wills einfach nicht nur für mich behalten...
Zum krönenden Abschluss nun diesem Thread vielleicht noch einen sinnvollen Titel geben ... :D

Gruß, Little John

Verfasst: 04.11.2008 00:04
von Kaeru Gaman
hatte ich beim Verschieben schon überlegt,
aber wollte den Titel nicht komplett ändern, damit Volker ihn wiederfindet.
sollte Volker besser selber machen.

Verfasst: 04.11.2008 08:57
von Kukulkan
Habe den ersten Post verändert.

Das Flackern ist jetzt weg!

Grüsse,

Volker
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de