REM Project: Billiards Physics
REM Created: 2/20/2005 2:16:41 PM
REM
REM ***** Main Source File *****
REM
Sync On
Sync Rate 200
`Autocam Off
 
Type Coordinates
   x as Float
   y as Float
   z as Float
EndType
 
Global Object as Coordinates
Global Target as Coordinates
Global FPS as Float
Global Bounce as Float
Global Friction as Float
Global SpinPass as Float
Global Stick_Energy as Float
Global Stick_Move as Float
Friction =.99
SpinPass = .55
 
Type Physics
   velocity as Coordinates
   vcount as float
   spin as Coordinates
   scount as float
   angle as Coordinates
   acount as float
   energy as float
EndType
Dim pool_balls(2,16) as Physics
 
make_pool_balls()
make_pool_table()
Make_Cue_Stick()
rack_balls()
Flag=0
`Position Camera 0,100,0
`Return_Object(1)
`Point Camera Object.x,Object.y,Object.z
 
 
do
   FPS = Screen FPS()
   Set cursor 0,0
   Print "FPS=";FPS
   control camera using arrowkeys 0,500/FPS,500/FPS
   m=Move_Balls()
   if m=0 Then Move_Cue_Stick() Else Hide Object 30
   sync
loop
end
 
Function Shoot()
   If MouseClick()=1
      Stick_Energy=Stick_Energy+.1
      If Stick_Energy<10 Then Stick_Energy=10
      If Stick_Energy>49 Then Stick_Energy=49
      Ink RGB(200,0,0),0
      SE$=Str$(Int(Stick_Energy*10)/10)
      tx=Text Width(SE$):ty=Text Height(SE$)
      Set Cursor Object Screen X(16)-tx/2,Object Screen Y(16)-ty/2
      Print SE$
      Ink RGB(255,255,255),0
   Endif
   If MouseClick()=0 And Stick_Energy>0
      Return_Object(16):Return_Target(30)
      dx#=(Object.x-Target.x):dz#=(Object.z-Target.z)
      vx#=dx#/abs(dx#+dz#):vz#=dz#/abs(dx#+dz#)
      pool_balls(1,16).Velocity.x=vx#
      pool_balls(1,16).Velocity.z=vz#
      pool_balls(1,16).Energy=Stick_Energy
      Stick_Energy=0
   Endif
EndFunction
 
Function Move_Balls()
   tablemove=0
   Clear_reactions()
   For i=1 to 15
      For j=i+1 to 16
         if i<>j
            If Object Collision(i,j)<>0
               PassXZ(i,j,Steps)
            Endif
         endif
      Next j
   Next i
   For i = 1 to 16
      If pool_balls(2,i).vcount<>0
         pool_balls(1,i).Velocity.x=pool_balls(2,i).Velocity.x/pool_balls(2,i).vcount
         pool_balls(1,i).Velocity.z=pool_balls(2,i).Velocity.z/pool_balls(2,i).vcount
         pool_balls(1,i).Energy=pool_balls(2,i).Energy/pool_balls(2,i).vcount
      Endif
      If Pool_Balls(1,i).Energy<>0
         tablemove=1
         pool_balls(1,i).Energy=pool_balls(1,i).Energy-(pool_balls(1,i).Energy*(1-Friction))
         If pool_balls(1,i).Energy<.001 Then pool_balls(1,i).Energy=0
         If pool_balls(1,i).Energy>50 Then pool_balls(1,i).Energy=50
         Return_Object(i)
         movex#=pool_balls(1,i).Velocity.x*pool_balls(1,i).Energy
         movez#=pool_balls(1,i).Velocity.z*pool_balls(1,i).Energy
         Position Object i,Object.x+movex#,Object.y,Object.z+movez#
         If Object Collision(i,21) Or Object Collision(i,22)
            pool_balls(1,i).Velocity.x=pool_balls(1,i).Velocity.x*-.9
            movex#=pool_balls(1,i).Velocity.x*pool_balls(1,i).Energy
            movez#=pool_balls(1,i).Velocity.z*pool_balls(1,i).Energy
            Position Object i,Object.x+movex#,Object.y,Object.z+movez#
         Endif
         If Object Collision(i,23) Or Object Collision(i,24)
            pool_balls(1,i).Velocity.z=pool_balls(1,i).Velocity.z*-.9
            movex#=pool_balls(1,i).Velocity.x*pool_balls(1,i).Energy
            movez#=pool_balls(1,i).Velocity.z*pool_balls(1,i).Energy
            Position Object i,Object.x+movex#,Object.y,Object.z+movez#
         Endif
         Roll Object Left i,movex#*3.1415
         Pitch Object Down i,movez#*3.1415
      Endif
   Next i
EndFunction tablemove
 
Function PassXZ(ObjectID,TargetID,incr)
`Two balls are overlapping. Passes the fastest x/z direction away from each other and shares energy
Return_Object(ObjectID):Return_Target(TargetID)
dx#=Object.x-Target.x
dz#=Object.z-Target.z
SRadius#=(10^2)*2
SDist#=(dx#^2+dz#^2)
Factor#=SRadius#/(SDist#*50)
a#=ATanFull(dx#,dz#)
vx#=sin(a#)
vz#=cos(a#)
 
pool_balls(2,ObjectID).Velocity.x=pool_balls(2,ObjectID).Velocity.x+dx#
pool_balls(2,ObjectID).Velocity.z=pool_balls(2,ObjectID).Velocity.z+dz#
pool_balls(2,TargetID).Velocity.x=pool_balls(2,TargetID).Velocity.x+dx#*-1
pool_balls(2,TargetID).Velocity.z=pool_balls(2,TargetID).Velocity.z+dz#*-1
pool_balls(2,ObjectID).Energy=pool_balls(1,TargetID).Energy*.50+Factor#
pool_balls(2,TargetID).Energy=pool_balls(1,ObjectID).Energy*.50+Factor#
pool_balls(2,ObjectID).vcount=pool_balls(2,ObjectID).vcount+1
pool_balls(2,TargetID).vcount=pool_balls(2,TargetID).vcount+1
EndFunction
 
Function Clear_Reactions()
   For i=1 to 16
      pool_balls(2,i).Velocity.x=pool_balls(1,i).Velocity.x
      pool_balls(2,i).Velocity.y=pool_balls(1,i).Velocity.y
      pool_balls(2,i).Velocity.z=pool_balls(1,i).Velocity.z
      pool_balls(2,i).vcount=1
      pool_balls(2,i).Energy=pool_balls(1,i).Energy
   Next i
EndFunction
 
function rack_balls()
   fact#=sqrt(3.0)*10
   position object 1,0,10,250
   position object 9,12,10,250+fact#
   position object 10,-12,10,250+fact#
   position object 2,24,10,250+fact#*2.0
   position object 8,0,10,250+fact#*2.0
   position object 3,-24,10,250+fact#*2.0
   position object 11,36,10,250+fact#*3.0
   position object 12,12,10,250+fact#*3.0
   position object 4,-12,10,250+fact#*3.0
   position object 13,-36,10,250+fact#*3.0
   position object 5,48,10,250+fact#*4.0
   position object 14,24,10,250+fact#*4.0
   position object 6,0,10,250+fact#*4.0
   position object 15,-24,10,250+fact#*4.0
   position object 7,-48,10,250+fact#*4.0
   position object 16,0,10,-250
endfunction
 
function make_pool_table()
   make object plain 20,500,1000
   xrotate object 20,-90
      color object 20,RGB(37,125,15)
   make object box 21,15,15,1030
      color object 21,rgb(37,125,15)
      position object 21,-257.5,7.5,0
   make object box 22,15,15,1030
      color object 22,rgb(37,125,15)
      position object 22,257.5,7.5,0
   make object box 23,500,15,15
      color object 23,rgb(37,125,15)
      position object 23,0,7.5,-507.5
   make object box 24,500,15,15
      color object 24,rgb(37,125,15)
      position object 24,0,7.5,507.5
endfunction
 
function make_pool_balls()
   for i=1 to 8
      make object sphere i,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
      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
   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 i = 1 to 16
      Set Object Collision To Spheres i
      Set Object Radius i,10
      pool_balls(1,i).Energy=0
   Next i
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_Cue_Stick()
   Make Object Cylinder 30,1
   Make Object Sphere 31,1,8,8
   Make Mesh From Object 31,31
   Delete Object 31
   Add Limb 30,1,31
   Add Limb 30,2,31
   Delete Mesh 31
   Scale Limb 30,0,200,20000,200
   Offset Limb 30,0,0,100,0
   Offset Limb 30,2,0,200,0
   Pitch Object Down 30,90
   Fix Object Pivot 30
   Color Object 30,RGB(64,0,0)
   Return_Object(16)
   Position Object 30,Object.x,Object.y,Object.z-250
Endfunction
 
Function Move_Cue_Stick()
   Show Object 30
   Return_Object(16)
   move#=(Leftkey()-RightKey())*.2
   If Move#<>0 Then Stick_Move=Stick_Move+move# Else Stick_Move=0
   Move Object Left 30,Stick_Move
   Point Object 30,Object.x,Object.y,Object.z
   Position Object 30,Object.x,Object.y,Object.z
   Move Object 30,-300
   Return_Target(30)
   Position Camera Target.x,Target.y+80,Target.z
   Move Object 30,70
   Shoot()
   Point Camera Object.x,Object.y,Object.z
Endfunction
 
Function Return_Object(ObjectID)
Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
EndFunction
 
Function Return_Target(TargetID)
Target.x=Object Position X(TargetID):Target.y=Object Position Y(TargetID):Target.z=Object Position Z(TargetID)
EndFunction
 
Function Sign(num as float)
t#=(num>0)-(num<0)
EndFunction t#