Code:
; Author: Kelebrindae
; Date: December, 15, 2010
; PB version: v4.51
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; Demo for my Verlet 2D physics engine.
;
; F1 to F9 : Create pre-defined sets of objects
; Left mouse button: Pick an object
; Del: Delete the picked object (or all objects if none is picked)
; Return: Enable/disable drawing (for benchmarking)
; Right-Ctrl : Slow motion
; ---------------------------------------------------------------------------------------------------------------
; Known bugs and limitations:
; ---------------------------------------------------------------------------------------------------------------
; - The drawing method used in this demo is quite slow. To test the real speed of the engine, use the
; "#PB_Screen_NoSynchronization" flag in OpenWindowedScreen and press "Return" (disables drawing)
; ---------------------------------------------------------------------------------------------------------------
; Window size
#SCREENWIDTH = 800
#SCREENHEIGHT = 500
; Verlet integration library
IncludeFile "verlet2D.pbi"
; General purpose variables
Global Dim *p.pointmass_struct(20)
Global *body.rigidBody_struct
Global drawmode.b = #True, mousemode.b = #False
Global *mousePoint.pointmass_struct, *ptrPoint.pointmass_struct
Global timer.i,j.i,minDistance.f,distance.f,numObj.i,numFps.i,numFpsShown.i
;- --- Procedures ---
EnableExplicit
;********************************************************
;- Drawing procedures
;********************************************************
; Draw all the points
Procedure drawpointmasses()
Protected w.i,h.i
ForEach pointmass()
; not static => white circle
If pointmass()\invmass > 0
Circle(pointmass()\x,pointmass()\y,2,$FFFFFF)
; also, we draw the speed as yellow lines (but most of the time, it's invisible)
w = pointmass()\oldX - pointmass()\x
h = pointmass()\oldY - pointmass()\y
If w = 0
w = 1
EndIf
If h = 0
h = 1
EndIf
Line(pointmass()\x,pointmass()\y,w,h,$00FFFF)
Else ; static => blue cross
Line(pointmass()\x - 3,pointmass()\y - 3,7,7,$FF0000)
Line(pointmass()\x - 3,pointmass()\y + 3,7,-7,$FF0000)
EndIf
Next pointmass()
EndProcedure
; Draw all the constraints
Procedure drawconstraints()
Protected w.i,h.i
ForEach constraint()
w = constraint()\p2\x - constraint()\p1\x
h = constraint()\p2\y - constraint()\p1\y
If w = 0
w = 1
EndIf
If h = 0
h = 1
EndIf
; Draw constraints in green, or grey is they are disabled
If constraint()\enable = #True
Line(constraint()\p1\x,constraint()\p1\y,w,h,$00FF00)
Else
Line(constraint()\p1\x,constraint()\p1\y,w,h,$777777)
EndIf
Next constraint()
EndProcedure
;********************************************************
;- Pre-defined objects
;********************************************************
; Create a single line. Useful to figure the ground, the walls, etc..
; (It's made of two points and TWO constraints, because my collision algo doesn't seem to like single constraint bodies...)
Procedure createLine(x1.i,y1.i,x2.i,y2.i,mass.f = 1)
Protected *body.rigidBody_struct
*body = createBody()
*p(1) = addBodyPointmass(*body,x1,y1,mass)
*p(2) = addBodyPointmass(*body,x2,y2,mass)
addBodyConstraint(*body,*p(1),*p(2))
addBodyConstraint(*body,*p(2),*p(1))
ProcedureReturn *body
EndProcedure
; Create a triangle
Procedure createTriangle(x.i,y.i,width.i,height.i,mass.f = 1,hspeed.f = 0,vspeed.f = 0,rotation.f = 0)
Protected *body.rigidBody_struct
*body = createBody()
*p(1) = addBodyPointmass(*body,x,y,mass,hspeed+rotation,vspeed)
*p(2) = addBodyPointmass(*body,x,y+height,mass,hspeed,vspeed)
*p(3) = addBodyPointmass(*body,x+width,y,mass,hspeed,vspeed+rotation)
addBodyConstraint(*body,*p(1),*p(2))
addBodyConstraint(*body,*p(1),*p(3))
addBodyConstraint(*body,*p(2),*p(3))
ProcedureReturn *body
EndProcedure
; Create a box
Procedure createBox(x.i,y.i,width.i,height.i,mass.f = 1,hspeed.f = 0,vspeed.f = 0,rotation.f = 0)
Protected *body.rigidBody_struct
*body = createBody()
*p(1) = addBodyPointmass(*body,x,y,mass,hspeed+rotation,vspeed)
*p(2) = addBodyPointmass(*body,x,y+height,mass,hspeed,vspeed)
*p(3) = addBodyPointmass(*body,x+width,y+height,mass,hspeed-rotation,vspeed)
*p(4) = addBodyPointmass(*body,x+width,y,mass,hspeed+rotation,vspeed)
addBodyConstraint(*body,*p(1),*p(2))
addBodyConstraint(*body,*p(2),*p(3))
addBodyConstraint(*body,*p(3),*p(4))
addBodyConstraint(*body,*p(1),*p(4))
addBodyConstraint(*body,*p(1),*p(3),#False)
addBodyConstraint(*body,*p(2),*p(4),#False)
ProcedureReturn *body
EndProcedure
; Create a chain of lines which can be used as a rope, an elastic, a bridge, etc..
Procedure createRope(x1.i,y1.i,x2.i,y2.i,nbSegments.i)
Protected i.i
Protected x.f = x1,y.f = y1
Protected xd.f = (x2 - x1) / nbSegments,yd.f = (y2 - y1) / nbSegments
Protected *body.rigidBody_struct
AddElement(compound())
For i=1 To nbSegments
*body = createBody()
If i=1
*p(1) = addBodyPointmass(*body,x,y,0) ; mass = 0 => static point
Else
*p(1) = *p(2)
; Re-use previous point
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(1) )
EndIf
; add next point
x+xd
y+yd
*p(2) = addBodyPointmass(*body,x,y)
; create link between the two points
addBodyConstraint(*body,*p(1),*p(2))
addBodyConstraint(*body,*p(2),*p(1))
*body\ptrParent = @compound()
Next i
ProcedureReturn *body
EndProcedure
; Create a swing (for all your circus needs ;) )
Procedure createSwing(x.i,y.i,width.i,height.i,center.i = 0,mass.f = 1)
Protected *body.rigidBody_struct
If center = 0
center = x + width/2
EndIf
*body = createBody()
*p(1) = addBodyPointmass(*body,x,y,mass)
*p(2) = addBodyPointmass(*body,center,y,0)
*p(3) = addBodyPointmass(*body,x + width,y,mass)
*p(4) = addBodyPointmass(*body,center,y + height,mass)
addBodyConstraint(*body,*p(1),*p(2))
addBodyConstraint(*body,*p(2),*p(3))
addBodyConstraint(*body,*p(2),*p(4),#False)
addBodyConstraint(*body,*p(1),*p(4))
addBodyConstraint(*body,*p(3),*p(4))
ProcedureReturn *body
EndProcedure
; Create a ball
Procedure createBall(x.i,y.i,radius.f,mass.f = 1)
Protected i.i
Protected *body.rigidBody_struct
*body = createBody()
*p(1) = addBodyPointmass(*body,x,y,mass*3)
For i = 0 To 330 Step 30
If i = 0
*p(2) = addBodyPointmass(*body,x+Cos(Radian(i))*radius,y+Sin(Radian(i))*radius,mass)
*p(5) = *p(2)
Else
*p(3) = *p(2)
*p(2) = addBodyPointmass(*body,x+Cos(Radian(i))*radius,y+Sin(Radian(i))*radius,mass)
addBodyConstraint(*body,*p(2),*p(3))
addBodyConstraint(*body,*p(1),*p(3),#False)
EndIf
Next i
addBodyConstraint(*body,*p(2),*p(5))
addBodyConstraint(*body,*p(1),*p(2),#False)
ProcedureReturn *body
EndProcedure
; Create a primitive ragdoll
Procedure createRagdoll(x.i,y.i,width.i = 50,height.i = 100,legSupport.b = #False)
Protected *ptrCompound.compound_struct,*ptrTorso.rigidbody_struct
Protected unitX.f = width / 5,unitY.i = height / 10
; Note to self: All this is a bit complicated; Need a way to attach a body to an other more easily...
*ptrCompound = AddElement(compound())
; Torso
*ptrTorso = createBody()
*ptrTorso\ptrParent = *ptrCompound
*p(1) = addBodyPointmass(*ptrTorso,x + unitX,y)
*p(2) = addBodyPointmass(*ptrTorso,x + 4*unitX,y)
*p(3) = addBodyPointmass(*ptrTorso,x + 1.5*unitX,y + 5*unitY)
*p(4) = addBodyPointmass(*ptrTorso,x + 3.5*unitX,y + 5*unitY)
addBodyConstraint(*ptrTorso,*p(1),*p(2))
addBodyConstraint(*ptrTorso,*p(1),*p(3))
addBodyConstraint(*ptrTorso,*p(2),*p(4))
addBodyConstraint(*ptrTorso,*p(3),*p(4))
addBodyConstraint(*ptrTorso,*p(1),*p(4),#False)
addBodyConstraint(*ptrTorso,*p(2),*p(3),#False)
; Right forearm
*body = createBody()
*body\ptrParent = *ptrCompound
*p(5) = addBodyPointmass(*body,x,y + 3*unitY,0.5)
*p(6) = addBodyPointmass(*body,x,y + 6*unitY,0.5)
addBodyConstraint(*body,*p(5),*p(6))
addBodyConstraint(*body,*p(6),*p(5))
; Right arm (we re-use already existing points from the foream and the torso)
*body = createBody()
*body\ptrParent = *ptrCompound
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(1) )
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(5) )
addBodyConstraint(*body,*p(5),*p(1))
addBodyConstraint(*body,*p(1),*p(5))
; Left forearm
*body = createBody()
*body\ptrParent = *ptrCompound
*p(7) = addBodyPointmass(*body,x + 5*unitX,y + 3*unitY,0.5)
*p(8) = addBodyPointmass(*body,x + 5*unitX,y + 6*unitY,0.5)
addBodyConstraint(*body,*p(7),*p(8))
addBodyConstraint(*body,*p(8),*p(7))
; Left arm (we re-use already existing points from the foream and the torso)
*body = createBody()
*body\ptrParent = *ptrCompound
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(2) )
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(7) )
addBodyConstraint(*body,*p(7),*p(2))
addBodyConstraint(*body,*p(2),*p(7))
; Right leg
*body = createBody()
*body\ptrParent = *ptrCompound
*p(9) = addBodyPointmass(*body,x + unitX,y + 8*unitY)
*p(10) = addBodyPointmass(*body,x + unitX,y + 11*unitY)
addBodyConstraint(*body,*p(9),*p(10))
addBodyConstraint(*body,*p(10),*p(9))
; Right thigh (we re-use already existing points from the leg and the lower torso)
*body = createBody()
*body\ptrParent = *ptrCompound
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(3) )
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(9) )
addBodyConstraint(*body,*p(9),*p(3))
addBodyConstraint(*body,*p(3),*p(9))
; Left leg
*body = createBody()
*body\ptrParent = *ptrCompound
*p(11) = addBodyPointmass(*body,x + 4*unitX,y + 8*unitY)
*p(12) = addBodyPointmass(*body,x + 4*unitX,y + 11*unitY)
addBodyConstraint(*body,*p(11),*p(12))
addBodyConstraint(*body,*p(12),*p(11))
; Left thigh (we re-use already existing points from the leg and the lower torso)
*body = createBody()
*body\ptrParent = *ptrCompound
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(4) )
*body\nbPoint + 1
*body\ptrPointList = ReAllocateMemory(*body\ptrPointList,(*body\nbPoint + 1) * #SIZEOFPTR )
PokeI(*body\ptrPointList + *body\nbPoint * #SIZEOFPTR , *p(11) )
addBodyConstraint(*body,*p(11),*p(4))
addBodyConstraint(*body,*p(4),*p(11))
; Support constraints (without them, the doll can't stand up)
If legSupport = #True
createConstraint(*p(9),*p(11),#False)
createConstraint(*p(10),*p(12),#False)
createConstraint(*p(9),*p(4),#False)
createConstraint(*p(10),*p(11),#False)
EndIf
ProcedureReturn *ptrTorso
EndProcedure
; Create some pre-defined objects, for demo's sake)
Procedure createObjects(num.i)
Protected x.i,i.i,j.i
Select num
Case 0 ; Reset
ClearList(compound())
ClearList(body())
ClearList(constraint())
ClearList(pointmass())
; Ground and walls
createBox(-50,#SCREENHEIGHT,#SCREENWIDTH+100,50,0)
createBox(-51,-5000,50,#SCREENHEIGHT + 5000,0)
createBox(#SCREENWIDTH,-5000,50,#SCREENHEIGHT + 5000,0)
Case 1 ; Random boxes
For i = 1 To 8
createbox(i * 75, 0 ,50,50,1,(300 - Random(600)) / 1000.0,(300 - Random(600)) / 1000.0,(300 - Random(600)) / 1000.0)
Next i
createBox(200,150,350,70,5)
Case 2 ; Pile o' boxes
x = Random(700)+20
For j=1 To 7
createBox(x,#SCREENHEIGHT - (j * 50),50,50 )
Next j
Case 3 ; a ball, a line, a triangle
createLine(250,300 + Random(100),550,300 + Random(100),0)
createTriangle(350,50,40,60)
createBall(560,50,25,0.2)
Case 4 ; a catapult
x = Random(400) + 100
createSwing(x,450,200,45)
createBox(x - 16,450,15,50,0)
createBox(x,410,25,25)
createBox(x + 150,0,50,50,10)
Case 5 ; Rope
x = Random(600)+50
createRope(x,50,x+150,150,8)
Case 6 ; Bridge (just a rope with both ends static)
*body = createRope(450,250,680,250,10)
*p(1) = PeekI(*body\ptrPointList + (*body\nbPoint * #SIZEOFPTR))
*p(1)\invmass = 0
Case 7 ; Ragdoll
createRagdoll(500,200)
Case 8 ; big boxes atop static points
createLine(250,400,250,490,0)
createBox(149,350,200,50,1)
createLine(550,400,550,490,0)
createBox(451,350,200,50,1)
Case 9 ; speed test
For i = 10 To #SCREENWIDTH-60 Step 60
For j=1 To 10
createBox(i,#SCREENHEIGHT - (j * 50),50,50 )
Next j
Next i
EndSelect
EndProcedure
; Deletes the current body and all its points and constraints
Macro DELETEBODY()
; Delete body's constraints
*ptr = body()\ptrConstraintList
For i = 0 To body()\nbEdge
; But first, check if it hasn't been already deleted
If FindString(listDeleted," "+Str(PeekI(*ptr))+" ",1) = 0
ChangeCurrentElement(constraint(),PeekI(*ptr))
DeleteElement(constraint())
; Store the reference of the deleted constraint
listDeleted + " "+Str(PeekI(*ptr))+" "
EndIf
*ptr + #SIZEOFPTR
Next i
; Delete body's points
*ptr = body()\ptrPointList
For i = 0 To body()\nbPoint
; But first, check if it hasn't been already deleted
If FindString(listDeleted," "+Str(PeekI(*ptr))+" ",1) = 0
ChangeCurrentElement(pointmass(),PeekI(*ptr))
DeleteElement(pointmass())
; Store the reference of the deleted point
listDeleted + " "+Str(PeekI(*ptr))+" "
EndIf
*ptr + #SIZEOFPTR
Next i
; Store the reference of the deleted body
listDeleted +" "+Str(@body())+" "
; Delete the body
DeleteElement(body())
EndMacro
; Deletes all things tied to the point in input => constraints, bodies, compound
Procedure deleteObjectFromPoint(*ptrPoint.pointmass_struct)
Protected *ptrConst.constraint_struct
Protected *ptr,i.i
Protected listDeleted.s
ForEach constraint()
; if the constraint contains the point, delete it and its parents (body, compound...)
If constraint()\p1 = *ptrPoint Or constraint()\p2 = *ptrPoint
*ptrConst = @constraint()
If constraint()\ptrParent <> 0 And FindString(listDeleted," "+Str(@body())+" ",1) = 0
; Find the parent body
ChangeCurrentElement(body(),constraint()\ptrParent)
; If the body is part of a compound, delete the compound
If body()\ptrParent <> 0
If FindString(listDeleted," "+Str(body()\ptrParent)+" ",1) = 0
ChangeCurrentElement(compound(),body()\ptrParent)
ForEach body()
If body()\ptrParent = @compound()
DELETEBODY()
EndIf
Next body()
; Store the reference of the deleted compound
listDeleted + " "+Str(@compound())+" "
DeleteElement(compound())
EndIf ; if FindString(listDeleted ...
Else
DELETEBODY()
EndIf ; else (not part of a compound)
EndIf ; if constraint()\ptrParent <> 0...
EndIf ; if constraint()\p1 = *ptrPoint or...
Next constraint()
EndProcedure
;DisableExplicit
;********************************************************
;- --- Main program ---
;********************************************************
;- initialization
InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()
;- Window
OpenWindow(0, 0, 0, #SCREENWIDTH, #SCREENHEIGHT, "Verlet", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, #SCREENWIDTH,#SCREENHEIGHT, 0, 0, 0,#PB_Screen_SmartSynchronization)
; Initialize environnement (3 objects: a ground, two walls)
createObjects(0)
;- --- Main Loop ---
timer = ElapsedMilliseconds()
Repeat
While WindowEvent() : Wend
; Sub-sampling => executes the simulation in small steps; slower, but more precise
For j = 1 To #SUBSAMPLING
; Moves the points
UPDATE_POINTMASSES()
If *mousePoint > 0
*mousePoint\x = MouseX()
*mousePoint\y = MouseY()
*mousePoint\oldX = *mousePoint\x
*mousePoint\oldY = *mousePoint\y
EndIf
; Solves the constraints
UPDATE_CONSTRAINTS()
; Solves the collisions
MANAGE_COLLISIONS()
Next j
;- Keyboard
ExamineKeyboard()
If KeyboardPushed(#PB_Key_RightControl)
Delay(100)
EndIf
If KeyboardReleased(#PB_Key_Return)
drawmode = 1-drawmode
EndIf
If KeyboardReleased(#PB_Key_F1)
createObjects(1)
EndIf
If KeyboardReleased(#PB_Key_F2)
createObjects(2)
EndIf
If KeyboardReleased(#PB_Key_F3)
createObjects(3)
EndIf
If KeyboardReleased(#PB_Key_F4)
createObjects(4)
EndIf
If KeyboardReleased(#PB_Key_F5)
createObjects(5)
EndIf
If KeyboardReleased(#PB_Key_F6)
createObjects(6)
EndIf
If KeyboardReleased(#PB_Key_F7)
createObjects(7)
EndIf
If KeyboardReleased(#PB_Key_F8)
createObjects(8)
EndIf
If KeyboardReleased(#PB_Key_F9)
createObjects(9)
EndIf
;- Mouse
ExamineMouse()
If mousemode = #False
If MouseButton(#PB_MouseButton_Left) And ListSize(pointmass()) > 0
minDistance = 999999
ForEach pointmass()
distance = (MouseX() - pointmass()\x)*(MouseX() - pointmass()\x) + (MouseY() - pointmass()\y)*(MouseY() - pointmass()\y)
If distance < minDistance
*mousePoint = @pointmass()
minDistance = distance
EndIf
Next pointmass()
If mindistance <= 300
mousemode = #True
Else
*mousePoint = 0
EndIf
EndIf
; Del => delete all objects
If KeyboardReleased(#PB_Key_Delete)
createObjects(0)
numobj=0
EndIf
Else
If MouseButton(#PB_MouseButton_Left) = 0
mousemode = #False
*mousePoint = 0
EndIf
; Del => delete only the picked object
If KeyboardReleased(#PB_Key_Delete) And ListSize(pointmass()) > 0
deleteObjectFromPoint(*mousePoint)
mousemode = #False
*mousePoint = 0
EndIf
EndIf
;- Drawing
ClearScreen($000001)
StartDrawing(ScreenOutput())
If drawmode = #True
Circle(MouseX(),MouseY(),4,$0000FF)
drawconstraints()
drawpointmasses()
numobj=0
ForEach body()
numobj+1
Box(body()\center\x,body()\center\y,2,2,$FF00FF)
Next body()
EndIf
numfps+1
If ElapsedMilliseconds()-timer >= 1000
numfpsShown = numfps
numfps=0
timer = ElapsedMilliseconds()
EndIf
DrawText(0,0,Str(numobj) + " obj. / " + Str(numfpsShown) + "FPS")
StopDrawing()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End
FAQ
Search
Register
Login
)
Looks very good - thank you Kelebrindae!