PureBasic Forums - English

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

Code: Select all

; -    +    ; restart with bigger balls
; -    -    ; restart with smaller balls