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