)Here's a little thing that I coded a few months ago, then forgot to post it here (it was before my experimentation with Verlet Physics http://www.purebasic.fr/english/viewtop ... 16&t=44665).
There's a lot of problems with this code, and I won't push it any further. So feel free to change/fix anything you want!
Code: Select all
; Author: Kelebrindae
; Date: october, 7, 2010
; PB version: v4.51
; OS: Windows
; --------------------------------------------------------------------------------------------
; Description:
; --------------------------------------------------------------------------------------------
; Quick and ugly (and very inaccurate) simulation of a bouncing balls. Pachinko, anyone?
;
; Controls:
; - [Space] : reset balls position
; - [Return]: draw a new "level"
; - + ; restart with bigger balls
; - - ; restart with smaller balls
; - Esc : quit
;
; NB: Don't forget to turn off the debugger !
; --------------------------------------------------------------------------------------------
#SCREENWIDTH = 800
#SCREENHEIGHT = 500
#BLANKCOLOR = $010101
; These values applies to a 60Hz frame rate
#GRAVITY = 0.16
#STICKYNESS = 0.4
#STOPTHRESHOLD = 0.05
Structure ball_struct
x.f
y.f
radius.i
elasticity.f
mass.f
onTheGround.b
vx.f ; horizontal velocity
vy.f ; vertical velocity
EndStructure
Global NewList ball.ball_struct()
Global *ptrSilhouette.b
Global angle.i, nbStep.i,i.i
Global ballRadius.i = 12
Global collisionX.f,collisionY.f,normalX.f,normalY.f,VdotN.f,normalForceX.f,normalForceY.f
Global absVx.f, absVy.f,vxStep.f,vyStep.f
Global *ptrBall.ball_struct
; Store sinus and cosinus (faster)
Global Dim cosTable.f(360)
Global Dim sinTable.f(360)
For i=0 To 359
cosTable(i) = Cos( Radian(i) )
sinTable(i) = Sin( Radian(i) )
Next i
EnableExplicit
;- --- Procedures ---
; Draw a ball and grab it as a 3d Sprite
Procedure createBallSprite(radius.i)
If IsSprite(0)
FreeSprite(0)
EndIf
CreateImage(0,51,51)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor($BBBB00)
BackColor($FFFF00)
CircularGradient(14,14,25)
Circle(25,25,25)
StopDrawing()
ResizeImage(0,radius*2,radius*2)
SaveImage(0,"ball.bmp")
FreeImage(0)
LoadSprite(0, "ball.bmp", #PB_Sprite_Texture)
DeleteFile("ball.bmp")
CreateSprite3D(0, 0)
EndProcedure
; Initialize (or reinitialize) the balls' positions
; According to the balls' size, create as much balls as possible at the top of the screen
Procedure initializeBalls(radius.i)
Protected i.i,j.i
i=10+ballRadius
j=ballRadius
ClearList(ball())
Repeat
AddElement(ball())
ball()\x = i
ball()\y = j
ball()\radius = ballRadius
ball()\mass = 10
ball()\elasticity = 0.75
ball()\vx = (20 - Random(40))/10
ball()\vy = 0
ball()\onTheGround = #False
i + ballRadius*2 + 4
If i > #SCREENWIDTH - 10 - ballRadius
i=10+ballRadius
j + ballRadius*2 + 4
EndIf
Until j > 50-ballRadius
EndProcedure
; Look up in the "silhouette" memory array if a given pixel is blank or not
Procedure.b checkCollision(xtest.i, ytest.i, levelWidth.i, levelHeight.i)
If xtest < 1 Or ytest < 1 Or xtest > levelWidth-1 Or ytest > levelHeight-1
ProcedureReturn 255
EndIf
ProcedureReturn PeekB(*ptrSilhouette + (ytest*levelWidth) + xtest)
EndProcedure
; Store the level's "silhouette" in memory to check collisions
Procedure storeSilhouette(numImage.i)
Protected *ptrSilhouette,*ptr
Protected i.i,j.i,width.i,height.i
width = ImageWidth(numImage)
height = ImageHeight(numImage)
*ptrSilhouette = AllocateMemory(width * height)
If *ptrSilhouette <> 0
*ptr = *ptrSilhouette
StartDrawing(ImageOutput(numImage))
For j = 0 To height-1
For i = 0 To width-1
If Point(i,j) <> #BLANKCOLOR
PokeB(*ptr,255)
Else
PokeB(*ptr,0)
EndIf
*ptr+1
Next i
Next j
StopDrawing()
EndIf
ProcedureReturn *ptrSilhouette
EndProcedure
; Draw a random background And create a 3D sprite from it
Procedure drawLevel(*ptrSilhouette = 0)
Protected i.i,x.i,y.i,w.i,h.i
; Free all previously used ressources
If IsSprite(999)
FreeSprite(999)
EndIf
If IsSprite3D(999)
FreeSprite3D(999)
EndIf
If *ptrSilhouette <> 0
FreeMemory(*ptrSilhouette)
EndIf
CreateImage(0,#SCREENWIDTH, #SCREENHEIGHT)
StartDrawing(ImageOutput(0))
Box(0,0,#SCREENWIDTH,#SCREENHEIGHT,#BLANKCOLOR)
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor($616161)
BackColor($EAEAEA)
For i = 0 To 20
x=Random(#SCREENWIDTH):y=50+Random(#SCREENHEIGHT-50):w=Random(25)+10:h=Random(25)+10
LinearGradient(x,y,x+h/2,y+h)
Box(x,y,w,h)
Next i
FrontColor($77777A)
BackColor($CCCCCD)
For i = 0 To 20
x=Random(#SCREENWIDTH):y=50+Random(#SCREENHEIGHT-50):w=Random(25)+10
CircularGradient(x-(w/2),y-(w/2),w)
Circle(x,y,w)
Next i
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,#SCREENWIDTH,50,#BLANKCOLOR)
DrawingMode(#PB_2DDrawing_Outlined)
Box(0,0,#SCREENWIDTH,#SCREENHEIGHT,$FFFFFF)
StopDrawing()
SaveImage(0,"decor.bmp")
LoadSprite(999, "decor.bmp", #PB_Sprite_Texture)
DeleteFile("decor.bmp")
CreateSprite3D(999,999)
; Store level's "silhouette" in memory for faster collision check
; (it uses a lot of memory, though)
*ptrSilhouette = storeSilhouette(0)
FreeImage(0)
; Return the pointer to the silhouette
ProcedureReturn *ptrSilhouette
EndProcedure
; Check collision between two balls. If they collide, set their new speed and direction
; (conversion of a Blitz Basic code from Jim Brown, here: http://www.blitzbasic.com/Community/posts.php?topic=55823 )
Procedure collideBalls(*ptrBall1.ball_struct,*ptrBall2.ball_struct)
Protected collisionDistance.f,actualDistance.f
Protected realcollNormalAngle.f,collNormalAngle.i
Protected moveDist1.f,moveDist2.f
Protected nX.f,nY.f,a1.f,a2.f,optimisedP.f
; Check distance between the balls (don't use SQR to make it faster)
collisionDistance = (*ptrBall1\radius + *ptrBall2\radius)*(*ptrBall1\radius + *ptrBall2\radius)
actualDistance = ( (*ptrBall2\x - *ptrBall1\x)*(*ptrBall2\x - *ptrBall1\x) + (*ptrBall2\y - *ptrBall1\y)*(*ptrBall2\y - *ptrBall1\y) )
; If the balls collide
If actualDistance < collisionDistance
; well, now we need real distances, so => SQR
collisionDistance = *ptrBall1\radius + *ptrBall2\radius
actualDistance = Sqr(actualDistance)
; Compute angle between the to ball
realcollNormalAngle = Degree(ATan2(*ptrBall2\x - *ptrBall1\x,*ptrBall2\y - *ptrBall1\y ))
; Convert this angle to an integer in the 0 - 359 range (to use in the Cos/Sin tables)
If realcollNormalAngle < 0
collNormalAngle = realcollNormalAngle + 360
Else
collNormalAngle = realcollNormalAngle
EndIf
; Move the balls so they don't intersect, according to the collision angle and their mass
moveDist1=(collisionDistance-actualDistance) * (*ptrBall2\mass / (*ptrBall1\mass + *ptrBall2\mass))
moveDist2=(collisionDistance-actualDistance) * (*ptrBall1\mass / (*ptrBall1\mass + *ptrBall2\mass))
*ptrBall1\x - moveDist1 * cosTable(collNormalAngle)
*ptrBall1\y - moveDist1 * sinTable(collNormalAngle)
*ptrBall2\x + moveDist2 * cosTable(collNormalAngle)
*ptrBall2\y + moveDist2 * sinTable(collNormalAngle)
; COLLISION RESPONSE
; n = vector connecting the centers of the balls.
; nX and nY are the components of the normalised vector n
nX = cosTable(collNormalAngle)
nY = sinTable(collNormalAngle)
; Find the components of each movement vectors along n, by using dot product
a1 = *ptrBall1\vx * nX + *ptrBall1\vy * nY
a2 = *ptrBall2\vx * nX + *ptrBall2\vy * nY
; optimisedP = 2(a1 - a2)
; ----------
; m1 + m2
optimisedP = (2.0 * (a1-a2)) / (*ptrBall1\mass + *ptrBall2\mass)
; Resultant vector for first ball
*ptrBall1\vx - (optimisedP * *ptrBall2\mass * nX)
*ptrBall1\vy - (optimisedP * *ptrBall2\mass * nY)
; Resultant vector for second ball
*ptrBall2\vx + (optimisedP * *ptrBall1\mass * nX)
*ptrBall2\vy + (optimisedP * *ptrBall1\mass * nY)
EndIf
EndProcedure
;- --- Main program ---
InitSprite()
InitSprite3D()
InitKeyboard()
;- Window
OpenWindow(0, 0, 0, #SCREENWIDTH, #SCREENHEIGHT, "Bounce", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, #SCREENWIDTH,#SCREENHEIGHT, 0, 0, 0,#PB_Screen_SmartSynchronization)
;- Create a sprite for the balls
createBallSprite(ballRadius)
;- Create a random level
*ptrSilhouette = drawLevel()
;- Create balls
initializeBalls(ballRadius)
;- --- Main Loop ---
Repeat
While WindowEvent() : Wend
ForEach ball()
; If the ball is moving or falling, check for collision
If ball()\vx <> 0 Or ball()\vy <> 0 Or ball()\onTheGround = #False
;- Collision with the background
; If X-velocity or Y-velocity exceeds 1, break movement into N steps where "partial" velocities are smaller then 1 (= sub-sampling)
If ball()\Vx > 1 Or ball()\Vx < -1 Or ball()\Vy > 1 Or ball()\Vy < -1
absVx = Abs(ball()\Vx)
absVy = Abs(ball()\Vy)
If absVx > absVy
nbStep = Int(absVx) + 1
Else
nbStep = Int(absVy) + 1
EndIf
vxStep = ball()\Vx / nbStep
vyStep = ball()\Vy / nbStep
Else
nbStep = 1
vxStep = ball()\Vx
vyStep = ball()\Vy
EndIf
; For each step, check for collision and move the ball
For i = 1 To nbStep
;Check 12 collision points around the ball
For angle = 0 To 330 Step 30
; Get coords for check point at angle [angle]
collisionX = cosTable(angle)
collisionY = sinTable(angle)
; Check collision
If checkCollision( ball()\x + collisionX * ball()\radius, ball()\y + collisionY * ball()\radius ,#SCREENWIDTH,#SCREENHEIGHT)
; Get normal to collision
normalX = -collisionX
normalY = -collisionY
; Move ball a bit away from collision
ball()\y + normalY
ball()\x + normalX
; Project velocity onto collision normal vector
VdotN = vxStep * normalX + vyStep * normalY
; Calculate normal force
normalForceX = -2.0 * normalX * VdotN
normalForceY = -2.0 * normalY * VdotN
; Add normal force to velocity vector
vxStep + normalForceX * ball()\elasticity
vyStep + normalForceY * ball()\elasticity
EndIf
Next angle
; Move the ball
ball()\x + vxStep
ball()\y + vyStep
Next i
; Total velocities = partial velocities * number of steps
ball()\vx = vxStep * nbStep
ball()\vy = vyStep * nbStep
; If the ball is in the air
If checkCollision( ball()\x, ball()\y + ball()\radius + 1,#SCREENWIDTH,#SCREENHEIGHT) = 0
; Apply gravity
ball()\vy + #GRAVITY
ball()\onTheGround = #False
Else
; If the ball is on the ground and its falling speed is under the "stickyness" threshold, consider it's rolling
If ball()\vy < #STICKYNESS And ball()\vy > 0
ball()\onTheGround = #True
ball()\vy = 0
EndIf
; If the ball is rolling on the ground, apply friction
If ball()\onTheGround = #True
ball()\vx * 0.99
; if the ball rolling speed is sufficiently small, stop it.
If ball()\vx < #STOPTHRESHOLD And ball()\vx > -#STOPTHRESHOLD
ball()\vx = 0
EndIf
EndIf ; if ball()\onTheGround = #True...
EndIf ; else... (ball is touching the ground)
;- Collision with all the other balls
*ptrBall = @ball()
ForEach ball()
If @ball() <> *ptrBall
collideBalls(*ptrBall,@ball())
EndIf
Next ball()
ChangeCurrentElement(ball(),*ptrBall)
EndIf ; if the ball is moving or falling...
Next ball()
;- Display screen
Start3D()
; Background
DisplaySprite3D(999,0,0,255)
; Balls
ForEach ball()
DisplaySprite3D(0,ball()\x-ball()\radius,ball()\y-ball()\radius)
Next ball()
Stop3D()
FlipBuffers()
;- Keyboard
ExamineKeyboard()
; Space => reset sim
If KeyboardReleased(#PB_Key_Space)
initializeBalls(ballRadius)
EndIf
; Return => draw a new "level"
If KeyboardReleased(#PB_Key_Return)
*ptrSilhouette = drawLevel(*ptrSilhouette )
initializeBalls(ballRadius)
EndIf
; minus => reset sim with smaller balls
If (KeyboardReleased(#PB_Key_Minus) Or KeyboardReleased(#PB_Key_Subtract)) And ballRadius > 2
ballRadius - 2
createBallSprite(ballRadius)
initializeBalls(ballRadius)
EndIf
; plus => reset sim with bigger balls
If (KeyboardReleased(#PB_Key_Equals) Or KeyboardReleased(#PB_Key_Add)) And ballRadius < 20
ballRadius + 2
createBallSprite(ballRadius)
initializeBalls(ballRadius)
EndIf
Until KeyboardPushed(#PB_Key_Escape)
FreeMemory(*ptrSilhouette)
End
