Hectic's Verlets Physik mit Masse und Luftwiderstand

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Benibaerenstark

Betreff: Hectic's Verlets Physik mit Masse und Luftwiderstand

 BeitragMi, Aug 29, 2007 2:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Wer sich einwenig für Physik im Spiel interessiert, dem werden Hectics geniale Codebeispiele ein Begriff sein:

-https://www.blitzforum.de/foru...hp?t=20596
-https://www.blitzforum.de/foru...hp?t=19846

Ich habe mich mit den Beispielen auseinandergesetzt, und bin zum Schluss gekommen, dass Hectic hier eine Umsetzung der Verlets-Integration gemacht hat. Detaillierte Infos zur Verlets-Physik:

http://home.tiscalinet.ch/bene...on_pfv.htm

Zudem habe ich seinen Editor erweitert:

-Man kann den Knotenpunkten unterschiedliche Massen geben
-Man kann "Aussenflächen" erstellen, welche es ermöglichen, den Luftwiderstand physikalisch Korrekt zu berechnen
-Versuchsweise ist es möglich, das "Seitwärtsgleiten" schräg angeströmter Objekte zu simulieren (kleine Massen machen noch Probleme)

Viel Spass!


Code: [AUSKLAPPEN]
;Grafikkramm
gfx=1024
gfy=768


ghx=gfx/2
ghy=gfy/2
Graphics gfx,gfy,0,1
SetBuffer BackBuffer()

Type kp ;KnotenPunkte
 Field xs% ;X-Fest-Position
 Field ys% ;Y-Fest-Position
 Field xp# ;X-Position
 Field yp# ;Y-Position
 Field xg# ;X-Speed
 Field yg# ;Y-Speed
 Field at% ;mobil/fest
 Field masse#
End Type

Type vk ;VerKlinkungen
 Field k1% ;von KP-1
 Field k2% ;zum KP-2
 Field ln# ;Solllänge
End Type


Type af ;Aussenfläche
 Field k1% ;von KP-1
 Field k2% ;zum KP-2
 Field ln# ;Fläche
End Type

sw%=0 ;Switch
id%=0 ;Handle
wk#=0 ;Winkel
dx#=0 ;
dy#=0 ;
mp%=1 ;Moving-Position
nn%=0 ;GetKey-Mode-Switch
gk%=0 ;GetKey-Puffer
nm$="";Filename

Global cw#=0.001 ;luftwiderstand
Global i#=0.1   ;invmasse
Global Abl=0 ; Ablenkung aktiviert?

;EDIT Hauptschleife
While Not KeyHit(1)

 ;Mauskramm
 mx=MouseX()
 my=MouseY()
 nx=Int(mx/10.0)*10
 ny=Int(my/10.0)*10

 ;KP Erstellen
 If MouseHit(1)
  id=0
  For kp.kp=Each kp
   If kp\xp=nx And kp\yp=ny id=Handle(kp)
  Next

  If id=0
 
   ;i=i-0.1

   kp.kp=New kp
   kp\xs=nx
   kp\ys=ny
   kp\xp=nx
   kp\yp=ny
   kp\xg=0
   kp\yg=0
   kp\at=0
   kp\masse=i
   id=Handle(kp)
  End If

  If sw=0
   vk.vk=New vk
   vk\k1=id
   vk\k2=id
   sw=1
  Else
   vk.vk=Last vk
   vk\k2=id
   k1.kp=Object.kp(vk\k1)
   k2.kp=Object.kp(vk\k2)
   vk\ln=Sqr((k1\xp-k2\xp)^2+(k1\yp-k2\yp)^2)
   sw=0
  End If
 End If

 ;Eigenschaft
 If MouseHit(2)
  id=0
  For kp.kp=Each kp
   If kp\xp=nx And kp\yp=ny id=Handle(kp)
  Next

  If id<>0
   k1.kp=Object.kp(id)
   k1\at=1-k1\at
  End If
 End If

 Color 32,32,48:Rect 0,gfy-40,gfx,60,1 ;Boden
 Color 48,48,72:For q=0 To gfx Step 10:Rect q,0,1,gfy,1:Rect 0,q,gfx,1,1:Next ;Gitter (fein)
 Color 64,64,96:For q=0 To gfx Step 40:Rect q,0,1,gfy,1:Rect 0,q,gfx,1,1:Next ;Gitter (grob)
 Color 96,96,144:Rect ghx,0,1,960,1 ;Mittellinie
 Color 240,240,240

 ;Maus-Position
 Rect mx-2,my-2,5,5,1
 Rect nx-4,ny-4,9,9,0

 ;KPs
 For kp.kp=Each kp
  Rect kp\xp-4,kp\yp-4,9,9,kp\at
 Next

 ;VKs
 For vk.vk=Each vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  Line k1\xp,k1\yp,k2\xp,k2\yp
  If k1=k2 Line k1\xp,k1\yp,nx,ny
 Next

 

 ;Schwerpunkt einzeichnen
 SX#=0
 SXtemp#=0
 Smasse#=0
 For kp.kp=Each kp
  Smasse=Smasse+1/(kp\masse)
  SXtemp#=SXtemp#+(kp\xp*(1/(kp\masse)))
 Next

 If Smasse>0
  SX#=SXtemp#/Smasse
 EndIf

 SY#=0
 SYtemp#=0
 For kp.kp=Each kp
   SYtemp#=SYtemp#+(kp\yp*(1/(kp\masse)))
 Next
 If Smasse>0
  SY#=SYtemp#/Smasse
 EndIf

 Oval SX-2,SY-2,5,5,0




 If KeyHit(59) nn=1 ;Load-Modus
 If KeyHit(60) nn=2 ;Save-Modus

 If nn>0
  gk=GetKey()
  If gk=8 If Not nm="" nm=Left(nm,Len(nm)-1)
  If gk>31 nm=nm+Chr$(gk)
  If KeyHit(57) nn=0

  ;Check
  If nn=1

   ;Handle-Konflikt
   For kp.kp=Each kp
    nn=0
   Next

   ;Handle-Konflikt
   For vk.vk=Each vk
    nn=0
   Next
  End If

  ;Load/Save
  If KeyHit(28)

   ;Load
   If nn=1
    nn=0

    ;Information einlesen
    If FileType(nm+".btm")
     file=ReadFile(nm+".btm")
      While Not Eof(file)
       If ReadByte(file)=1
        kp.kp=New kp
        kp\xs=ReadShort(file)
        kp\ys=ReadShort(file)
        kp\xp=ReadFloat(file)
        kp\yp=ReadFloat(file)
        kp\xg=ReadFloat(file)
        kp\yg=ReadFloat(file)
        kp\at=ReadByte(file)
        id=Handle(kp)
       Else
        vk.vk=New vk
        vk\k1=ReadShort(file)
        vk\k2=ReadShort(file)
        vk\ln=ReadFloat(file)
       End If
      Wend
     CloseFile file
    End If
   End If

   ;Save
   If nn=2
    nn=0

    ;Information schreiben
    file=WriteFile(nm+".btm")
     For kp.kp=Each kp
      WriteByte file,1
      WriteShort file,kp\xs
      WriteShort file,kp\ys
      WriteFloat file,kp\xp
      WriteFloat file,kp\yp
      WriteFloat file,kp\xg
      WriteFloat file,kp\yg
      WriteByte file,kp\at
     Next
     For vk.vk=Each vk
      WriteByte file,0
      WriteShort file,vk\k1
      WriteShort file,vk\k2
      WriteFloat file,vk\ln
     Next
    CloseFile file
   End If
  End If
 End If

 ;Load/Save -Info-Anzeige
 If nn=1 Text 100,100,"[Load] Filename: "+nm+".btm"
 If nn=2 Text 100,100,"[Save] Filename: "+nm+".btm"

 Text 0,0,"Knotenpunkte und Verbindungen erstellen, Speichern:F1, Laden F2, Masse ändern: Pfeil auf/Pfeil ab, weiter mit esc"
 Text 0,20,"Masse: "+ 1/i

 If KeyDown (200) Then i = i*0.98
 If KeyDown (208) Then i = i*1.02


 Flip
 Cls
Wend








;##########################################################################################################



;Luftwiderstandsflächen erstellen
While Not KeyHit(1)

 ;Mauskramm
 mx=MouseX()
 my=MouseY()
 nx=Int(mx/10.0)*10
 ny=Int(my/10.0)*10

 ;Fläche Erstellen
 If MouseHit(1)
  id=0
  For kp.kp=Each kp
   If kp\xp=nx And kp\yp=ny id=Handle(kp)
  Next

  If id>0
   
    If sw=0
     af.af=New af
     af\k1=id
     af\k2=id
     sw=1
    Else
     af.af=Last af
     af\k2=id
     k1.kp=Object.kp(af\k1)
     k2.kp=Object.kp(af\k2)
     af\ln=Sqr((k1\xp-k2\xp)^2+(k1\yp-k2\yp)^2)
     sw=0
   End If

  End If
 End If



 Color 32,32,48:Rect 0,gfy-40,gfx,60,1 ;Boden
 Color 48,48,72:For q=0 To gfx Step 10:Rect q,0,1,gfy,1:Rect 0,q,gfx,1,1:Next ;Gitter (fein)
 Color 64,64,96:For q=0 To gfx Step 40:Rect q,0,1,gfy,1:Rect 0,q,gfx,1,1:Next ;Gitter (grob)
 Color 96,96,144:Rect ghx,0,1,960,1 ;Mittellinie
 Color 240,240,240

 ;Maus-Position
 Rect mx-2,my-2,5,5,1
 Rect nx-4,ny-4,9,9,0

 ;KPs
 For kp.kp=Each kp
  Rect kp\xp-4,kp\yp-4,9,9,kp\at
 Next

 ;VKs
 For vk.vk=Each vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  Line k1\xp,k1\yp,k2\xp,k2\yp
  If k1=k2 Line k1\xp,k1\yp,nx,ny
 Next



 ;AFs
 Color 255,0,0
 For af.af=Each af
  Color 255,0,0
   k1.kp=Object.kp(af\k1)
   k2.kp=Object.kp(af\k2)
   Line k1\xp,k1\yp,k2\xp,k2\yp
   If k1=k2 Line k1\xp,k1\yp,nx,ny
  Color 255,255,0
   If k1=k2 Then
     Winkel#=(ATan2(ny-k1\yp,nx-k1\xp))
     Xforce#=-Sin(Winkel)
     Yforce#=Cos(Winkel)

     NLX#=(k1\xp+nx)/2
     NLY#=(k1\yp+ny)/2

     Line NLX,NLY,NLX+10*Xforce,NLY+10*Yforce

    Else
     Winkel#=(ATan2(k2\yp-k1\yp,k2\xp-k1\xp))
     Xforce#=-Sin(Winkel)
     Yforce#=Cos(Winkel)

     NLX#=(k1\xp+k2\xp)/2
     NLY#=(k1\yp+k2\yp)/2

     Line NLX,NLY,NLX+10*Xforce,NLY+10*Yforce
   EndIf

 Next
 Color 240,240,240



 ;Schwerpunkt einzeichnen
 SX#=0
 SXtemp#=0
 Smasse#=0
 For kp.kp=Each kp
  Smasse=Smasse+1/(kp\masse)
  SXtemp#=SXtemp#+(kp\xp*(1/(kp\masse)))
 Next

 If Smasse>0
  SX#=SXtemp#/Smasse
 EndIf

 SY#=0
 SYtemp#=0
 For kp.kp=Each kp
   SYtemp#=SYtemp#+(kp\yp*(1/(kp\masse)))
 Next
 If Smasse>0
  SY#=SYtemp#/Smasse
 EndIf

 Oval SX-2,SY-2,5,5,0

 
 Text 0,0,"Aussenflächen für den Luftwiderstand erstellen (nicht zwingend), weiter mit esc"





 Flip
 Cls
Wend







;#####################################################################################################################
;ANIM Hauptschleife
While Not KeyHit(1)

 ;Boden
 Color 48,48,72
 Rect 0,gfy-40,gfx,40,1

 ;VKs-Update
 For w=1 To 8 ;Extra-Härte
  For vk.vk=Each vk
   k1.kp=Object.kp(vk\k1)
   k2.kp=Object.kp(vk\k2)

  ; wk=(ATan2(k2\yp-k1\yp,k2\xp-k1\xp))Mod 360

  ; dx=(k1\xp+Cos(wk)*vk\ln)-k2\xp
  ; dy=(k1\yp+Sin(wk)*vk\ln)-k2\yp

  ;REPLACE


 deltaX#=k1\xp-k2\xp             ;abstände
 deltaY#=k1\yp-k2\yp

 istln#=Sqr((deltaX#)^2+(deltaY#)^2)    ;Skalarprodukt --> kann weiterdimensioniert werden!
 diff#=(istln-vk\ln)/(istln*(k1\masse+k2\masse))
 
 dx=deltaX*0.5*diff
 dy=deltaY*0.5*diff

 ;_____________________________


   dx=dx/3.5
   dy=dy/3.5




   k1\xp=k1\xp-dx*k1\masse ;ort...
   k1\yp=k1\yp-dy*k1\masse

   k1\xg=k1\xg-dx*k1\masse ;und geschwindigkeit anpassen
   k1\yg=k1\yg-dy*k1\masse


   k2\xp=k2\xp+dx*k2\masse
   k2\yp=k2\yp+dy*k2\masse
   k2\xg=k2\xg+dx*k2\masse
   k2\yg=k2\yg+dy*k2\masse
  Next
 Next

 ;KPs-Update
 Color 240,240,240
 For kp.kp=Each kp
  If kp\at=1
   kp\xp=kp\xs
   kp\yp=kp\ys
   kp\xg=0
   kp\yg=0
  End If

  kp\yg=kp\yg+.05;05  ;Gravitationskraft

  kp\xp=kp\xp+kp\xg
  kp\yp=kp\yp+kp\yg

  ;ReibungX#= (kp\xg^2)*0.01   ;Luftreibungskraft (pro punkt)
 ; ReibungY#= (kp\yg^2)*0.01
 
 
  ;kp\xg=kp\xg-ReibungX
 ; kp\yg=kp\yg-ReibungY



  If kp\yp>gfy-43 kp\yp=gfy-43:kp\yg=0:kp\xg=0
  Rect kp\xp-2,kp\yp-2,5,5,0
 Next

 ;VKs zeichnen
 Color 64,64,96
 For vk.vk=Each vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  Line k1\xp,k1\yp,k2\xp,k2\yp
 Next


 
 ;Luftwiderstand berechnen

 
  For af.af = Each af

   k1.kp=Object.kp(af\k1)
   k2.kp=Object.kp(af\k2)


   Winkel#=(ATan2(k2\yp-k1\yp,k2\xp-k1\xp))
   Xforce#=-Sin(Winkel)
   Yforce#=Cos(Winkel)
   


   If k1\xg*Xforce > 0 Then
     X1r#=af\ln*k1\xg^2*cw*Xforce           ;Xresistance
     k1\xg =k1\xg-(X1r*k1\masse)
    Else
     X1r#=0
   EndIf


   If k1\yg*Yforce > 0 Then
     Y1r#=af\ln*k1\yg^2*cw*Yforce           ;Yresistance
     k1\yg =k1\yg-(Y1r*k1\masse)
    Else
     Y1r#=0
   EndIf

   If k2\xg*Xforce > 0 Then
     X2r#=af\ln*k2\xg^2*cw*Xforce           ;Xresistance
     k2\xg =k2\xg-(X2r*k2\masse)
     Else
     X2r#=0
   EndIf

   
   If k2\yg*Yforce > 0 Then
     Y2r#=af\ln*k2\yg^2*cw*Yforce           ;Yresistance
     k2\yg =k2\yg-(Y2r*k2\masse)
    Else
     Y2r#=0
   EndIf


  ; Wenn eine Fläche (z.B. Blatt Papier) durch die Luft fällt, beginnt es
  ; sehr bald, sich seitlich zu bewegen: Dies hier ist ein Ansatz, funktioniert
  ; aber noch nicht 100%ig -> bei zu geringer Masse fliegt das Teil davon



If Abl = 1

   Ablenkung#=Sin(2*Winkel)

   k1\xg=k1\xg+Ablenkung*k1\yg *0.1*k1\masse       ;seitenkraft
   k1\yg=k1\yg+Ablenkung*k1\xg *0.1*k1\masse       ;seitenkraft
   k2\xg=k2\xg+Ablenkung*k2\yg *0.1*k2\masse      ;seitenkraft
   k2\yg=k2\yg+Ablenkung*k2\xg *0.1*k2\masse       ;seitenkraft

EndIf


   Color 0,255,0

    Line k1\xp,k1\yp,k1\xp+X1r*100,k1\yp+Y1r*100
    Line k2\xp+X2r*100,k2\yp+Y2r*100,k1\xp+X1r*100,k1\yp+Y1r*100
    Line k2\xp,k2\yp,k2\xp+X2r*100,k2\yp+Y2r*100

   


   




 
  Next







 kp.kp=Last kp
 k1.kp=Object.kp(mp)
 If KeyHit(29) mp=mp-1:If mp<1 mp=Handle(kp)
 If KeyHit(56) mp=mp+1:If mp>Handle(kp) mp=1
 If KeyDown(203) k1\xg=k1\xg-.05*Handle(kp)
 If KeyDown(205) k1\xg=k1\xg+.05*Handle(kp)
 If KeyDown(200) k1\yg=k1\yg-.05*Handle(kp)
 If KeyDown(208) k1\yg=k1\yg+.05*Handle(kp)
 Color 240,240,240:Rect k1\xp-2,k1\yp-2,5,5,1

 ;[a] Erste VK verlängern
 If KeyDown(30) vk.vk=First vk:vk\ln=vk\ln+.5

 ;[y] Erste VK verkürzen
 If KeyDown(44) vk.vk=First vk:vk\ln=vk\ln-.5:If vk\ln<10 vk\ln=10

 ;[s] 2/3te VK vorne beschleunigen
 If KeyDown(31)
  vk.vk=First vk
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg-(k1\xp-k2\xp)/100
  k1\yg=k1\yg-(k1\yp-k2\yp)/100
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg-(k1\xp-k2\xp)/100
  k1\yg=k1\yg-(k1\yp-k2\yp)/100
 End If

 ;[x] 2/3te VK zurück beschleunigen
 If KeyDown(45)
  vk.vk=First vk
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg+(k1\xp-k2\xp)/100
  k1\yg=k1\yg+(k1\yp-k2\yp)/100
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg+(k1\xp-k2\xp)/100
  k1\yg=k1\yg+(k1\yp-k2\yp)/100
 End If

 ;[d] 4te VK links drehen
 If KeyDown(32)
  vk.vk=First vk
  vk.vk=After vk
  vk.vk=After vk
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg+(k1\yp-k2\yp)/40
  k1\yg=k1\yg-(k1\xp-k2\xp)/40
  k2\xg=k2\xg-(k1\yp-k2\yp)/40
  k2\yg=k2\yg+(k1\xp-k2\xp)/40
 End If

 ;[c] 4te VK rechts drehen
 If KeyDown(46)
  vk.vk=First vk
  vk.vk=After vk
  vk.vk=After vk
  vk.vk=After vk
  k1.kp=Object.kp(vk\k1)
  k2.kp=Object.kp(vk\k2)
  k1\xg=k1\xg-(k1\yp-k2\yp)/40
  k1\yg=k1\yg+(k1\xp-k2\xp)/40
  k2\xg=k2\xg+(k1\yp-k2\yp)/40
  k2\yg=k2\yg-(k1\xp-k2\xp)/40
 End If

 pos = 0


 ;Schwerpunkt einzeichnen
 SX#=0
 SXtemp#=0
 Smasse#=0
 For kp.kp=Each kp
  Smasse=Smasse+1/(kp\masse)
  SXtemp#=SXtemp#+(kp\xp*(1/(kp\masse)))
 Next

 If Smasse>0
  SX#=SXtemp#/Smasse
 EndIf

 SY#=0
 SYtemp#=0
 For kp.kp=Each kp
   SYtemp#=SYtemp#+(kp\yp*(1/(kp\masse)))
 Next
 If Smasse>0
  SY#=SYtemp#/Smasse
 EndIf

 Oval SX-2,SY-2,5,5,0


 If Abl=1
  Text 0,0," Seitliche Ablenkung deaktivieren: Leertaste, Beenden mit esc "
  Else
  Text 0,0," Seitliche Ablenkung aktivieren: Leertaste, Beenden mit esc "
 EndIf


 If KeyHit (57) Then Abl=-Abl


 Flip
 Cls
Wend
End
3D Scanner selber bauen? -> www.bewe-3dscanner.ch.vu

hectic

Sieger des IS Talentwettbewerb 2006

BeitragMi, Aug 29, 2007 2:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Bin sehr beeindruckt. Wusste auch bis heute nicht, dass es sich ''Verlets-Integration'' nennt. Very Happy

Was für mich sehr interessant ist, ist die unterschiedliche Masseangabe. Hatte dazu schon eine Idee, die ich aber noch nicht umgesetzt hatte. Die Tragflächen sind auch sehr geil. Werde mal die nächsten Tage versuchen, dieso so zu machen, dass sie sich seitlich weg bewegen, wenn sie schräg angeordnet sind und runter fallen.
Download der Draw3D2 V.1.1 für schnelle Echtzeiteffekte über Blitz3D

Benibaerenstark

 BeitragMi, Aug 29, 2007 11:05
Antworten mit Zitat
Benutzer-Profile anzeigen
Oh, es hat sich ein Fehler in meinen Code eingeschlichen...die Seitliche Ablenkung wird gar nicht aktiviert, wenn man die Leertaste drückt...


Code: [AUSKLAPPEN]
Global Abl=0 ; Ablenkung aktiviert?
in Code: [AUSKLAPPEN]
Global Abl=1 ; Ablenkung aktiviert?
ändern, und es funktioniert... (ausser kleine Massen).
3D Scanner selber bauen? -> www.bewe-3dscanner.ch.vu
 

FWeinb

ehemals "ich"

BeitragDo, Aug 30, 2007 17:32
Antworten mit Zitat
Benutzer-Profile anzeigen
Sehr Genial das ganze nicht schlecht umsetzung Respeckt
"Wenn die Menschen nur über das sprächen, was sie begreifen, dann würde es sehr still auf der Welt sein." Albert Einstein (1879-1955)
"If you live each day as if it was your last, someday you'll most certainly be right." Steve Jobs

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group