REM Project: Billiards Physics
 
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on:sync rate 90
hide mouse
autocam off
position camera 0,40,-300
color backdrop 0
hide light 0
set ambient light 1
make light 1
position light 1,-500,500,-500
set light range 1,10000
global power#
power#=100.0
 
global dim ball_speed#(16)
 
global hit
 
global cueball_speed#
 
make_pool_balls()
make_pool_table()
rack_balls()
make_target()
 
 
do
 
   if keystate(17)=1 then rotate_x(9,1.0)
   if keystate(18)=1 then rotate_y(9,1.0)
   if keystate(19)=1 then rotate_z(9,1.0)
 
   position_camera()
 
   if hit=0 then aim_cueball()
 
   if mouseclick()=1 and hit=0
     hit=1
     ball_speed#(16)=power#/40.0
   endif
 
   if hit=1
 
     collide_with_cushions()
     collide_with_balls()
     move_balls()
   endif
 
   update_shadows()
 
   `text 0,0,str$(screen fps())
 
   sync
loop
end
 
function rotate_x(object,angle#)
   xrotate object object,wrapvalue(angle#+object angle x(object))
endfunction
 
function rotate_y(object,angle#)
   yrotate object object,wrapvalue(angle#+object angle y(object))
   `zrotate object object,wrapvalue(angle#+abs(90-object angle x(object))+object angle z(object))
endfunction
 
function rotate_z(object,angle#)
   zrotate object object,wrapvalue(angle#+object angle z(object))
endfunction
 
 
function rack_balls()
   fact#=sqrt(3.0)*11
   position object 1,0,10,250
   position object 9,11,10,250+fact#
   position object 10,-11,10,250+fact#
   position object 2,22,10,250+fact#*2.0
   position object 8,0,10,250+fact#*2.0
   position object 3,-22,10,250+fact#*2.0
   position object 11,33,10,250+fact#*3.0
   position object 12,11,10,250+fact#*3.0
   position object 4,-11,10,250+fact#*3.0
   position object 13,-33,10,250+fact#*3.0
   position object 5,44,10,250+fact#*4.0
   position object 14,22,10,250+fact#*4.0
   position object 6,0,10,250+fact#*4.0
   position object 15,-22,10,250+fact#*4.0
   position object 7,-44,10,250+fact#*4.0
   position object 16,0,10,-250
endfunction
 
 
function make_pool_table()
for x=0 to 10
for y=0 to 10
ink RGB(50+x*20,50+(y+x)*10,50),0
dot x,y
next y
next x
get image 20,0,0,10,10
 
   make object plain 20,500,1000
      xrotate object 20,-90
      yrotate object 20,-180
      texture object 20,20
      set object emissive 20,rgb(50,50,10)
      make object box 21,15,15,1030
      texture object 21,20
      position object 21,-257.5,7.5,0
   make object box 22,15,15,1030
      texture object 22,20
      position object 22,257.5,7.5,0
   make object box 23,500,15,15
      texture object 23,20
      position object 23,0,7.5,-507.5
   make object box 24,500,15,15
      texture object 24,20
      position object 24,0,7.5,507.5
 
ink rgb(255,255,255),0
endfunction
 
function make_pool_balls()
   for i=1 to 8
      make object sphere i,20,20,20
      select i
         case 1:ink RGB(255,255,0),0:endcase
         case 2:ink RGB(0,0,255),0:endcase
         case 3:ink RGB(255,128,64),0:endcase
         case 4:ink RGB(156,0,223),0:endcase
         case 5:ink RGB(128,0,64),0:endcase
         case 6:ink RGB(0,128,64),0:endcase
         case 7:ink RGB(202,0,0),0:endcase
         case 8:ink RGB(0,0,0),0:endcase
      endselect
      box 0,0,128,128:solid_circle(64,64,7,RGB(250,250,200)):ink 0,0:text 60,57,str$(i)
      get image i,0,30,127,97
      texture object i,i
      position object i,i*20-150,10,0
   next i
width1#=20
for i=9 to 15
      make object sphere i,20,20,20
      ink rgb(250,250,200),0
      box 0,0,128,128
      select i
         case 9:ink RGB(255,255,0),0:endcase
         case 10:ink RGB(0,0,255),0:endcase
         case 11:ink RGB(255,128,64),0:endcase
         case 12:ink RGB(156,0,223),0:endcase
         case 13:ink RGB(128,0,64),0:endcase
         case 14:ink RGB(0,128,64),0:endcase
         case 15:ink RGB(202,0,0),0:endcase
      endselect
      for u=0 to 128
         for v=0 to 128
            width2#=width1#/(cos(abs(v-63)*180.0/50.0)*2.0)
            if abs(u-32)<=width2# then dot u,v
            if abs(u-96)<=width2# then dot u,v
            box 0,0,128,40
            box 0,86,128,128
         next v
      next u
      ink 0,0
      if i=9
         text 60,57,str$(i)
      else
         text 56,57,str$(i)
      endif
      get image i,0,35,127,92
      texture object i,i
      position object i,i*20-150,10,0
   next i
 
   make object sphere 16,20,20,20
   ink rgb(250,250,200),0
   box 0,0,128,128
   get image 16,0,35,127,92
   texture object 16,16
   position object 16,16*20-150,10,0
 
 
   for ball=1 to 16
     set object specular ball,rgb(200,200,200)
     set object specular power ball,25
     set object emissive ball,rgb(50,50,10)
     make object sphere ball+30,20,20,20
     color object ball+30,0
     scale object ball+30,150,1,100
     yrotate object ball+30,-45
     ghost object on ball+30,4
 
   next ball
 
endfunction
 
function solid_circle(x,y,radius,color)
lock pixels
ptr=get pixels pointer()
this=get pixels pitch()
that =bitmap depth()/8
for i=1 to radius*2
   for j=1 to radius*2
      pointer=ptr+((y+j-radius)*this)+(x-radius+i)*that
      if (radius-i)^2+(radius-j)^2<=radius^2 then *pointer=color
   next j
next i
unlock pixels
endfunction
 
function make_target()
 
make object cube 17,1
hide object 17
 
endfunction
 
function position_camera()
 
if hit=1 then smoothness=300 else smoothness=100
position camera curvevalue(object position x(16),camera position x(),50),100,curvevalue(object position z(16),camera position z(),50)
yrotate camera curveangle(object angle y(16),camera angle y(),smoothness)
move camera -5
 
endfunction
 
function aim_cueball()
 
yrotate object 16,object angle y(16)+mousemovex()/3.0
power#=power#-mousemovey()
position object 17,object position x(16),object position y(16),object position z(16)
yrotate object 17,object angle y(16)
move object 17,power#
 
line object screen x(17)-10,object screen y(17)-10,object screen x(17)+10,object screen y(17)+10,
line object screen x(17)-10,object screen y(17)+10,object screen x(17)+10,object screen y(17)-10,
 
endfunction
 
 
function collide_with_cushions()
 
for ball=1 to 16
 
  if object position x(ball)>240 or object position x(ball)<-240
    if object position x(ball)>240 then x#=240
    if object position x(ball)<-240 then x#=-240
    ball_speed#(ball)=ball_speed#(ball)*0.95
    yrotate object ball,object angle y(ball)*-1
  endif
 
  if object position z(ball)>490 or object position z(ball)<-490
    if object position z(ball)>490 then z#=490
    if object position z(ball)<-490 then z#=-490
    ball_speed#(ball)=ball_speed#(ball)*0.95
    yrotate object ball,(object angle y(ball)*-1)+180
  endif
 
next ball
 
endfunction
 
function update_shadows()
 
for ball=1 to 16
position object ball+30,object position x(ball)+8,object position y(ball)-9,object position z(ball)+8
next ball
 
endfunction
 
function find_distance(x1#,z1#,x2#,z2#)
distance#=sqrt(((x2#-x1#)*(x2#-x1#))+((z2#-z1#)*(z2#-z1#)))
endfunction distance#
 
function find_bearing(object1,object2)
objectbearing#=atanfull(object position x(object2)-object position x(object1),object position z(object2)-object position z(object1))
endfunction objectbearing#
 
function collide_with_balls()
 
n=0
`go through all every ball
 
for object=1 to 16
 
`and text for collision against every other ball
`except combinations already checked (n-values)
 
  for target=1+n to 16
 
  if object=target
 
  else
 
  distance#=find_distance(object position x(object),object position z(object),object position x(target),object position z(target))
 
  if distance#<20
 
    move object object,-(20-distance#)
 
    remstart
    -------------------------------------------------------------
    ioa#: initial object angle
    foa#: finial object angle
    ita#: initial target angle
    fta#: final target angle
 
    bearing# is the angle between object and target's centres, and defines the p-direction
    the normal to this line is the q-direction
 
    iovp#, iovq#: initial object velocity in p and q directions
    fovp#, fovq#: final object velocity in p and q directions
    itvp#, itvq#: initial target velocity in p and q directions
    ftvp#, ftvq#: final target velocity in p and q directions
 
    ioa_p#: angle between ioa# and p-direction
    ita_p#: angle between ita# and p-direction
    --------------------------------------------------------------
    remend
 
    `get object and target initial angles
    ioa#=wrapvalue(object angle y(object))
    ita#=wrapvalue(object angle y(target))
 
    `get bearing between object and target
    bearing#=find_bearing(object,target)
 
    velo#=ball_speed#(object)
    velt#=ball_speed#(target)
 
    `Work out the new velocities of the balls using trig
    `These four lines by Hamish McHaggis
    velX1# = SIN(bearing#+90)*SIN(360-(bearing#-ioa#))*velo#+SIN(bearing#)*COS(bearing#-ita#)*velt#
    velY1# = COS(bearing#+90)*SIN(360-(bearing#-ioa#))*velo#+COS(bearing#)*COS(bearing#-ita#)*velt#
    velX2# = SIN(bearing#)*COS(bearing#-ioa#)*velo#+SIN(bearing#+90)*SIN(360-(bearing#-ita#))*velt#
    velY2# = COS(bearing#)*COS(bearing#-ioa#)*velo#+COS(bearing#+90)*SIN(360-(bearing#-ita#))*velt#
 
    `work out final angles and rotate
    foa#=atanfull(velX1#,velY1#)
    fta#=atanfull(velX2#,velY2#)
 
    fix object pivot object
    fix object pivot target
    yrotate object object,-foa#
    yrotate object target,-fta#
    fix object pivot object
    fix object pivot target
    yrotate object object,foa#
    yrotate object target,fta#
 
    `Pythagurus gives the resultant velocities
    ball_speed#(object)=sqrt(velX1#^2+velY1#^2)
    ball_speed#(target)=sqrt(velX2#^2+velY2#^2)
 
    endif
  endif
 
  next target
  inc n
next object
 
endfunction
 
function move_balls()
 
stopped=0
for ball=1 to 16
 
vx#=ball_speed#(ball)*sin(object angle y(ball))
vz#=ball_speed#(ball)*cos(object angle y(ball))
 
x#=object position x(ball)
z#=object position z(ball)
 
inc x#,vx#
inc z#,vz#
 
position object ball,x#,10,z#
 
xrotate object ball,object angle x(ball)+vx#
zrotate object ball,object angle z(ball)+vz#
 
ball_speed#(ball)=ball_speed#(ball)*0.995
if ball_speed#(ball)<0.1 then ball_speed#(ball)=0:inc stopped
next ball
 
if stopped=16 then hit=0
 
endfunction