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