I managed to come up with some pool physics throughout yesterday and today, they may not be entirely accurate as I couldn't find anything on the internet about pool physics apart from some 90 degree velocity rule. I know real balls spin, but I haven't taken that into account yet. Therefore I had to go by some guessing and trial and error to get the right physics.
I have had some problems with the balls sticking to each other, I managed to pretty much eliminate this bug by doing 10 collision checks each loop, and moving the balls at 1/10th the visible speed. Obvoiusly it may still happen as in real life there are infinate collision checks
, just turn the variable "numSteps" up if you find them sticking.
Please give me credit if you use this code in any way (one name springs to mind
).
LMB to control cue ball
Spacebar to reset balls
Download:
http://www.freewebs.com/thedarkbasicplace/forumstuff/pool.rar
Updated Version:
`===================
` Pool Physics Demo
` By Joseph Thomson
` 24/01/04
`===================
`If you use any of this code in any way please give
`credit to me for the original code.
`Position data for balls
DATA 100,240
DATA 400,240
DATA 421,230,421,250
DATA 442,220,442,240,442,260
DATA 463,210,463,230,463,250,463,270
DATA 484,200,484,220,484,240,484,260,484,280
DATA 505,190,505,210,505,230,505,250,505,270,505,290
`Ball type with velocity and position
TYPE ballType
xPos AS FLOAT
yPos AS FLOAT
xVel AS FLOAT
yVel AS FLOAT
ENDTYPE
`Number of balls and ball radius
numBalls AS INTEGER = 16
ballRad AS INTEGER = 10
DIM balls(numBalls) AS ballType
GOSUB placeBalls
`Walls
topWall = 10
bottomWall = 470
leftWall = 10
rightWall = 630
`Increase for increased accuracy
numSteps AS INTEGER = 30
tableFriction AS FLOAT = 0.025
wallDecay AS FLOAT = 1.0
shotAng AS FLOAT
shotPower AS FLOAT
mouseHold AS INTEGER
mouseHoldX AS FLOAT
mouseHoldY AS FLOAT
dist AS FLOAT
angleBetween AS FLOAT
ang1 AS FLOAT
ang2 AS FLOAT
vel1 AS FLOAT
vel2 AS FLOAT
velX1 AS FLOAT
velX2 AS FLOAT
velY1 AS FLOAT
velY2 AS FLOAT
totalVel AS FLOAT
SYNC ON
SYNC RATE 60
DO
`Draw walls
INK RGB(255,255,255),0
BOX leftWall-1,topWall-1,rightWall+1,bottomwall+1
INK RGB(0,0,0),0
BOX leftWall,topWall,rightWall,bottomwall
`Do the movement of the balls and collision detection in steps, for increased accuracy
FOR l=1 TO numSteps
`Loop through all balls
FOR x=1 TO numBalls
`Move the ball
INC balls(x).xPos,balls(x).xVel/numSteps
INC balls(x).yPos,balls(x).yVel/numSteps
`Control the shooting of the ball
IF MOUSECLICK()=1
IF mouseHold = 0
mouseHold = 1
mouseHoldX = MOUSEX()
mouseHoldY = MOUSEY()
ELSE
shotPower = SQRT((mouseHoldX-MOUSEX())^2+(mouseHoldY-MOUSEY())^2)*0.2
IF shotPower > 100.0 THEN shotPower = 100.0
shotAng = 360-(180-ATANFULL(mouseHoldX-MOUSEX(),mouseHoldY-MOUSEY()))
ENDIF
ELSE
IF MOUSECLICK()=0 AND mouseHold = 1
mouseHold = 0
balls(1).xVel=SIN(shotAng)*shotPower
balls(1).yVel=COS(shotAng)*shotPower
ENDIF
ENDIF
`Replace the balls if space is pressed
IF SPACEKEY()=1
GOSUB placeBalls
ENDIF
`Control balls' collision with walls (rebounding and energy loss)
IF balls(x).xPos-ballRad < leftWall
balls(x).xPos = leftWall+ballRad
balls(x).xVel = -balls(x).xVel*wallDecay
ENDIF
IF balls(x).xPos+ballRad > rightWall
balls(x).xPos = rightWall-ballRad
balls(x).xVel = -balls(x).xVel*wallDecay
ENDIF
IF balls(x).yPos-ballRad < topWall
balls(x).yPos = topWall+ballRad
balls(x).yVel = -balls(x).yVel*wallDecay
ENDIF
IF balls(x).yPos+ballRad > bottomWall
balls(x).yPos = bottomWall-ballRad
balls(x).yVel = -balls(x).yVel*wallDecay
ENDIF
`Loop through all balls
FOR y=1 TO numBalls
`Don't check collision between the same ball
IF y<>x
`Get distance of balls from each other
dist = SQRT((balls(x).xPos-balls(y).xPos)^2+(balls(x).yPos-balls(y).yPos)^2)
`If they are touching
IF dist < ballRad*2
`Get the angle between them
angleBetween = ATANFULL(balls(x).xPos-balls(y).xPos,balls(x).yPos-balls(y).yPos)
`Move the first ball back where it was
DEC balls(x).xPos,balls(x).xVel/numSteps
DEC balls(x).yPos,balls(x).yVel/numSteps
`Get the angles of the balls velocities
ang1 = ATANFULL(balls(x).xVel,balls(x).yVel)
ang2 = ATANFULL(balls(y).xVel,balls(y).yVel)
`Get the speed of the balls velocities
vel1 = SQRT(balls(x).xVel^2+balls(x).yVel^2)*0.9
vel2 = SQRT(balls(y).xVel^2+balls(y).yVel^2)*0.9
`Work out the new velocities of the balls using trig
velX1 = SIN(angleBetween+90)*SIN(360-(angleBetween-ang1))*vel1+SIN(angleBetween)*COS(angleBetween-ang2)*vel2
velY1 = COS(angleBetween+90)*SIN(360-(angleBetween-ang1))*vel1+COS(angleBetween)*COS(angleBetween-ang2)*vel2
velX2 = SIN(angleBetween)*COS(angleBetween-ang1)*vel1+SIN(angleBetween+90)*SIN(360-(angleBetween-ang2))*vel2
velY2 = COS(angleBetween)*COS(angleBetween-ang1)*vel1+COS(angleBetween+90)*SIN(360-(angleBetween-ang2))*vel2
`Set the balls' velocities
balls(x).xVel = velX1
balls(x).yVel = velY1
balls(y).xVel = velX2
balls(y).yVel = velY2
ENDIF
ENDIF
NEXT y
`If the loop is on the last step...
IF l=numSteps
`Draw graphics
IF x=1
INK RGB(255,255,0),0
ELSE
INK RGB(255,255,255),0
ENDIF
CIRCLE balls(x).xPos,balls(x).yPos,ballRad
IF MOUSECLICK()=1 THEN LINE balls(1).xPos,balls(1).yPos,balls(1).xPos+SIN(shotAng)*shotPower*3,balls(1).yPos+COS(shotAng)*shotPower*3
`Control ball friction
totalVel = SQRT(balls(x).xVel^2+balls(x).xVel^2)
DEC balls(x).xVel,tableFriction*totalVel*(balls(x).xVel/totalVel)
DEC balls(x).yVel,tableFriction*totalVel*(balls(x).yVel/totalVel)
ENDIF
NEXT x
NEXT l
SYNC
CLS
LOOP
`Replace the balls
placeBalls:
RESTORE
FOR p=1 TO numBalls
READ balls(p).xPos
READ balls(p).yPos
balls(p).xVel = 0.0
balls(p).yVel = 0.0
NEXT p
RETURN
Do you bite your thumb at me sir?
Athelon XP 1600 Plus (1.4ghz) - ATI Radeon 9600 Pro - 256mb RAM
