Posted: 24th Jan 2004 16:42
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:
+ Code Snippet
`===================
` 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
Posted: 24th Jan 2004 19:41
Very Nice Seems very accurate to me.
Posted: 24th Jan 2004 20:44
damn good work!
Posted: 24th Jan 2004 21:03
Thanks. I have now uploaded an exe (.rar format) for anyone without dbpro, also I have changed the code a bit, the friction doesn't use curvevalue() now, there is another row of balls and the balls lose energy when they hit each other. I'm hoping this proves for a more realistic demo :S.
Posted: 6th Feb 2004 20:31
"in real life there are infinate collision checks..."
actually there aren't... i think...

Einstien's theory of general realativity says that nothing can go faster than the speed of light and that things moving faster move slower through time. This is because its just like in DB. assuming you have to objects moving at two different speeds, one at 10mph, the other at 5mph. the the universe has a giant loop and is revolving, every other loop the 10mph object moves 1 unit, and every 4th time the 5mph object moves a unit.

move object 1,10
move object 2,5

see the similarity? assuming this and that the speed of light is moving every single revolution of the code we can determain that the sync rate of the universe is:
S=sync rate
C=speed of light
U=single unit in space
M=one mile (c being in miles per second)
S=c*(M/U)

so the universe has a limited sync rate... hmmm god must be one good programmer to have made the whole thing in 7 days.... wow.

mebbe hes the archietect
Posted: 6th Feb 2004 20:42
K, that had nothing to do with my code , though it was interesting to hear. But who says light, or anything, moves in steps? What if they all move in infinitly small steps all the time, ie. constantly.
Posted: 6th Feb 2004 20:49
That would be not possible assuming that the quantum theory is true .
Posted: 6th Feb 2004 21:17
K, I don't have a clue about that though. Science in yr 11 is crap.
Posted: 6th Feb 2004 21:52
god must be one good programmer to have made the whole thing in 7 days.... wow.


Centuries later, we're still awaiting the patch.

But in theory, anything travelling faster than light would distort its shape. There was an example I saw once stating that a 20ft pole could fit length-wise completely inside a barn only 15ft in depth. If you could move the pole through the barn at whatever the insane speed was, theoretically the entire pole would be inside the barn for a fraction of a nanosecond. But now we're just getting off topic.

I looked through your code, but I don't quite get this line.
FOR l=1 TO numSteps

It controls accuracy in what aspect?
Posted: 6th Feb 2004 21:58
Dummy me, I should've read the whole post. I see what you did.
Posted: 23rd Feb 2004 23:00
Pretty good,abit buggy with some angles..or it may have just been the friction I adjusted,I got balls moving continuasly till they hit something using tableFriction AS FLOAT = 0.0005

And I dunno how you got this to run initially,as there is an endif that shouldnt be there in the code!!...........

+ Code Snippet
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

The endif before the Next i shouldnt be there, should be deleted..
Posted: 23rd Feb 2004 23:28
0.0005 friction is hardly anything at all :S thats why the balls didnt appear to slow down .

The endif is meant to be there. I'll show you...

`If the loop is on the last step...
IF l=numSteps : `1 ifs open
`Draw graphics
IF x=1 : `2 ifs open
INK RGB(255,255,0),0
ELSE
INK RGB(255,255,255),0
ENDIF : `1 ifs open

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 : `This if has a then, therefore it doesnt need an endif

`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 : ` No ifs open, et voila
Posted: 24th Feb 2004 20:14
Well,thats very interesting, because if I put the endif back in,it says comand line out of place error!! If I take the endif out its fine!

So really it beats me!! Whats this code for, is it DBpro or DB Classic?? And I have to set the friction to that to make the ball go any reasonable distance!!
Posted: 24th Feb 2004 22:37
It's DBPro of course, wouldn't work in classic. Very odd.
Posted: 18th Mar 2004 18:38
Very nice. If I have time I might expand this into a mini multiplayer pool game. Would be a nice little game to play in work when things are quiet.