`Coding Challenge #5 - Casino Gambling Game - Pachinko
`Bill Robinson
`Started 3-17-06 --- Deadline 3-29-06
`All Rights Reserved for use as a published game.
`
`Shoot balls into playing area, trying to get them in the win pockets.
`The mouse x-direction controls the Power Meter
`The Left Mouse button Fires Balls.
`The Right Mouse button controls the firing rate of the balls
`If you get below $100, press the 'T' key spend another $100 in balls from the Teller.
`
set display mode 1024,768,32
sync on : sync rate 0
 
`hide mouse
autocam off
set ambient light 25
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000
 
` Create the ODE World
ode start
ode set world gravity 0,-5,0       :`was 0,-20,0
ode set world step  0.3             :`was 0.3
ode set world erp (0.2)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing
 
dim pocketinfo(10,10)
dim doorstatus(10)
 
#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)
 
global numlevels=5
global level
global levelflag
global numballs
global money
 
global screenxcenter
global screenycenter
 
`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=100
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=100
global ballsleft
global mx
global my
 
`walls
global leftwall=500
global rightwall=3500
global floor=0
global ceiling=4000
global backwall=250
global backwallheight
global barrierheight
 
`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0
 
`pins
global nextpinptr=3000
 
`Camera
global camx=2000
global camy=2000
global camz=-10000
 
`ODE - globals
global odeballptr
 
_ball_textures()                :`build textures for balls
_backwall_graphics()
gosub _intro
 
screenxcenter=screen width()/2
 
rem --- make left wall
make object box 310,backwall,ceiling+100,50
yrotate object 310,90
color object 310,rgb(100,100,0)
position object 310,leftwall/2,ceiling/2,backwall/2
set object emissive 310,rgb(100,100,0)
 
rem --- make right wall
make object box 311,backwall,ceiling+100,50
yrotate object 311,-90
color object 311,rgb(150,150,0)
position object 311,rightwall+leftwall/2,ceiling/2,backwall/2
 
remstart
rem --- make left floor
make object box 303,rightwall/2-120,backwall+100,50
xrotate object 303,-90
zrotate object 303,-6
color object 303,rgb(0,200,0)
position object 303,rightwall/4-70+leftwall/2,floor+70,backwall/2
rem --- make right floor
make object box 306,rightwall/2-120,backwall+100,50
xrotate object 306,-90
zrotate object 306,6
color object 306,rgb(0,200,0)
position object 306,rightwall-rightwall/4+70+leftwall/2,floor+70,backwall/2
remend
 
rem --- make back wall
make object box 304,rightwall,ceiling,3
color object 304,rgb(0,0,200)
position object 304,rightwall/2+leftwall/2,ceiling/2,backwall   :`position backwall
texture object 304,10
 
rem --- make front wall
make object box 307,rightwall,ceiling,3
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,ceiling/2,backwall-ballsize-40   :`position front wall
ode create static box 307
`ghost object on 307
hide object 307
 
rem --- make ceiling
make object box 305,rightwall,backwall,50
xrotate object 305,90
color object 305,rgb(100,100,0)
position object 305,rightwall/2+leftwall/2,ceiling,backwall/2
set object emissive 305,rgb(100,100,0)
 
rem --- Create ODE tennis balls ---
for i=1 to maxballs
   make object sphere i,ballsize          :`was i,30
   set object i,1,1,0
   color object i,rgb(255,0,0)
   set object collision off i
   position object i, 5000,5000,-5000      :`move object WAY off screen
   texture object i,rnd(5)+11
   hide object i
next i
 
rem --- make power bar
make object box 201,100,100,2
color object 201,rgb(255,255,0)
`position object 201,leftwall+150,ceiling-120,160   :`position power bar
 
rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,ceiling-120,160
 
rem --- win pocket placement in game ---
pocketdata:
data 800,900
data 1400,500
data 2000,700
data 2600,500
data 3200,900
data 2000,2000
restore pocketdata
pocketsize=150
for i=1 to 6
   read pocketinfo(i,1)
   read pocketinfo(i,2)
   pocketinfo(i,3)=pocketinfo(i,2)+pocketsize/2    :`y1 limit for pocket capture of ball
   pocketinfo(i,4)=pocketinfo(i,2)-pocketsize/2    :`y2 limit for pocket capture of ball
   pocketinfo(i,5)=pocketinfo(i,1)-pocketsize/2    :`x1 limit for pocket capture of ball
   pocketinfo(i,6)=pocketinfo(i,1)+pocketsize/2    :`x2 limit for pocket capture of ball
next i
 
rem --- make win pockets with boxes
for i=1 to 30 step 5
   make object box 320+i,pocketsize,pocketsize,3
   yrotate object 320+i,-90
   color object 320+i,rgb(255,0,0)
 
   make object box 321+i,pocketsize,pocketsize,3
   color object 321+i,rgb(0,255,0)
 
   make object box 322+i,pocketsize,pocketsize,3
   yrotate object 322+i,90
   color object 322+i,rgb(255,0,255)
 
   make object box 323+i,pocketsize,pocketsize,3
   xrotate object 323+i,-90
   color object 323+i,rgb(255,255,0)
 
   make object box 324+i,pocketsize,pocketsize,3
   color object 324+i,rgb(0,0,0)
next i
 
rem --- position win pockets and texture them
for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=0
   position object 316+i*5,locx-pocketsize/2,locy,backwall-pocketsize/2
   position object 317+i*5,locx,locy,backwall-pocketsize
   pocketinfo(i,7)=317+i*5       :`save object# for texturing later
   if i<6
      texture object 317+i*5,1
   else
      texture object 317+i*5,3
   endif
   position object 318+i*5,locx+pocketsize/2,locy,backwall-pocketsize/2
   position object 319+i*5,locx,locy-pocketsize/2,backwall-pocketsize/2
   position object 320+i*5,locx,locy,backwall-3
next i
 
rem --- create ODE instances of win pockets
for i=321 to 350
   ode create static box i
next i
for i=324 to 350 step 5
   color object i,rgb(0,255,255)
next i
 
rem --- create pin patterns above win pockets
for i=1 to 6
   if i<=5
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,4,0)
   else
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,6,0)
   endif
next i
 
_pin_pattern1(745,2700,5)
_pin_pattern2(880,2700,5)
 
_pin_pattern1(1935,3100,5)
_pin_pattern2(2070,3100,5)
 
_pin_pattern1(3105,2500,5)
_pin_pattern2(3240,2500,5)
 
rem --- make win pocket doors
doorsize=175
for i=1 to 12 step 2
   make object box 209+i,doorsize,doorsize,20
   color object 209+i,rgb(200,0,200)
   if i<=10
      zrotate object 209+i,45
   else
      zrotate object 209+i,-30
   endif
   yrotate object 209+i,-90
 
   make object box 210+i,doorsize,doorsize,20
   color object 210+i,rgb(200,0,200)
   if i<=10
      zrotate object 210+i,-45
   else
      zrotate object 210+i,30
   endif
   yrotate object 210+i,-90
next i
 
for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=backwall-pocketsize/2
   if i<=5 then doorstatus(i)=1 else doorstatus(i)=0
   if i<=5
      position object 208+i*2,locx-pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 208+i*2,locx-pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 208+i*2
 
   if i<=5
      position object 209+i*2,locx+pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 209+i*2,locx+pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 209+i*2
next i
 
`-------------------------------------------------------
 
`ode create static box 303     :`floor left
`ode create static box 306     :`floor right
ode create static box 305     :`ceiling
ode create static box 310     :`left wall
ode create static box 311     :`right wall
ode create static box 304     :`tell ODE about backwall
`ode set contact bounce 304,1
`ode set contact fdir1 303,0.0                 :` was 30.0  Add FRICTION
`ode set contact fdir1 306,0.0                 :` was 30.0  Add FRICTION
`--------------------------------------------------------
 
nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=100         :`how many balls on screen at the same time
numballs=100            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=150          :`pause between each ball being fired
level=1                 :`start at this level
 
set camera FOV 25                         :`use a zoom lens
position camera camx,camy,camz            :`set camera FAR away, so pins in the game look straighter!
point camera camx,camy,camz+1500          :`was targetx#,targety#,targetz#
position mouse 10,10
ballcheck=1
 
rem ----- main loop -----------------------------------------------------
do
   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
   if keypress>0 then _key_action(keypress)
 
   mx=mousex()
   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_tennis_ball         :`FIRE!
   if mousebutton=2
      balltiming=120-mx/10                               :`faster shooting rate adjust
      position object 202,rightwall-1050+mx,ceiling-120,160
   else
      position object 201,leftwall+mx,ceiling-120,160
   endif
 
`  --- clear balls falling thru bottom hole
   if object position y(ballcheck)<-100
      position object ballcheck,5000,500,-5000
      hide object ballcheck
      ode destroy object ballcheck
      dec ballcount
   endif
   inc ballcheck
   if ballcheck>maxballs then ballcheck=1
 
   if pocketsopen=0
      if bonusopenflag=0
         _open_bonus(6)
      endif
   else
      if bonusopenflag=1
         _close_bonus(6)
      endif
   endif
 
   if bonusopenflag=1
      inc flash
      if flash=20
         texture object 347,4
      else
         if flash=40
            texture object 347,3
            flash=1
         endif
      endif
   endif
 
   gosub _check_pockets
   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   sync
loop
rem --------------------------------------------------------------------
ode end
end
 
 
function _open_bonus(pocketnum)
if doorstatus(pocketnum)=1 then exitfunction
_open_doors(pocketnum)
doorstatus(pocketnum)=1
bonusopenflag=1
texture object 347,4
endfunction
 
 
function _close_bonus(pocketnum)
if doorstatus(pocketnum)=0 then exitfunction
_close_doors(pocketnum)
doorstatus(pocketnum)=0
bonusopenflag=0
texture object 347,3
endfunction
 
 
rem --- show score on screen
_show_score:
set cursor 1,1
`print screen fps()
center text screenxcenter,2,"Money Left: $"+str$(numballs)
`print "ballcount=";ballcount
`print "pocketsopen=";pocketsopen
`print "bonusflag=";bonusopenflag
return
 
 
rem ---------- fires tennis balls ----------
_fire_tennis_ball:
if ballcount=ballsatonce then return
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of tennis balls
if numballs=0                          :`out of tennis balls to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif
 
ballx#=300
bally#=3300
ballz#=backwall-ballsize-20
 
`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
show object odeballptr
 
ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,40                 :`was 20
ode set contact bounce odeballptr,1
 
ode set linear velocity odeballptr,50+mx*2,mx,0.0
ode set contact fdir1 odeballptr,0.0                 :` was 30.0  Add FRICTION
 
dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired
 
inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return
 
 
_check_pockets:
for i=1 to maxballs
   y=object position y(i)              :`get each balls y position
   for j=1 to 6                        :`check all 6 pockets
      if y<pocketinfo(j,3)             :`check top of each pocket
         if y>pocketinfo(j,4)          :`check bottom of each pocket
            x=object position x(i)     :`get each balls x position
            if x>pocketinfo(j,5)       :`check left side of each pocket
               if x<pocketinfo(j,6)    :`check right side of each pocket
                  hide object i        :`yep, ball must be in pocket
                  ode destroy object i
                  position object i, 5000,5000,-5000
                  dec ballcount
                  _change_doors(j)
                  sync
               endif
            endif
         endif
      endif
   next j
next i
return
 
 
function _change_doors(pocketnum)
if doorstatus(pocketnum)=1
   _close_doors(pocketnum)
   if pocketnum=6
      for i=1 to 5
         _open_doors(i)
      next i
      inc numballs,50
      bonusopenflag=0
   else
      inc numballs,1
   endif
else
   inc numballs,3
   _open_doors(pocketnum)
endif
endfunction
 
 
function _open_doors(pocketnum)
if doorstatus(pocketnum)=0
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=1
   if pocketnum=6
      ang=0
      offset=pocketsize/2
   else
      ang=45
      offset=pocketsize
      inc pocketsopen
      texture object pocketinfo(pocketnum,7),1
   endif
 
   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
 
   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction
 
 
function _close_doors(pocketnum)
if doorstatus(pocketnum)=1
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=0
   if pocketnum=6
      ang=-30
      offset=pocketsize/4
   else
      ang=0
      offset=pocketsize/2
      dec pocketsopen
      texture object pocketinfo(pocketnum,7),2
   endif
 
   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
 
   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction
 
 
function _finished_level(level)
set cursor 1,200
print "YOU FINISHED LEVEL - ";level
print "Press a key to continue"
sync
wait key
if level=numlevels
   print "  "
   print "That's all there is for now - Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction
 
 
function _key_action(keypress)
select keypress
   case 20
      if numballs<100
         inc numballs,100
      endif
   endcase
endselect
endfunction
 
 
function _ball_textures()
for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i+10,0,0,50,50
   delete bitmap i
next i
endfunction
 
 
function _make_pin(x,y)
make object box nextpinptr,12,200,12
xrotate object nextpinptr,90
zrotate object nextpinptr,45
position object nextpinptr,x,y,backwall-100
ode create static box nextpinptr
endfunction
 
 
function _pin_pattern1(x,y,numpins)
xspacing=50
yspacing=50
xpos=x      :`-(numpins*xspacing/2)
ypos=y      :`+(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
dec xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
dec xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   dec xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction
 
 
function _pin_pattern2(x,y,numpins)
xspacing=50
yspacing=50
xpos=x         :`-(numpins*xspacing/2)
ypos=y         :`-(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
inc xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
inc xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   inc xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction
 
 
function _pin_pattern3(x,y,numrows,startpins,pininc)
xspacing=125      :`was 120
yspacing=115      :`was 110
if startpins=1
   xpos=x
   offset=0
else
   offset=xspacing/2
   xpos=x-((startpins-1)*xspacing/2)
endif
ypos=y
for i=1 to numrows
   for j=1 to startpins
      _make_pin(xpos,ypos)
      inc xpos,xspacing
      inc nextpinptr
   next j
   inc ypos,yspacing
   if offset<>0 then offset=offset*-1
      if offset<0
         xpos=x-((startpins-1)*xspacing/2)-offset
      else
         xpos=x-((startpins-1)*xspacing/2)
      endif
next i
endfunction
 
 
function _backwall_graphics()
ink rgb(255,255,255),rgb(0,0,200)
`ink rgb(0,0,200),0
`box 0,0,1024,768
`ink rgb(255,255,255),0
cls rgb(0,170,00)
set cursor 6,7
print 1
get image 1,0,0,20,20
cls rgb(0,170,00)
set cursor 6,7
print 3
get image 2,0,0,20,20
cls rgb(0,70,00)
set cursor 2,4
`set text size 16
print 50
get image 3,0,0,20,20
cls rgb(0,170,00)
ink rgb(255,0,0),0
set cursor 2,4
`set text size 16
print 50
get image 4,0,0,20,20
remstart
for i= 1 to 30
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   ellipse rnd(400),50+rnd(400),rnd(100),rnd(100)
next i
blur bitmap 0,2
remend
cls
`ink rgb(255,255,255),0
set cursor 55,25
set text size 16
print "POWER METER"
for i=30 to 200 step 20
   line i,5,i,25
next i
 
set cursor 340,25
print "FIRING RATE METER"
for i=320 to 480 step 20
   line i,5,i,25
next i
get image 10,0,0,512,512,1
endfunction
 
 
_intro:
sync
set text font "Arial"
set text size 30
cx=screen width()/2
cy=100
 
introtext:
data "-green"
data "Pachinko Game"
data "   "
data "-purple"
data "There are 15,000 pachinko gambling arcades in Japan,"
data "and for some it is much more than mere recreation."
data "Pachinko is the most popular leisure activity in Japan."
data "   "
data "40 and 50 million people--roughly a quarter of the population--"
data "play pachinko at least occasionally, and as many as 30 million are avid players."
data "   "
data "   "
data "-cyan"
data "The LEFT mouse button FIRES!"
data "The RIGHT mouse button controls the firing rate of the balls"
data "The mouse x-direction controls the Power Meter"
data "You start with $100, if your money gets low,"
data "press 'T' to spend another $100 for more balls"
data "   "
data "(If the balls are getting stuck above pins, change ballsize=75 on line 56)"
data "   "
data "-yellow"
data "Press a key to continue"
data "999"
 
cls
restore introtext
read t$
while t$<>"999"
   if left$(t$,1)="-"
      if t$="-green" then ink rgb(0,255,0),0
      if t$="-purple" then ink rgb(200,0,200),0
      if t$="-yellow" then ink rgb(255,255,0),0
      if t$="-cyan" then ink rgb(0,255,255),0
   else
      center text cx,cy,t$
      inc cy,30
   endif
   read t$
endwhile
 
sync
wait key
ink rgb(0,255,255),0
cls
sync
return