-=[Tutorial]=- Basic Pool game & Realistic Collision Ang

thoughtful · **Posted:** Tue Jan 20, 2004 3:08 am

Okay here is my long promised tutorial

I have seen a lot of reference to poor tonys tutorial, which has some bugs. That turotial was meant to be a base information, he said in his post that he did not spend all the time figuring all the trig out. So give him a break Very Happy

. BTW my tutorial was inspired by somewhat same principle and then i added some stuff.

The tutorial is not just on collision but it actually provieds a base package for n e pool game, with a lot of room to expand. I actually took out a old version of my ISP and had to delete some stuff to make it so it doesnt give the whole solution. The collision algorithm is very good, but it might have some problem, such as the balls sticking together, now that i want u to figure on your own (my ISP has an advanced version of the same algorith with no problems Razz

).

Also you can change the values of the constants to increase ball size, decay, highest speed, lowest speed or number of balls e.t.c.

And also i will like to thank tony and catalyst who at the start helped me understand how the realistic collision works.

code:

% by Abdullah Ramay a.k.a Thoughtful
% some variables may not be used in this tutorial becuase this is taken from my game that i am making for my ISP
%click on the white ball and drag to take a shot
var white_x : real% positions
var white_y : real
var white_xsp : real%velocities
var white_ysp : real
var x, y, but : int
var sunk_x, sunk_y : int
const totalballs := 3 %change this to change number of balls
var balls_x : array 1 .. totalballs of real%positions
var balls_y : array 1 .. totalballs of real
var balls_xsp : array 1 .. totalballs of real%velocities
var balls_ysp : array 1 .. totalballs of real
var balls_check : array 1 .. totalballs of int
var font : int := Font.New ("verdana:5:bold")
var font2 : int := Font.New ("verdana:5")
var distance : real
var xsp_temp1, ysp_temp1, xsp_temp2, ysp_temp2 : real
var movedist1, movedist2, collangle, mass, a1, a2, nX, nY, optimisedP : real
const decay := 75 %inversely poportional to stopping, bigger decay= longer moving ball
const lowbar := 50
const ballradius := 8 %radius of the ball, try 18 for monster ball ;=)
const lowestspeed := .01%lowest possible speed
const highestspeed := 10 %highest possible speed
const ballcollidedistance := ballradius * 2 %how far does the ball has to be before it collides
const pocketcollidedistance := 20

var cuecolor : int := white
setscreen ("title:Thoughtful's Pool")
setscreen ("offscreenonly")
View.Set ("graphics:600;350")
sunk_x := 20
sunk_y := 20
mass := 1
for i : 1 .. totalballs %initialises starting positions
balls_x (i) := Rand.Int (20 + lowbar, (maxx - 20)) + Rand.Real
balls_y (i) := Rand.Int (20, (maxy - 20)) + Rand.Real
balls_xsp (i) := 0
balls_ysp (i) := 0
balls_check (i) := 1
end for
% ignore these , jus some initial setup values
white_x := (maxx div 2)
white_y := (maxy div 2) + (lowbar / 2)
white_xsp := 0
white_ysp := 0
proc drawfield %draws the field
drawfillbox (0, 0, maxx, maxy, brown)
drawfillbox (10, 10 + lowbar, maxx - 10, maxy - 10, white)
drawfillbox (20, 20 + lowbar, maxx - 20, maxy - 20, green)

end drawfield
%collision of white ball to balls
proc white_collide
for i : 1 .. totalballs
distance := ((balls_x (i) - white_x) * (balls_x (i) - white_x) + (balls_y (i) - white_y) * (balls_y (i) - white_y)) ** 0.5
if distance < ballcollidedistance then
% this the part which controls the ball to ball collision
/******************************************************************************************
* the collision part is below *
******************************************************************************************/

collangle := arctand ((balls_y (i) - white_y) / ((balls_x (i) - white_x))) %get angle

nX := cosd (collangle) %x vector
nY := sind (collangle) %y vector

a2 := balls_xsp (i) * nX + balls_ysp (i) * nY%figure out reultant velcoities
a1 := white_xsp * nX + white_ysp * nY %resultants

optimisedP := (2.0 * (a1 - a2)) / (mass + mass) %you can have different masses, i am using same masses for all balls

balls_xsp (i) := balls_xsp (i) + (optimisedP * mass * nX) %finally initialises the x and y velocoities to the balls
balls_ysp (i) := balls_ysp (i) + (optimisedP * mass * nY)
white_xsp := white_xsp - (optimisedP * mass * nX)
white_ysp := white_ysp - (optimisedP * mass * nY)
/******************************************************************************************
* the collision part ends *
******************************************************************************************/

end if
end for
end white_collide

%collision of balls to balls
proc balls_collide
for i : 1 .. totalballs
for k : i .. totalballs

if k not= i then
distance := (((balls_x (i) - balls_x (k)) * (balls_x (i) - balls_x (k))) + ((balls_y (i) - balls_y (k)) * (balls_y (i) - balls_y (k)))) ** 0.5
if distance < ballcollidedistance then

collangle := arctand ((balls_y (k) - balls_y (i)) / ((balls_x (k) - balls_x (i))))

nX := cosd (collangle)
nY := sind (collangle)

a1 := balls_xsp (i) * nX + balls_ysp (i) * nY
a2 := balls_xsp (k) * nX + balls_ysp (k) * nY

optimisedP := (2.0 * (a1 - a2)) / (mass + mass)

balls_xsp (i) := balls_xsp (i) - (optimisedP * mass * nX)
balls_ysp (i) := balls_ysp (i) - (optimisedP * mass * nY)
balls_xsp (k) := balls_xsp (k) + (optimisedP * mass * nX)
balls_ysp (k) := balls_ysp (k) + (optimisedP * mass * nY)
% moves the balls forward a step so they dont get stuck with each other( but the balls will still stick)
balls_x (i) += balls_xsp (i)
balls_y (i) += balls_ysp (i)
balls_x (k) += balls_xsp (k)
balls_y (k) += balls_ysp (k)

end if
end if

end for
end for
end balls_collide

% controls the motion& collision with the side bars, also decays the speed so it slows
proc balls_mov
for i : 1 .. totalballs

if balls_check (i) not= 0 then
balls_x (i) += balls_xsp (i)
balls_y (i) += balls_ysp (i)
if balls_x (i) < (20 + ballradius) then
balls_x (i) := 20 + ballradius
balls_xsp (i) := - (balls_xsp (i))
end if
if balls_x (i) > (maxx - (20 + ballradius)) then
balls_x (i) := maxx - (20 + ballradius)
balls_xsp (i) := - (balls_xsp (i))
end if
if balls_y (i) < (20 + ballradius) + lowbar then
balls_y (i) := (20 + ballradius) + lowbar
balls_ysp (i) := - (balls_ysp (i))
end if
if balls_y (i) > (maxy - (20 + ballradius)) then
balls_y (i) := maxy - (20 + ballradius)
balls_ysp (i) := - (balls_ysp (i))
end if

if balls_xsp (i) > 0 then
balls_xsp (i) := balls_xsp (i) - (balls_xsp (i) / decay)
end if
if balls_ysp (i) > 0 then
balls_ysp (i) := balls_ysp (i) - (balls_ysp (i) / decay)
end if
if balls_xsp (i) < 0 then
balls_xsp (i) := balls_xsp (i) + (- (balls_xsp (i) / decay))
end if
if balls_ysp (i) < 0 then
balls_ysp (i) := balls_ysp (i) + (- (balls_ysp (i) / decay))
end if

if balls_ysp (i) > - (lowestspeed) and balls_ysp (i) < (lowestspeed) then
balls_ysp (i) := 0
end if

if balls_xsp (i) > - (lowestspeed) and balls_xsp (i) < (lowestspeed) then
balls_xsp (i) := 0
end if
end if
end for

for i : 1 .. totalballs %draws the balls

drawfilloval (round (balls_x (i)), round (balls_y (i)), ballradius, ballradius, i)
drawfilloval (round (balls_x (i)), round (balls_y (i)), ballradius - 4, ballradius - 4, white)

drawoval (round (balls_x (i)), round (balls_y (i)), ballradius, ballradius, black)
Font.Draw (intstr (i), round (balls_x (i)) - 2, round (balls_y (i)) - 2, font, 7)

end for

end balls_mov
proc whiteball_mov %controls the moving of the white ball

white_x += white_xsp
white_y += white_ysp
Mouse.Where (x, y, but)

% bouncing of the wall
if white_x < (20 + ballradius) then
white_x := 20 + ballradius
white_xsp := - (white_xsp)
end if
if white_x > (maxx - (20 + ballradius)) then
white_x := maxx - (20 + ballradius)
white_xsp := - (white_xsp)
end if
if white_y < (20 + ballradius) + lowbar then
white_y := (20 + ballradius) + lowbar
white_ysp := - (white_ysp)
end if
if white_y > (maxy - (20 + ballradius)) then
white_y := maxy - (20 + ballradius)
white_ysp := - (white_ysp)
end if

% decays the ball
if white_xsp > 0 then
white_xsp := white_xsp - (white_xsp / decay)
end if
if white_ysp > 0 then
white_ysp := white_ysp - (white_ysp / decay)
end if
if white_xsp < 0 then
white_xsp := white_xsp + (- (white_xsp / decay))
end if
if white_ysp < 0 then
white_ysp := white_ysp + (- (white_ysp / decay))
end if
% makes the ball stop
if white_ysp > - (lowestspeed) and white_ysp < (lowestspeed) then
white_ysp := 0
end if

if white_xsp > - (lowestspeed) and white_xsp < (lowestspeed) then
white_xsp := 0
end if

drawfilloval (round (white_x), round (white_y), ballradius, ballradius, white)
drawoval (round (white_x), round (white_y), ballradius, ballradius, black)

end whiteball_mov
proc poolcue
if (x > white_x - 5) and x < (white_x + ballradius) and (y > white_y - ballradius) and y < (white_y + ballradius) and but = 1 then
white_xsp := 0
white_ysp := 0
loop
drawfield
Mouse.Where (x, y, but) %gets
exit when but = 0
drawfilloval (round (white_x), round (white_y), ballradius, ballradius, white)
drawoval (round (white_x), round (white_y), ballradius, ballradius, black)
balls_mov

Draw.Line (round (white_x), round (white_y), x, y, cuecolor)

delay (10)% take this away if the game runs too slowly, my computer is a 2.6 Ghz so doesnt amtters to me :)
View.Update
cls
end loop

white_xsp := (white_x - x) / 15 % gets the power from cue for the shot
white_ysp := (white_y - y) / 15
if white_xsp > highestspeed then % sees if the power is according to the highest speed e.t.c
white_xsp := highestspeed
elsif white_xsp < -highestspeed then
white_xsp := -highestspeed
end if
if white_ysp > highestspeed then
white_ysp := highestspeed
elsif white_ysp < -highestspeed then
white_ysp := -highestspeed
end if
end if
end poolcue
% main loop, i always like procedure, very easy to add rules and stuff to the game, my final isp just uses a single procedure for all rules
loop
drawfield

white_collide
balls_collide
whiteball_mov
balls_mov
if but = 1 then
poolcue
end if
View.Update
cls
end loop

i hope u liked it, if you did let me know by replying

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members