% 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
|