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