Simulation von Massen und Anziehungskräften (ohne flackern)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Benutzeravatar
Kukulkan
Beiträge: 1066
Registriert: 09.09.2004 07:07
Wohnort: Süddeutschland
Kontaktdaten:
Kontaktdaten von Kukulkan

Simulation von Massen und Anziehungskräften (ohne flackern)

Beitrag 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
Zuletzt geändert von Kukulkan am 04.11.2008 08:56, insgesamt 5-mal geändert.
Nach oben
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:
Kontaktdaten von STARGÅTE

Beitrag 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 :
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Nach oben
c4s
Beiträge: 1235
Registriert: 19.09.2007 22:18

Beitrag 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:
"Menschenskinder, das Niveau dieses Forums singt schon wieder!" — GronkhLP ||| "ich hogffe ihr könnt den fehle endecken" — Marvin133 ||| "Ideoten gibts ..." — computerfreak ||| "Jup, danke. Gruss" — funkheld
Nach oben
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

sehr chique!

... und es ist Beispielcode, also ab ins C,T&T... :D
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
Benutzeravatar
milan1612
Beiträge: 810
Registriert: 15.04.2007 17:58

Beitrag von milan1612 »

Ganz nett, aber flackert das nur bei mir wie die Hölle? Da kriegt man ja Augenkrebs!
Bin nur noch sehr selten hier, bitte nur noch per PN kontaktieren
Nach oben
Benutzeravatar
Kukulkan
Beiträge: 1066
Registriert: 09.09.2004 07:07
Wohnort: Süddeutschland
Kontaktdaten:
Kontaktdaten von Kukulkan

Beitrag 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
Nach oben
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag 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.
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
Little John

Beitrag 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
Nach oben
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag 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.
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
Benutzeravatar
Kukulkan
Beiträge: 1066
Registriert: 09.09.2004 07:07
Wohnort: Süddeutschland
Kontaktdaten:
Kontaktdaten von Kukulkan

Beitrag von Kukulkan »

Habe den ersten Post verändert.

Das Flackern ist jetzt weg!

Grüsse,

Volker
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“