Da ich aber meine Engine für mich behalten wollte, hab ich mal ne komplett neue geschrieben um diese quasi als Comunity-Engine weiter zu entwickeln. Bis jetzt sinds auch nur ca 400 Zeilen. Würd mich freuen, wenn mein Name bei Verwendung irgendwo erwähnt werden würde.
Ich freue mich über jegliche Verbesserungen/Optimierungen.
Nadann viel Spaß damit.
Code: Alles auswählen
;vector stuff  / Vektor Zeugs
Structure vect
   x.d
   y.d
EndStructure
Procedure vect(*v.vect,x.d,y.d)               ; / zum erstellen eines Vektors
   *v\x=x
   *v\y=y
EndProcedure
Procedure Normalize(*v.vect)
   Protected Length.d
   Length=Sqr(*v\x**v\x+*v\y**v\y)
   If Length<>0
      *v\x/Length
      *v\Y/Length
   EndIf
EndProcedure
Procedure.d Length(*v.vect)                   ; / Länge
   ProcedureReturn Sqr(*v\x**v\x+*v\y**v\y)
EndProcedure
Procedure.d DotProduct(*v1.vect,*v2.vect)     ; / Kreuzprodukt
   ProcedureReturn (*v1\x**v2\x+*v1\y**v2\y)
EndProcedure
;Physic Structures
Structure count     ; for counting the physic variables / zum mitzählen der PhysiK Variablen
   particle.l
   constraint.l
EndStructure
Structure particle
   r.d           ;radius / Radius
   p.vect
   oldp.vect
   a.vect        ;acceleration / Beschleunigung
   m.d           ;mass=0 represents static Particle  / masse=0 represintiert starre Körper
   id.l
   collision.b   ;>1 if the particle collides / >1 wenn der Particle kollidiert
EndStructure
Global Dim particle.particle(10000) 
Structure constraint
   *p1.particle
   *p2.particle
   e.d ;elastizity (between 1-0.001) / Elastizität (zwischen 1-0.001)
   length.d
   id.l
EndStructure
Global Dim constraint.constraint(10000)
Structure halfspace
   p.vect           ; / Stützvektor
   v.vect           ; / Richtungsvektor
   n0.vect          ;normalized normal vector / normierter Normalenvektor
EndStructure
Global NewList halfspace.halfspace()
Global count.count
Global timestep.d; delta t
timestep=0.8
Global iterations.l     ; / Anzahl der Rechendurchläufe
iterations=5
Global itelligentiterations.b ; increases Performance, but can be buggy / erhöht die Rechenleistung, kann aber fehlerhaft sein (bei zu vielen Iterationen)
itelligentiterations=1
Global gravity.vect
gravity\y=0.5
Global particleid.l
particleid=1
Global constraintid.l
constraintid=1
Global entityid.l
entityid=1
Global airfriction.d    ; / Luftwiderstand
airfriction=0.02
Procedure.l CountParticles() ;is used by the Engine / wird nur von Engine benutzt
   Protected i.l
   For i=1 To ArraySize(particle())
      If particle(i)\id=0
         ProcedureReturn (i-1)
      EndIf
   Next
EndProcedure
Procedure.l CountConstraint();is used by the Engine / wird nur von Engine benutzt
   Protected i.l
   For i=1 To ArraySize(constraint())
      If constraint(i)\id=0
         ProcedureReturn (i-1)
      EndIf
   Next
EndProcedure
Procedure CountAll();is used by the Engine. Updates the "count" variable/ wird nur von Engine benutzt. Aktuallisiert die "count" variable
   count\particle=CountParticles()
   count\constraint=CountConstraint()
EndProcedure
Procedure PointToParticle(x,y,inc); searched the particle on the given coardinate / sucht den Particle an der gegebenen Koardinate
   Protected diff.vect
   Protected length.d
   For i=1 To count\particle
      vect(diff,x-particle(i)\p\x,y-particle(i)\p\y)
      length=length(diff)
      If length<particle(i)\r+inc
         ProcedureReturn particle(i)
      EndIf
   Next
EndProcedure
Procedure CreateParticle(px.d,py.d,rad.d,mass.d) ;to create a particle / zum erstellen eines Particles
   Protected nr.l
   nr.l=count\particle+1
   particle(nr)\r=rad
   particle(nr)\m=mass
   particle(nr)\p\x=px
   particle(nr)\p\y=py
   particle(nr)\oldp\x=px
   particle(nr)\oldp\y=py
   particle(nr)\id=particleid
   vect(particle(nr)\a,gravity\x,gravity\y) ;Gravitation
   particleid+1
   count\particle+1
   ProcedureReturn particle(nr)
EndProcedure
Procedure CreateConstraint(*p1.particle,*p2.particle,elasticity.d) ;to create a constraint / zum erstellen eines Constraints (Feder)
   Protected nr.l
   If *p1\p\x<>*p2\p\x Or *p1\p\y<>*p2\p\y
      nr.l=count\constraint+1
      constraint(nr)\p1=*p1
      constraint(nr)\p2=*p2
      constraint(nr)\length=Sqr((*p2\p\x-*p1\p\x)*(*p2\p\x-*p1\p\x)+(*p2\p\y-*p1\p\y)*(*p2\p\y-*p1\p\y))  
      constraint(nr)\id=constraintid
      constraint(nr)\e=elasticity
      constraintid+1
      count\constraint+1
      ProcedureReturn constraint(nr)
   EndIf
EndProcedure
Procedure AddHalfSpace(px,py,vx.d,vy.d) ;to add a halfspace (ground) / zum hinzufügen eines Halfspaces (Boden)
   AddElement(halfspace())
   halfspace()\p\x=px
   halfspace()\p\y=py
   halfspace()\v\x=vx
   halfspace()\v\y=vy
   vect(halfspace()\n0,vy,-vx)
   normalize(halfspace()\n0)
EndProcedure
Procedure DeleteConstraint(*c.constraint)
   For i=1 To count\constraint
      If constraint(i)\id=*c\id
         For j=i To count\constraint
            constraint(j)=constraint(j+1)
         Next
      EndIf
   Next
   count\constraint-1
EndProcedure
Procedure DeleteParticle(*p.particle)
   For i=1 To count\constraint
      If constraint(i)\p1\id=*p\id Or constraint(i)\p2\id=*p\id
         DeleteConstraint(constraint(i))
         i-1
         delete+1
      EndIf
   Next
   
   Structure remindedge
      p1id.l
      p2id.l
      cid.l
   EndStructure
   
   Protected NewList remindedge.remindedge()
   
   For i=1 To count\constraint
      AddElement(remindedge())
      remindedge()\p1id=constraint(i)\p1\id
      remindedge()\p2id=constraint(i)\p2\id
      remindedge()\cid=constraint(i)\id
   Next
   
   For i=1 To count\particle
      If particle(i)\id=*p\id
         For j=i To count\particle
            particle(j)=particle(j+1)
         Next
      EndIf
   Next
   count\particle-1
   
   ResetList(remindedge())
   While NextElement(remindedge())
      For i=1 To count\constraint
         If constraint(i)\id=remindedge()\cid
            For j=1 To count\particle
               If particle(j)\id=remindedge()\p1id
                  constraint(i)\p1=particle(j)
               ElseIf particle(j)\id=remindedge()\p2id
                  constraint(i)\p2=particle(j)
               EndIf
            Next
         EndIf
      Next
   Wend
EndProcedure
Procedure UpdateVerlet() ;standart Verlet integration / Standart Verlet Integration
   Protected old.vect
   Protected v.vect
   Protected i.l
   For i=1 To count\particle
      If particle(i)\m<>0
         
         vect(old,particle(i)\p\x,particle(i)\p\y)                 ;Geschwindigkeit wird aus alter und neuer poition berrechnet + beschleunigung(gravitation)
         particle(i)\p\x=2*particle(i)\p\x-particle(i)\oldp\x+particle(i)\a\x*timestep*timestep
         particle(i)\p\y=2*particle(i)\p\y-particle(i)\oldp\y+particle(i)\a\y*timestep*timestep
         vect(particle(i)\oldp,old\x,old\y)
         
         ;Luftwiderstand
         vect(v,particle(i)\p\x-old\x,particle(i)\p\y-old\y) 
         vect(v,v\x*airfriction,v\y*airfriction)   
         vect(particle(i)\p,particle(i)\p\x-v\x,particle(i)\p\y-v\y)
     EndIf
   Next
EndProcedure
Procedure UpdateConstraints() ;updates the constraints / aktualisiert die Constraints (Federn)
   Protected DeltaX.d
   Protected DeltaY.d
   Protected DeltaLength.d
   Protected Diff.d
   Protected i.l
      For i=1 To count\constraint
         DeltaX=constraint(i)\p2\p\x-constraint(i)\p1\p\x
         DeltaY=constraint(i)\p2\p\y-constraint(i)\p1\p\y
         DeltaLength=Sqr(DeltaX*DeltaX+DeltaY*DeltaY)
         Diff=(DeltaLength-constraint(i)\length)/DeltaLength
         
         Protected m.d
         m=constraint(i)\p1\m+constraint(i)\p2\m
         If constraint(i)\p1\m<>0
            If constraint(i)\p2\m=0
               constraint(i)\p1\p\x=constraint(i)\p1\p\x+DeltaX*Diff*constraint(i)\e
               constraint(i)\p1\p\y=constraint(i)\p1\p\y+DeltaY*Diff*constraint(i)\e
            Else
               constraint(i)\p1\p\x=constraint(i)\p1\p\x+DeltaX*Diff*constraint(i)\e*(constraint(i)\p2\m/m)
               constraint(i)\p1\p\y=constraint(i)\p1\p\y+DeltaY*Diff*constraint(i)\e*(constraint(i)\p2\m/m)
            EndIf
         EndIf
         If constraint(i)\p2\m<>0
            If constraint(i)\p1\m=0
               constraint(i)\p2\p\x=constraint(i)\p2\p\x-DeltaX*Diff*constraint(i)\e
               constraint(i)\p2\p\y=constraint(i)\p2\p\y-DeltaY*Diff*constraint(i)\e
            Else
               constraint(i)\p2\p\x=constraint(i)\p2\p\x-DeltaX*Diff*constraint(i)\e*(constraint(i)\p1\m/m)
               constraint(i)\p2\p\y=constraint(i)\p2\p\y-DeltaY*Diff*constraint(i)\e*(constraint(i)\p1\m/m)
            EndIf
         EndIf
      Next
EndProcedure
Procedure SetCollisionsToZero() ; resets the collisions / resetet die Kollisionen
   Protected i.l
   For i=1 To count\particle
      particle(i)\collision=0
   Next
EndProcedure
Procedure ProcessCollision(*p1.particle,*p2.particle) ; collision-solving / Kollisionsverarbetung
   Protected rad.d
   Protected v.vect
   Protected vlength.d
   rad=*p1\r+*p2\r
   Protected distance.d
      distance=(*p2\p\x-*p1\p\x)*(*p2\p\x-*p1\p\x)+(*p2\p\y-*p1\p\y)*(*p2\p\y-*p1\p\y)   ;die Wurzel wird später gezogen um Rechnerleistung zu sparen
      If distance<(rad*rad) ; wenn die distanz kleiner als beide radien addiert ist, dann kollidiern die Objekte
         If distance<>0
            
            distance=Sqr(distance)  ;wir hab en ja das Quadrat berprüft   
            vect(v,*p2\p\x-*p1\p\x,*p2\p\y-*p1\p\y)   ;Kollisionsvektor wird errechnet (Richtung)
            vect(v,v\x/distance,v\y/distance)    ;Vektor wird normiert
            
            vlength=rad-distance                 ;Länge des Vektors
            vect(v,v\x*vlength,v\y*vlength)      ;Vektor wird auf die errechnete Länge multipliziert (skalar)
            
         Else
            vect(v,(Random(10)-5)/10,(Random(10)-5)/10);Gibt einen Zufalls Impuls falls die Kugeln aufeinander liegen
         EndIf
                  
         Protected m.d
         m=*p1\m+*p2\m
         If *p1\m<>0
            If *p2\m=0
               *p1\p\x-v\x   
               *p1\p\y-v\y
            Else
               *p1\p\x-v\x*(*p2\m/m)            ;Position wir mit dem errechneten Vektor verschowben     
               *p1\p\y-v\y*(*p2\m/m)             ;den Rest regelt die Verlet Integration
            EndIf
         EndIf
         If *p2\m<>0
            If *p1\m=0
               *p2\p\x+v\x
               *p2\p\y+v\y
            Else
               *p2\p\x+v\x*(*p1\m/m) 
               *p2\p\y+v\y*(*p1\m/m) 
            EndIf
         EndIf
         ProcedureReturn 1
      ElseIf distance=(rad*rad)
         ProcedureReturn 1
      Else
         ProcedureReturn 0
      EndIf
EndProcedure
Structure CollisionRemark ; used for intelligentiterations / wird zum merken bei intelligenten Iterationen verwendet
   *p1.particle
   *p2.particle
EndStructure
Global NewList CollisionRemark.CollisionRemark()
Procedure UpdateCollisions() ; collision-loop / Kollisionsschleife
   Protected i.l
   Protected j.l
   Protected k.l
   SetCollisionsToZero()
      For i=1 To count\particle
         For j=1 To count\particle
            If particle(i)\id<>particle(j)\id
               If ProcessCollision(particle(i),particle(j))  ;jedes Object wir mit jedem auf Collision überprüft
                  particle(i)\collision+1
                  If itelligentiterations=1
                     AddElement(CollisionRemark())
                     CollisionRemark()\p1=particle(i)
                     CollisionRemark()\p2=particle(j)
                  EndIf
               EndIf
            EndIf
         Next
      Next
      UpdateConstraints() ;Federn werden geupdated
EndProcedure
Procedure UpdateCollisionsIntelligent()
   Protected i.l
   Protected j.l
   Protected k.l
   SetCollisionsToZero()
   ResetList(CollisionRemark())
   While NextElement(CollisionRemark())
      If Not ProcessCollision(CollisionRemark()\p1,CollisionRemark()\p2)
         DeleteElement(CollisionRemark())
      EndIf
   Wend
   UpdateConstraints() ;Federn werden geupdated
EndProcedure
Procedure UpdateParticleHalfspaceCollision(); uses the Hessche Normal Form to solve collision / benutzt die Hessische Normalenform zum lösen der Kollision
   Protected n0.vect
   Protected length.d
   Protected distance.d
   Protected h.vect
   ResetList(halfspace())
   While NextElement(halfspace())
      For i=1 To count\particle
         vect(n0,halfspace()\n0\x,halfspace()\n0\y)           
         vect(h,particle(i)\p\x-halfspace()\p\x,particle(i)\p\y-halfspace()\p\y)
         distance=dotproduct(h,n0)
         distance-particle(i)\r
         If distance<0
            vect(h,n0\x*distance,n0\y*distance)
            vect(particle(i)\p,particle(i)\p\x-h\x,particle(i)\p\y-h\y)
            particle(i)\collision=1
         EndIf
      Next
   Wend
EndProcedure
Procedure CalcStep() ; the most important procedure, witch is used in your mainloop / die wichtigste Procedure, welche in der Hauptschleife benutzt wird
   CountAll()
   UpdateVerlet()
   For i=1 To iterations
      If i=1 Or itelligentiterations=0
         UpdateCollisions()
      Else
         UpdateCollisionsIntelligent()
      EndIf
      UpdateParticleHalfspaceCollision()
   Next
   ClearList(CollisionRemark())
EndProcedure
Screenshot:
http://www.xup.in/pic,14437720/screenshot_cvp.PNG
Code: Alles auswählen
XIncludeFile "CircleVerletPhysics.pb"
Global Screen.vect
vect(screen,800,600)
Global MouseClick.b
Global *SelectedParticle.particle
Global timer.l
Global Frames.l
Global Time.d
Global StartTime.d
Global fps.l
Procedure FrameCount()
   Time=ElapsedMilliseconds()-StartTime
   Frames+1
   If Time>1000
      StartTime=ElapsedMilliseconds()
      fps=Frames
      Frames=0
   EndIf
   ;timestep=60/fps*0.8
EndProcedure
Procedure Init()
   InitSprite()
   InitKeyboard()
   InitMouse()
   OpenWindow(0, 0, 0, Screen\x, Screen\y, "physix", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget)
   OpenWindowedScreen(WindowID(0), 0, 0, Screen\x,Screen\y,0, 0, 0)
EndProcedure
Procedure CreateBox(x1.d,y1.d,x2.d,y2.d,r,m)
   CreateParticle(x1,y1,r,m)
   CreateParticle(x1,y2,r,m)
   CreateParticle(x2,y1,r,m)
   CreateParticle(x2,y2,r,m)
   CreateConstraint(particle(count\particle),particle(count\particle-1),1)
   CreateConstraint(particle(count\particle-1),particle(count\particle-2),1)
   CreateConstraint(particle(count\particle-2),particle(count\particle-3),1)
   CreateConstraint(particle(count\particle-3),particle(count\particle),1)
   CreateConstraint(particle(count\particle),particle(count\particle-2),1)
   CreateConstraint(particle(count\particle-1),particle(count\particle-3),1)
EndProcedure
Procedure CreateChain(x,y)
   CreateParticle(x,y,0,0.01)
   CreateConstraint(particle(count\particle-1),particle(count\particle),1)
   constraint(count\constraint)\length=5
EndProcedure
Procedure RenderHalfSpace()
   Protected t.d
   Protected y1.d
   Protected y2.d
   Protected x1.d
   Protected x2.d
   
   If Abs(halfspace()\v\x)>Abs(halfspace()\v\y)
      t=-halfspace()\p\x/halfspace()\v\x
      y1=halfspace()\p\y+t*halfspace()\v\y
   
      t=(Screen\x-halfspace()\p\x)/halfspace()\v\x
      y2=halfspace()\p\y+t*halfspace()\v\y
      LineXY(0,y1,Screen\x,y2,RGB(255,255,255))
      LineXY(Screen\x/2,(y1+y2)/2,Screen\x/2-halfspace()\n0\x*100,(y1+y2)/2-halfspace()\n0\y*100,RGB(255,255,255))
   Else
      t=-halfspace()\p\y/halfspace()\v\y
      x1=halfspace()\p\x+t*halfspace()\v\x
   
      t=(Screen\y-halfspace()\p\y)/halfspace()\v\y
      x2=halfspace()\p\x+t*halfspace()\v\x
      LineXY(x1,0,x2,Screen\y,RGB(255,255,255))
      LineXY((x1+x2)/2,Screen\y/2,(x1+x2)/2-halfspace()\n0\x*100,Screen\y/2-halfspace()\n0\y*100,RGB(255,255,255))
   EndIf
   
   
EndProcedure
Procedure Render()    ;draw stuff
   Protected i.l
   ClearScreen(RGB(0,0,0))
   StartDrawing(ScreenOutput())
   DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
   
   DrawText(10,50,"Rechtsklick : Particle greifen",RGB(100,0,255))
   DrawText(10,65,"Linksclick : Particle erstellen",RGB(100,0,255))
   DrawText(10,80,"Leertaste : Box erstellen",RGB(100,0,255))
   DrawText(10,95,"Entf : Particle löschen",RGB(100,0,255))
   
   ;Render Particles
   For i=1 To count\particle
      Circle(particle(i)\p\x,particle(i)\p\y,particle(i)\r,RGB(100,100,255))
   Next
   If *SelectedParticle<>#Null
     Circle(*SelectedParticle\p\x,*SelectedParticle\p\y,*SelectedParticle\r+5,RGB(255,0,0))
   EndIf
   
   ;Render Constraints
   For i=1 To count\constraint
      FrontColor(RGB(255,0,100))
      LineXY(constraint(i)\p1\p\x,constraint(i)\p1\p\y,constraint(i)\p2\p\x,constraint(i)\p2\p\y)
   Next
   
   ;Render Halfspaces
   ResetList(halfspace())
   While NextElement(halfspace())
      renderhalfspace()
   Wend
   Box(MouseX()-2,MouseY()-2,5,5,RGB(255,0,0))
   FrontColor(RGB(255,255,255))
   DrawText(0,0,"fps : "+Str(fps))
   DrawText(0,15,"p+c : "+Str(count\constraint+count\particle))
   
   StopDrawing()
   FlipBuffers() 
EndProcedure
Procedure controls()
   ExamineMouse()
   ExamineKeyboard()
   If MouseButton(1) And MouseClick=0
      MouseClick=1
   ElseIf MouseButton(1)
      MouseClick=2
   EndIf
   If MouseButton(2) And MouseClick=0
      MouseClick=3
   ElseIf MouseButton(2)
      MouseClick=4
   EndIf
   If MouseButton(2)=0 And MouseButton(1)=0
      MouseClick=0
   EndIf
   
   If MouseButton(1) And timer=1
      r=10+Random(15)
      CreateParticle(MouseX(),MouseY(),r,r/20)
   EndIf
   
   If MouseButton(2) And *SelectedParticle<>#Null
       vect(*SelectedParticle\p,MouseX(),MouseY())  
   Else
      *SelectedParticle=PointToParticle(MouseX(),MouseY(),5)
   EndIf
   
   If KeyboardReleased(#PB_Key_Space)
      CreateBox(MouseX()-25,MouseY()-25,MouseX()+25,MouseY()+25,20,1)
   EndIf
   If KeyboardReleased(#PB_Key_Delete)
       If *SelectedParticle<>#Null
         deleteparticle(*SelectedParticle)
       EndIf
   EndIf
   ExamineKeyboard()
   ExamineMouse()
EndProcedure
AddHalfSpace(1,1,-1,0)   ;Bildschirmränder
AddHalfSpace(1,1,0,1)
AddHalfSpace(screen\x-1,0,0,-1)
AddHalfSpace(0,Screen\y-1,1,0)
;Anfangszeug wird erstellt
CreateParticle(50,400,15,0)
For i=1 To 10
   CreateParticle(50+30*i,400,15,0.5)
   CreateConstraint(particle(count\particle),particle(count\particle-1),1)
Next
Particle(count\particle)\m=0
CreateParticle(100,300,20,1)
Particle(count\particle)\a\y=-0.2
CreateParticle(100,340,1,0.01)
CreateConstraint(particle(count\particle),particle(count\particle-1),1)
For i=1 To 20
   CreateChain(100,340+i*5)
Next
For i=1 To 10
   CreateChain(100+5*i,440)
Next
For i=1 To 20
   CreateChain(150,440-i*5)
Next
CreateParticle(150,300,25,1)
Particle(count\particle)\a\y=-0.2
createconstraint(Particle(count\particle),Particle(count\particle-1),1)
;*************MAIN PROGRAM****************
Init()
countAll()
Repeat
   
   Repeat
   WEvent=WindowEvent()
      Select WEvent
          Case #PB_Event_CloseWindow
              End
          EndSelect
   Until WEvent=0 ;Bis es keine neuen Informationen gibt.
   timer+1
   If timer>=5
      timer=0
   EndIf
   FrameCount()
   render()
   CalcStep()
   controls()
   
Until KeyboardPushed(#PB_Key_Escape)
End
[edit] neueste Versionen werden wegen der Größe ab nun als download reingestellt
neueste Version:
http://www.xup.in/dl,82663857/CircleVer ... cs0.1.rar/

 
 
 
  

 
 