Sorry your browser is not supported!

Rem Project: Brave Badger
Rem Started: Tuesday, October 13, 2009
Rem The Game Creators Forum code challenge
Rem **************************************
Rem Use W A S D to move the Badger vehicle.
Rem Num pad keys control the camera view.
Rem Use "5" key to cycle camera presets.

set display mode 800,600,32
disable escapekey
set ambient light 60
color backdrop 0

gosub DeclareVariables
gosub DrawGraphics
gosub MakeObjects

sync on
sync rate 60

set text size 20
ink cWhite
nStartTime=timer()
nGameLength=180000


` main loop ***************************
do 
    ` movement controls   
    nTurn = 0
    nKeyDriftFlag = 1

    if keystate(1) ` the ESC key
        for x = 1 to nObject
            delete object x
        next x
        end
    endif
           
    if keystate(17) ` "w" key - moving forward
        nSpeed# = nSpeed# + .1
        if nSpeed# > 5 then nSpeed# = 5
        nKeyDriftFlag = 0
    endif

    if keystate(31) ` "s" key - backward movement
        nSpeed# = nSpeed# - .1
        if nSpeed# < -5 then nSpeed# = -5
        nKeyDriftFlag = 0
    endif

    ` slow down to zero movement if no movement keys are pressed
    if nKeyDriftFlag
        if nSpeed# < .1 and nSpeed# > -.1 then nSpeed# = 0
        if nSpeed# < 0 then nSpeed# = nSpeed# + .1
        if nSpeed# > 0 then nSpeed# = nSpeed# - .1
    endif
    
    if keystate(30) ` "a" key - turning left
        nTurn = -1
    endif
    
    if keystate(32) ` "d" key - turning right
        nTurn = 1
    endif    
   
    ` camera controls
    if keystate(72) ` "8" key on numpad - camera closer to tank
        dec camDistance
        if camDistance < 40 then camDistance = 40
    endif
    
    if keystate(80) ` "2" key on numpad - camera farther from tank
        inc camDistance
        if camDistance > 300 then camDistance = 300
    endif
    
    if keystate(75) ` "4" on keypad - camera turn left
        camAngleOffset = wrapvalue(camAngleOffset-2.5)
    endif
    
    if keystate(77) ` "6" key on numpad - camera turn right
        camAngleOffset = wrapvalue(camAngleOffset+2.5)
    endif

    if keystate(73) ` "9" on numpad - camera higher                
        inc camHeight
      if camHeight > 300 then camHeight = 300
    endif
    
    if keystate(81) ` "3" on numpad - camera lower    
        dec camHeight
      if camHeight < 27 then camHeight = 27
   endif
   
   if keystate(76) ` "5" on numpad - cycle camera views
        if timer() > nCameraTimer + 500
            nCameraTimer = timer()
          inc camShot
          if camShot = 7 then camShot = 1
          select camShot
              case 1
                  camAngleOffset =  0
                  camDistance = 60
                  camHeight = 27
              endcase
              case 2
                  camAngleOffset = 90
                  camDistance = 95
                  camHeight = 27
              endcase
              case 3
                  camAngleOffset =  270
                  camDistance = 95
                  camHeight = 27
              endcase
              case 4
                  camAngleOffset =  180
                  camDistance = 117
                  camHeight = 27
              endcase
              case 5
                  camAngleOffset =  30
                  camDistance = 200
                  camHeight = 68
              endcase
              case 6
                  camAngleOffset = 0
                  camDistance = 200
                  camHeight = 100
              endcase              
          endselect
      endif
   endif

	` activate tank laser
	if timer() > nTankLaserTimer + 1000
		show object nTankBeam
		nTankLaserTimer = timer()
		nLaserBurstTime = timer()
	endif   

	` check tank collision
	if nSpeed#<0 then nMovement = -1
	if nSpeed#>0 then nMovement = 1
	if nTurn = 1 and checkcollision(nTankBumper2) then nTurn = 0 : nSpeed# = 0
	if nTurn = -1 and checkcollision(nTankBumper1) then nTurn = 0 : nSpeed# = 0
	if nTurn = 1 and checkcollision(nTankBumper3) then nTurn = 0 : nSpeed# = 0
	if nTurn = -1 and checkcollision(nTankBumper4) then nTurn = 0 : nSpeed# = 0
	if nMovement = 1 and checkcollision(nTankBumper1) then nMovement = 0 : nSpeed# = 0
	if nMovement = 1 and checkcollision(nTankBumper2) then nMovement = 0 : nSpeed# = 0
	if nMovement =-1 and checkcollision(nTankBumper3) then nMovement = 0 : nSpeed# = 0
	if nMovement = -1 and checkcollision(nTankBumper4) then nMovement = 0 : nSpeed# = 0

	` move and turn tank
	yrotate object nTankBody, wrapvalue(object angle y(nTankBody)+nTurn)
	move object nTankBody, nSpeed# * abs(nMovement)

	` check for tank beam hitting target
	if object visible(nTankBeam) and object collision(nTarget,nTankBeam)
   	inc nHits
   	position object nTarget, rnd(909)+90,20,rnd(909)+90
   	rotate object nTarget,0,rnd(259)+1,0
	endif
	
	` move the target
	move object nTarget, 3
	
	` check for target near boundary
	if object position z(nTarget) > 900 then rotate object nTarget,0,wrapvalue(90+rnd(179)),0
	if object position z(nTarget) < -900 then rotate object nTarget,0,wrapvalue(90-rnd(179)),0
	if object position x(nTarget) > 900 then rotate object nTarget,0,wrapvalue(0-rnd(179)),0
	if object position x(nTarget) < -900 then rotate object nTarget,0,wrapvalue(0+rnd(179)),0

	` end tank laser fire
	if timer() > nLaserBurstTime + 100
    	hide object nTankBeam
	endif   

	` move camera
	set camera to follow object position x(nTankBody),object position y(nTankBody),object position z(nTankBody),wrapvalue(object angle y(nTankBody)+camAngleOffset),camDistance,camHeight,1,0
	point camera object position x(nTankBody), object position y(nTankBody), object position z(nTankBody)

	` update and fire defensive lasers
	for laser = 1 to 4
   	point object nLaser(laser), object position x(nTankBody), 15, object position z(nTankBody)
    	nDistance = getdistance(object position x(nTankBody),object position y(nTankBody),object position z(nTankBody),object position x(nLaser(laser)),object position y(nLaser(laser)),object position z(nLaser(laser)))
    	
		if nDistance<600
        	if rnd(30)=1 and object visible(nLaserBeam(laser))=0
            scale object nLaserBeam(laser),100,100,(nDistance*100)+10
            position object nLaserBeam(laser),0,0,(nDistance/2) + 10
            show object nLaserBeam(laser)
            laserTimer(laser) = timer()
         endif
   	endif

	   ` take damage from defensive lasers
   	if object visible(nLaserBeam(laser)) then dec nTankHealth, 1
   	if nTankHealth < 1 then gosub EndSimulation

	   ` end defensive laser fire
   	if timer() > laserTimer(laser) + 50
   		hide object nLaserBeam(laser)
      	position object nLaserBeam(laser),0,0,0
      	scale object nLaserBeam(laser),100,100,100
   	endif
	next laser
	
	` calculate the clock
	nElapsedTime=timer()-nStartTime
	nTimeLeft=nGameLength-nElapsedTime	
	nSeconds=nTimeLeft/1000
	nMinutes=nSeconds/60
	nSeconds=nSeconds-nMinutes*60
	sTime$="0"+str$(nMinutes)+":"
	if nSeconds<10 then sTime$=sTime$+"0"
	sTime$=sTime$+str$(nSeconds)
	
	` display status, score, and clock
	text 0,0," Vehicle Status:" + str$(nTankHealth/2) + "%   Targets Destroyed:" + str$(nHits) + "   Time Left:" + sTime$
	
	if nSeconds=0 AND nMinutes=0 then gosub ShowScore
	
	sync
loop

end
`****************************
DeclareVariables:

` color assignments
#constant cBlack=rgb(0,0,0)
#constant cWhite=rgb(255,255,255)
#constant cRed=rgb(255,0,0)
#constant cDarkRed=rgb(100,0,0)
#constant cLightBlue=rgb(150,150,255)
#constant cBlue=rgb(0,0,255)
#constant cDarkBlue=rgb(0,0,100)
#constant cDarkYellow=rgb(100,100,0)
#constant cYellow=rgb(255,255,0)
#constant cGreen=rgb(0,255,0)
#constant cDarkGreen=rgb(0,100,0)
#constant cGrey=rgb(200,200,200)
#constant cLightGray=rgb(225,225,225)
#constant cMediumGray=rgb(150,150,150)
#constant cDarkGray=rgb(50,50,50)
#constant cBrown=rgb(255,128,0)
#constant cDarkBrown=rgb(125,75,0)
#constant cDarkerBrown=rgb(65,25,0)
#constant cTan=rgb(160,120,70)
#constant cMediumTan=rgb(155,115,65)
#constant cDarktan=rgb(150,110,50)
#constant cNeon=rgb(87,87,255)

` texture assignments
tBackdrop=1
tFloorGrid=2
tBodyTop=3
tBillboard=4
tID=5
tBlack=6
tBarrel=7
tBodyFront=8
tLaser=9
tTankSkirt=10
tWallGrid=11
tNeon=12

` camera assignments
camAngleOffset=0
camDistance=200
camHeight=100
camShot=6

` globals for collision function
global nCollisionStart, nCollisionEnd, nTankBody, nKeyTimer

nSeconds as integer
nMinutes as integer

dim nLaser(4)
dim nLaserBeam(4)
dim laserTimer(4)

` misc variables
nTankHealth as integer = 200

return
`*********************************
DrawGraphics:

` tank shadow and other black parts
cls cBlack
get image tBlack,0,0,10,10,3

` laser beam
cls cRed
get image tLaser,0,0,7,7

` neon for marble
cls cNeon
get image tNeon,0,0,7,7

` tank skirts
cls cBlack
ink cYellow
for x = 5 to 20
    line x,5,x+15,40
next x
get image tTankSkirt,0,0,45,45

` camo background
ink cTan
box 0,0,800,600
for b = 1 to 5000
    r=rnd(2)
    select r
        case 0: c=cTan : endcase
        case 1: c=cDarkTan : endcase
        case 2: c=cMediumTan : endcase
    endselect
    ink c
    bx=rnd(800)
    by=rnd(600)
    box bx,by,bx+10,by+10
next b

` tank body parts
get image tBodyTop,1,1,200,340,3

` back billboard on tank   <=============== draw a hatch cover!

set text font "ariel"
set text to bold
set text size 28
ink cBlack
text 10,202,"BADGER MARK IV MOD 5"
ink cWhite
text 8,200,"BADGER MARK IV MOD 5"
get image tBillboard,1,1,300,240,3

` tank ID number
cls
set text size 100
ink cDarkBrown
text 5,5,"5"
ink cWhite
text 0,0,"5"
get image tID,0,10,50,90

` floor tiles
ink cMediumGray
box 0,0,127,127
ink cLightGray
box 2,2,124,124
get image tFloorGrid,0,0,127,127,3
get image tWallGrid,0,0,127,12,3

return
`*************************************
MakeObjects:

` make the walls
inc nObject
make object plane nObject,2000,20
position object nObject,0,10,1000
texture object nObject,tWallGrid
scale object texture nObject,20,1

nCollisionStart=nObject

inc nObject
make object plane nObject,2000,20
position object nObject,0,10,-1000
texture object nObject,tWallGrid
scale object texture nObject,20,1

inc nObject
make object plane nObject,2000,20
rotate object nObject,0,90,0
position object nObject,-1000,10,0
texture object nObject,tWallGrid
scale object texture nObject,20,1
    
inc nObject
make object plane nObject,2000,20
rotate object nObject,0,90,0
position object nObject,1000,10,0
texture object nObject,tWallGrid
scale object texture nObject,20,1

` put all the other colliding terrain before this line:
nCollisionEnd = nObject

`make the floor
inc nObject
make object plane nObject, 2000,2000
rotate object nObject, 90, 0, 0
position object nObject, 0,0,0
texture object nObject, tFloorGrid
scale object texture nObject, 20, 20
set object collision off nObject

` the laser poles
inc nObject
make object box nObject,2,50,2
position object nObject,-1005,25,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,1005,25,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,-1005,25,-1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,1005,25,-1005
texture object nObject,tWallGrid

` the laser bases
inc nObject
make object box nObject,10,20,10
position object nObject,-1005,10,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,1005,10,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,-1005,10,-1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,1005,10,-1005
texture object nObject,tWallGrid

` make the laser guns
for laser = 1 to 4
    inc nObject
    nLaser(laser) = nObject
    make object box nLaser(laser),7,7,20
next laser

` make the laser beams
for beam = 1 to 4
    inc nObject
    nLaserBeam(beam) = nObject
    make object box nLaserBeam(beam),2,2,1
    glue object to limb nLaserBeam(beam),nLaser(beam),0
    position object nLaserBeam(beam),0,0,0    
    texture object nLaserBeam(beam),tLaser
    hide object nLaserBeam(beam)
next beam

` put the lasers on the poles
position object nLaser(1),-1005,50,1005
position object nLaser(2),1005,50,1005
position object nLaser(3),-1005,50,-1005
position object nLaser(4),1005,50,-1005

` make the tank
` this is the main body, root limb
inc nObject
nTankBody = nObject
make object box nTankBody,55,3,85

` these are the four bumpers used to check for collisions
inc nObject
nTankBumper1 = nObject
make object box nTankBumper1,26,1,40
inc nObject
nTankBumper2 = nObject
make object box nTankBumper2,26,1,40
inc nObject
nTankBumper3 = nObject
make object box nTankBumper3,26,1,40
inc nObject
nTankBumper4 = nObject
make object box nTankBumper4,26,1,40

` these are the rest of the tank parts
inc nObject
nTankBody1 = nObject
make object triangle nTankBody1,25,20,-40,-25,20,-40,25,5,40
inc nObject
nTankBody2 = nObject
make object triangle ntankBody2,25,5,40,-25,20,-40,-25,5,40
inc nObject
nTankSide1 = nObject
make object triangle nTankSide1,25,20,-40,25,5,-40,25,5,40
inc nObject
nTankSide2 = nObject
make object triangle nTankSide2,-25,20,-40,-25,5,-40,-25,5,40
inc nObject
nTankFront = nObject
make object plane nTankFront,50,5
inc nObject
nTankBack = nObject
make object plane nTankBack,50,5
inc nObject
nTankBillboard = nObject
make object plane nTankBillboard,50,15
inc nObject
nTankSkirt1 = nObject
make object plane nTankSkirt1,80,5
inc nObject
nTankSkirt2 = nObject
make object plane nTankSkirt2,80,5
inc nObject
nTankBarrel1 = nObject
make object box nTankBarrel1,3,3,60
inc nObject
nTankBarrel2 = nObject
make object box nTankBarrel2,8,5,6
inc nObject
nTankBarrel3 = nObject
make object sphere nTankBarrel3,3
inc nObject
nTankShadow = nObject
make object plane nTankShadow,60,90
inc nObject
nTankIDPanel1 = nObject
make object plane nTankIDPanel1,8,10
inc nObject
nTankIDPanel2 = nObject
make object plane nTankIDPanel2,8,10
inc nObject
nTankBeam = nObject
make object box nTankBeam,2,2,400
set object collision to polygons nTankBeam

` glue all tank parts together
glue object to limb nTankBumper1,nTankBody,0
glue object to limb nTankBumper2,nTankBody,0
glue object to limb nTankBumper3,nTankBody,0
glue object to limb nTankBumper4,nTankBody,0
glue object to limb nTankBody1,nTankBody,0
glue object to limb nTankBody2,nTankBody,0
glue object to limb nTankSide1,nTankBody,0
glue object to limb nTankSide2,nTankBody,0
glue object to limb nTankFront,nTankBody,0
glue object to limb nTankBack,nTankBody,0
glue object to limb nTankBillboard,nTankBody,0
glue object to limb nTankSkirt1,nTankBody,0
glue object to limb nTankSkirt2,nTankBody,0
glue object to limb nTankBarrel1,nTankBody,0
glue object to limb nTankBarrel2,nTankBody,0
glue object to limb nTankBarrel3,nTankBody,0
glue object to limb nTankShadow,nTankBody,0
glue object to limb nTankIDPanel1,nTankBody,0
glue object to limb nTankIDPanel2,nTankBody,0
glue object to limb nTankBeam,nTankBody,0

` scale and rotate some tank parts
scale object nTankBarrel3,100,100,1
rotate object nTankSkirt1,0,90,0
rotate object nTankSkirt2,0,90,0
rotate object nTankBarrel1,0,0,45
rotate object nTankShadow,90,0,0
rotate object nTankIDPanel1,0,90,0
rotate object nTankIDPanel2,0,-90,0
rotate object nTankBeam,0,0,45

` position tank parts
position object nTankBumper1,-17,0,25
position object nTankBumper2,17,0,25
position object nTankBumper3,-17,0,-25
position object nTankBumper4,17,0,-25
position object nTankFront,0,2.5,40
position object nTankBack,0,2.5,-40
position object nTankBillboard, 0,12.5,-40
position object nTankSkirt1,25,2.5,0
position object nTankSkirt2,-25,2.5,0
position object nTankBarrel1,0,15,0
position object nTankBarrel2,0,15,30
position object nTankBarrel3,0,15,33
position object nTankShadow,0,-4.9,0
position object nTankIDPanel1,25.1,12,-33
position object nTankIDPanel2,-25.1,12,-33
position object nTankBeam,-0.1,15,230

` texture the tank parts
texture object nTankBody,tBodyTop
texture object nTankBody1,tBodyTop
texture object nTankBody2,tBodyTop
texture object nTankSide1,tBodyTop
texture object nTankSide2,tBodyTop
texture object nTankFront,tTankSkirt
texture object nTankBack,tTankSkirt
texture object ntankBillboard,tBillboard
texture object nTankSkirt1,tTankSkirt
texture object nTankSkirt2,tTankSkirt
texture object nTankBarrel1,tBodyTop
texture object nTankBarrel2,tBodyTop
texture object nTankBarrel3,tBlack
texture object nTankShadow,tBlack
texture object nTankIDPanel1,tID
texture object nTankIDPanel2,tID
texture object nTankBeam, tLaser
set alpha mapping on nTankShadow,30
scale object texture nTankFront,8,1
scale object texture nTankBack,8,1
scale object texture nTankSkirt1,12,1
scale object texture nTankSkirt2,12,1
set object transparency nTankIDPanel1,2
set object transparency nTankIDPanel2,2
set object ambience nTankBody,cMediumGray
set object ambience nTankSide1,cMediumGray
set object ambience nTankSide2,cMediumGray
set object ambience nTankBillboard,cDarkGray
set object ambience nTankBarrel1,cBlack

` hide the bumpers
hide object nTankBumper1
hide object nTankBumper2
hide object nTankBumper3
hide object nTankBumper4

` hide the laser rangefinder
hide object nTankBeam

` move tank to start position
position object nTankBody,0,5,0

` make the target
inc nObject
nTarget = nObject
make object sphere nTarget,40,36,36
texture object nTarget,tNeon
position object nTarget,rnd(800)+50,20,rnd(800)+5
rotate object nTarget,0,rnd(359)+1,0

return
`*************************************
function checkcollision(nObjectToCheck as integer)
nCollisionFlag=0
for nCheck = nCollisionStart to nCollisionEnd
    if object collision(nObjectToCheck,nCheck)
        nCollisionFlag = 1
    endif
next nCheck
endfunction nCollisionFlag
`*************************************
function getdistance(x1 as float,y1 as float,z1 as float,x2 as float,y2 as float,z2 as float)
xd=x1-x2
yd=y1-y2
zd=z1-z2
nDistance#=sqrt((xd*xd)+(yd*yd)+(zd*zd))
endfunction nDistance#
`*************************************
EndSimulation:
set text size 50
center text 400,200,"VEHICLE DESTROYED"
center text 400,240,"SIMULATION TERMINATED"
sync
wait key
end
return
`*************************************
Showscore:
set text size 50
center text 400,20 ,"SIMULATION COMPLETE"
center text 400,240,"FINAL SCORE:" + str$(nHits*50)
sync
enable escapekey
do
loop
end
return

Rem Project: Brave Badger
Rem Created: Tuesday, October 13, 2009
Rem The Game Creators Forum code challenge
Rem **************************************
Rem Use W A S D to move the Badger vehicle.
Rem Num pad keys control the camera view.
Rem Use "5" key to cycle camera presets.

set display mode 800,600,32
disable escapekey
set ambient light 60
color backdrop 0
randomize timer()

gosub DeclareVariables
gosub DrawGraphics
gosub MakeObjects

sync on
sync rate 60

do
    gosub PlayGame
    if nTankHealth < 1 then gosub EndSimulation else gosub ShowScore
    outlinetext("Continue? y/n",400,360,30)
    sync
    nWaitingForAnswer=1
    while nWaitingForAnswer
        if keystate(21) then nWaitingForAnswer=0
        if keystate(49) then end
        if keystate(1) then end
    endwhile
loop

` game loop ***************************
PlayGame:
set text size 20
ink cWhite,cBlack
nStartTime=timer()
nGameLength=120000
nTankHealth=200
position object nTankBody,0,5,0
yrotate object nTankBody,0

for t = 1 to 3
    position object nTarget(t),rnd(800)+50,20,rnd(800)+5
    rotate object nTarget(t),0,rnd(359)+1,0
next t


do
    ` movement controls
    nTurn = 0
    nKeyDriftFlag = 1

    if keystate(1) ` the ESC key
        for x = 1 to nObject
            delete object x
        next x
        end
    endif

    if keystate(17) ` "w" key - moving forward
        nSpeed# = nSpeed# + .1
        if nSpeed# > 5 then nSpeed# = 5
        nKeyDriftFlag = 0
    endif

    if keystate(31) ` "s" key - backward movement
        nSpeed# = nSpeed# - .1
        if nSpeed# < -5 then nSpeed# = -5
        nKeyDriftFlag = 0
    endif

    ` slow down to zero movement if no movement keys are pressed
    if nKeyDriftFlag
        if nSpeed# < .1 and nSpeed# > -.1 then nSpeed# = 0
        if nSpeed# < 0 then nSpeed# = nSpeed# + .1
        if nSpeed# > 0 then nSpeed# = nSpeed# - .1
    endif

    if keystate(30) ` "a" key - turning left
        nTurn = -1
    endif

    if keystate(32) ` "d" key - turning right
        nTurn = 1
    endif

    ` camera controls
    if keystate(72) ` "8" key on numpad - camera closer to tank
        dec camDistance
        if camDistance < 40 then camDistance = 40
    endif

    if keystate(80) ` "2" key on numpad - camera farther from tank
        inc camDistance
        if camDistance > 300 then camDistance = 300
    endif

    if keystate(75) ` "4" on keypad - camera turn left
        camAngleOffset = wrapvalue(camAngleOffset-2.5)
    endif

    if keystate(77) ` "6" key on numpad - camera turn right
        camAngleOffset = wrapvalue(camAngleOffset+2.5)
    endif

    if keystate(73) ` "9" on numpad - camera higher
        inc camHeight
      if camHeight > 300 then camHeight = 300
    endif

    if keystate(81) ` "3" on numpad - camera lower
        dec camHeight
      if camHeight < 27 then camHeight = 27
   endif

   if keystate(76) ` "5" on numpad - cycle camera views
        if timer() > nCameraTimer + 500
            nCameraTimer = timer()
          inc camShot
          if camShot = 7 then camShot = 1
          select camShot
              case 1
                  camAngleOffset =  0
                  camDistance = 60
                  camHeight = 27
              endcase
              case 2
                  camAngleOffset = 90
                  camDistance = 95
                  camHeight = 27
              endcase
              case 3
                  camAngleOffset =  270
                  camDistance = 95
                  camHeight = 27
              endcase
              case 4
                  camAngleOffset =  180
                  camDistance = 117
                  camHeight = 27
              endcase
              case 5
                  camAngleOffset =  30
                  camDistance = 200
                  camHeight = 68
              endcase
              case 6
                  camAngleOffset = 0
                  camDistance = 200
                  camHeight = 100
              endcase
          endselect
      endif
   endif

    ` flash tank laser
    if timer()>nTankLaserTimer+50
        if object visible(nTankBeam)
            hide object nTankBeam
            nTankLaserTimer=timer()
        else
            show object nTankBeam
            nTankLaserTimer=timer()
        endif
    endif

    ` check tank collision
    if nSpeed#<0 then nMovement = -1
    if nSpeed#>0 then nMovement = 1
    if nTurn = 1 and checkcollision(nTankBumper2) then nTurn = 0 : nSpeed# = 0
    if nTurn = -1 and checkcollision(nTankBumper1) then nTurn = 0 : nSpeed# = 0
    if nTurn = 1 and checkcollision(nTankBumper3) then nTurn = 0 : nSpeed# = 0
    if nTurn = -1 and checkcollision(nTankBumper4) then nTurn = 0 : nSpeed# = 0
    if nMovement = 1 and checkcollision(nTankBumper1) then nMovement = 0 : nSpeed# = 0
    if nMovement = 1 and checkcollision(nTankBumper2) then nMovement = 0 : nSpeed# = 0
    if nMovement =-1 and checkcollision(nTankBumper3) then nMovement = 0 : nSpeed# = 0
    if nMovement = -1 and checkcollision(nTankBumper4) then nMovement = 0 : nSpeed# = 0

    ` move and turn tank
    yrotate object nTankBody, wrapvalue(object angle y(nTankBody)+nTurn)
    move object nTankBody, nSpeed# * abs(nMovement)
    position object nTankBeam,object position x(nTankBody),object position y(nTankBody),object position z(nTankBody)
    set object to object orientation nTankBeam,nTankBody,1
    move object nTankBeam,163
    move object up nTankBeam,15

for t = 1 to 3
    ` check distance from target to tank
    d#=getdistance(object position x(nTankBody),object position y(nTankBody),object position z(nTankBody),object position x(nTarget(t)),object position y(nTarget(t)),object position z(nTarget(t)))

    ` if the target is close to the tank, chase it down
    if d#<200
        point object nTarget(t),object position x(nTankBody),20,object position z(nTankBody)
    endif

    ` check for tank beam hitting target
    if object collision(nTankBeam,nTarget(t)) and nTargetStatus(t) = 0
       inc nHits
       nTargetStatus(t)=1
       texture object nTarget(t),tFire
       if d# < 150.0
          dec nTankHealth, rnd(5) + 7
          if nTankHealth < 1 then gosub EndSimulation
       endif
    endif

    ` move the target
    if nTargetStatus(t)=0
        move object nTarget(t), 3
    else
        set alpha mapping on nTarget(t), 100 - (nTargetStatus(t) * 20)
        scale object nTarget(t), 100 + (nTargetStatus(t) * 40),100 + (nTargetStatus(t) * 40),100 + (nTargetStatus(t) * 40)
        inc nTargetStatus(t)
        if nTargetStatus(t) = 6
            position object nTarget(t), rnd(909)+90,20,rnd(909)+90
            scale object nTarget(t),100,100,100
            texture object nTarget(t),tNeon
            set alpha mapping on nTarget(t),100
            rotate object nTarget(t),0,rnd(259)+1,0
            nTargetStatus(t)=0
        endif
    endif

    ` check for target near boundary
    if object position z(nTarget(t)) > 900 then rotate object nTarget(t),0,wrapvalue(90+rnd(179)),0
    if object position z(nTarget(t)) < -900 then rotate object nTarget(t),0,wrapvalue(90-rnd(179)),0
    if object position x(nTarget(t)) > 900 then rotate object nTarget(t),0,wrapvalue(0-rnd(179)),0
    if object position x(nTarget(t)) < -900 then rotate object nTarget(t),0,wrapvalue(0+rnd(179)),0
next t

    ` move camera
    set camera to follow object position x(nTankBody),object position y(nTankBody),object position z(nTankBody),wrapvalue(object angle y(nTankBody)+camAngleOffset),camDistance,camHeight,1,0
    point camera object position x(nTankBody), object position y(nTankBody), object position z(nTankBody)

    ` update and fire defensive lasers
    for laser = 1 to 4
        point object nLaser(laser), object position x(nTankBody), 15, object position z(nTankBody)
        nDistance = getdistance(object position x(nTankBody),object position y(nTankBody),object position z(nTankBody),object position x(nLaser(laser)),object position y(nLaser(laser)),object position z(nLaser(laser)))

        if nDistance<600
            if rnd(30)=1 and object visible(nLaserBeam(laser))=0
            scale object nLaserBeam(laser),100,100,(nDistance*100)+10
            position object nLaserBeam(laser),0,0,(nDistance/2) + 10
            show object nLaserBeam(laser)
            laserTimer(laser) = timer()
         endif
       endif

       ` take damage from defensive lasers
       if object visible(nLaserBeam(laser)) then dec nTankHealth, 1
       if nTankHealth < 1 then return

       ` end defensive laser fire
       if timer() > laserTimer(laser) + 50
           hide object nLaserBeam(laser)
          position object nLaserBeam(laser),0,0,0
          scale object nLaserBeam(laser),100,100,100
       endif
    next laser

    ` calculate the clock
    nElapsedTime=timer()-nStartTime
    nTimeLeft=nGameLength-nElapsedTime
    nSeconds=nTimeLeft/1000
    nMinutes=nSeconds/60
    nSeconds=nSeconds-nMinutes*60
    sTime$="0"+str$(nMinutes)+":"
    if nSeconds<10 then sTime$=sTime$+"0"
    sTime$=sTime$+str$(nSeconds)

    ` display status, score, and clock
    text 0,0," Vehicle Integrity: " + str$(nTankHealth/2) + "%   Targets Destroyed: " + str$(nHits) + "   Time Left: " + sTime$
    if nSeconds=0 AND nMinutes=0 then return

    sync
loop

return
`****************************
DeclareVariables:

` color assignments
#constant cBlack=rgb(0,0,0)
#constant cWhite=rgb(255,255,255)
#constant cRed=rgb(255,0,0)
#constant cDarkRed=rgb(100,0,0)
#constant cLightBlue=rgb(150,150,255)
#constant cBlue=rgb(0,0,255)
#constant cDarkBlue=rgb(0,0,100)
#constant cDarkYellow=rgb(100,100,0)
#constant cYellow=rgb(255,255,0)
#constant cGreen=rgb(0,255,0)
#constant cDarkGreen=rgb(0,100,0)
#constant cGrey=rgb(200,200,200)
#constant cLightGray=rgb(225,225,225)
#constant cMediumGray=rgb(150,150,150)
#constant cDarkGray=rgb(50,50,50)
#constant cBrown=rgb(255,128,0)
#constant cDarkBrown=rgb(125,75,0)
#constant cDarkerBrown=rgb(65,25,0)
#constant cTan=rgb(160,120,70)
#constant cMediumTan=rgb(155,115,65)
#constant cDarktan=rgb(150,110,50)
#constant cNeon=rgb(87,87,255)

` texture assignments
tBackdrop=1
tFloorGrid=2
tBodyTop=3
tBillboard=4
tID=5
tBlack=6
tBarrel=7
tBodyFront=8
tLaser=9
tTankSkirt=10
tWallGrid=11
tNeon=12
tFire = 13

` camera assignments
camAngleOffset=0
camDistance=200
camHeight=100
camShot=6

` globals for collision function
global nCollisionStart, nCollisionEnd, nTankBody, nKeyTimer

nSeconds as integer
nMinutes as integer

dim nLaser(4)
dim nLaserBeam(4)
dim laserTimer(4)
dim nTarget(3)
dim nTargetStatus(3)

` misc variables
nTankHealth as integer = 200

return
`*********************************
DrawGraphics:

` tank shadow and other black parts
cls cBlack
get image tBlack,0,0,10,10,3

` laser beam
cls cRed
get image tLaser,0,0,7,7

` neon for marble
cls cNeon
get image tNeon,0,0,7,7

` tank skirts
cls cBlack
ink cYellow,cBlack
for x = 5 to 20
    line x,5,x+15,40
next x
get image tTankSkirt,0,0,45,45

box 100,100,300,300,cRed,cYellow,cRed,cYellow
get image tFire,100,100,300,300

` camo background
ink cTan,cBlack
box 0,0,800,600
for b = 1 to 5000
    r=rnd(2)
    select r
        case 0: c=cTan : endcase
        case 1: c=cDarkTan : endcase
        case 2: c=cMediumTan : endcase
    endselect
    ink c,cBlack
    bx=rnd(800)
    by=rnd(600)
    box bx,by,bx+10,by+10
next b

` tank body parts
get image tBodyTop,1,1,200,340,3

` back billboard on tank   <=============== draw a hatch cover!

set text font "ariel"
set text to bold
set text size 28
ink cBlack,cBlack
text 10,202,"BADGER MARK IV MOD 5"
ink cWhite,cBlck
text 8,200,"BADGER MARK IV MOD 5"
get image tBillboard,1,1,300,240,3

` tank ID number
cls
set text size 100
ink cDarkBrown,cBlack
text 5,5,"5"
ink cWhite,cBlack
text 0,0,"5"
get image tID,0,10,50,90

` floor tiles
ink cMediumGray,cBlack
box 0,0,127,127
ink cLightGray,cBlack
box 2,2,124,124
get image tFloorGrid,0,0,127,127,3
get image tWallGrid,0,0,127,127,3

return
`*************************************
MakeObjects:

` make the walls
inc nObject
make object plane nObject,2000,20
position object nObject,0,10,1000
texture object nObject,tWallGrid
scale object texture nObject,20,1

nCollisionStart=nObject

inc nObject
make object plane nObject,2000,20
position object nObject,0,10,-1000
texture object nObject,tWallGrid
scale object texture nObject,20,1

inc nObject
make object plane nObject,2000,20
rotate object nObject,0,90,0
position object nObject,-1000,10,0
texture object nObject,tWallGrid
scale object texture nObject,20,1

inc nObject
make object plane nObject,2000,20
rotate object nObject,0,90,0
position object nObject,1000,10,0
texture object nObject,tWallGrid
scale object texture nObject,20,1

inc nObject
make object box nObject,100,10,100
texture object nObject,tWallGrid
position object nObject,100,5,100

` put all the other colliding terrain before this line:
nCollisionEnd = nObject

`make the floor
inc nObject
make object plane nObject, 2000,2000
rotate object nObject, 90, 0, 0
position object nObject, 0,0,0
texture object nObject, tFloorGrid
scale object texture nObject, 20, 20
set object collision off nObject

` the laser poles
inc nObject
make object box nObject,2,50,2
position object nObject,-1005,25,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,1005,25,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,-1005,25,-1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,2,50,2
position object nObject,1005,25,-1005
texture object nObject,tWallGrid

` the laser bases
inc nObject
make object box nObject,10,20,10
position object nObject,-1005,10,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,1005,10,1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,-1005,10,-1005
texture object nObject,tWallGrid
inc nObject
make object box nObject,10,20,10
position object nObject,1005,10,-1005
texture object nObject,tWallGrid

` make the laser guns
for laser = 1 to 4
    inc nObject
    nLaser(laser) = nObject
    make object box nLaser(laser),7,7,20
next laser

` make the laser beams
for beam = 1 to 4
    inc nObject
    nLaserBeam(beam) = nObject
    make object box nLaserBeam(beam),2,2,1
    glue object to limb nLaserBeam(beam),nLaser(beam),0
    position object nLaserBeam(beam),0,0,0
    texture object nLaserBeam(beam),tLaser
    hide object nLaserBeam(beam)
next beam

` put the lasers on the poles
position object nLaser(1),-1005,50,1005
position object nLaser(2),1005,50,1005
position object nLaser(3),-1005,50,-1005
position object nLaser(4),1005,50,-1005

` make the tank
` this is the main body, root limb
inc nObject
nTankBody = nObject
make object box nTankBody,55,3,85

` these are the four bumpers used to check for collisions
inc nObject
nTankBumper1 = nObject
make object box nTankBumper1,26,1,40
inc nObject
nTankBumper2 = nObject
make object box nTankBumper2,26,1,40
inc nObject
nTankBumper3 = nObject
make object box nTankBumper3,26,1,40
inc nObject
nTankBumper4 = nObject
make object box nTankBumper4,26,1,40

` these are the rest of the tank parts
inc nObject
nTankBody1 = nObject
make object triangle nTankBody1,25,20,-40,-25,20,-40,25,5,40
inc nObject
nTankBody2 = nObject
make object triangle ntankBody2,25,5,40,-25,20,-40,-25,5,40
inc nObject
nTankSide1 = nObject
make object triangle nTankSide1,25,20,-40,25,5,-40,25,5,40
inc nObject
nTankSide2 = nObject
make object triangle nTankSide2,-25,20,-40,-25,5,-40,-25,5,40
inc nObject
nTankFront = nObject
make object plane nTankFront,50,5
inc nObject
nTankBack = nObject
make object plane nTankBack,50,5
inc nObject
nTankBillboard = nObject
make object plane nTankBillboard,50,15
inc nObject
nTankSkirt1 = nObject
make object plane nTankSkirt1,80,5
inc nObject
nTankSkirt2 = nObject
make object plane nTankSkirt2,80,5
inc nObject
nTankBarrel1 = nObject
make object box nTankBarrel1,3,3,60
inc nObject
nTankBarrel2 = nObject
make object box nTankBarrel2,8,5,6
inc nObject
nTankBarrel3 = nObject
make object sphere nTankBarrel3,3
inc nObject
nTankShadow = nObject
make object plane nTankShadow,60,90
inc nObject
nTankIDPanel1 = nObject
make object plane nTankIDPanel1,8,10
inc nObject
nTankIDPanel2 = nObject
make object plane nTankIDPanel2,8,10
inc nObject
nTankBeam = nObject
make object box nTankBeam,2,2,400

` glue all tank parts together
glue object to limb nTankBumper1,nTankBody,0
glue object to limb nTankBumper2,nTankBody,0
glue object to limb nTankBumper3,nTankBody,0
glue object to limb nTankBumper4,nTankBody,0
glue object to limb nTankBody1,nTankBody,0
glue object to limb nTankBody2,nTankBody,0
glue object to limb nTankSide1,nTankBody,0
glue object to limb nTankSide2,nTankBody,0
glue object to limb nTankFront,nTankBody,0
glue object to limb nTankBack,nTankBody,0
glue object to limb nTankBillboard,nTankBody,0
glue object to limb nTankSkirt1,nTankBody,0
glue object to limb nTankSkirt2,nTankBody,0
glue object to limb nTankBarrel1,nTankBody,0
glue object to limb nTankBarrel2,nTankBody,0
glue object to limb nTankBarrel3,nTankBody,0
glue object to limb nTankShadow,nTankBody,0
glue object to limb nTankIDPanel1,nTankBody,0
glue object to limb nTankIDPanel2,nTankBody,0

` scale and rotate some tank parts
scale object nTankBarrel3,100,100,1
rotate object nTankSkirt1,0,90,0
rotate object nTankSkirt2,0,90,0
rotate object nTankBarrel1,0,0,45
rotate object nTankShadow,90,0,0
rotate object nTankIDPanel1,0,90,0
rotate object nTankIDPanel2,0,-90,0

` position tank parts
position object nTankBumper1,-17,0,25
position object nTankBumper2,17,0,25
position object nTankBumper3,-17,0,-25
position object nTankBumper4,17,0,-25
position object nTankFront,0,2.5,40
position object nTankBack,0,2.5,-40
position object nTankBillboard, 0,12.5,-40
position object nTankSkirt1,25,2.5,0
position object nTankSkirt2,-25,2.5,0
position object nTankBarrel1,0,15,0
position object nTankBarrel2,0,15,30
position object nTankBarrel3,0,15,33
position object nTankShadow,0,-4.9,0
position object nTankIDPanel1,25.1,12,-33
position object nTankIDPanel2,-25.1,12,-33

` texture the tank parts
texture object nTankBody,tBodyTop
texture object nTankBody1,tBodyTop
texture object nTankBody2,tBodyTop
texture object nTankSide1,tBodyTop
texture object nTankSide2,tBodyTop
texture object nTankFront,tTankSkirt
texture object nTankBack,tTankSkirt
texture object ntankBillboard,tBillboard
texture object nTankSkirt1,tTankSkirt
texture object nTankSkirt2,tTankSkirt
texture object nTankBarrel1,tBodyTop
texture object nTankBarrel2,tBodyTop
texture object nTankBarrel3,tBlack
texture object nTankShadow,tBlack
texture object nTankIDPanel1,tID
texture object nTankIDPanel2,tID
texture object nTankBeam, tLaser
set alpha mapping on nTankShadow,30
scale object texture nTankFront,8,1
scale object texture nTankBack,8,1
scale object texture nTankSkirt1,12,1
scale object texture nTankSkirt2,12,1
set object transparency nTankIDPanel1,2
set object transparency nTankIDPanel2,2
set object ambience nTankBody,cMediumGray
set object ambience nTankSide1,cMediumGray
set object ambience nTankSide2,cMediumGray
set object ambience nTankBillboard,cDarkGray
set object ambience nTankBarrel1,cBlack

` hide the bumpers
hide object nTankBumper1
hide object nTankBumper2
hide object nTankBumper3
hide object nTankBumper4

` make the targets
for t = 1 to 3
    inc nObject
    nTarget(t) = nObject
    make object sphere nTarget(t),25,36,36
    texture object nTarget(t),tNeon
    inc nObject
    make object sphere nObject,30,36,36
    texture object nObject,tBlack
    set alpha mapping on nObject,30
    glue object to limb nObject, nTarget(t),0
    scale object nObject,120,0,120
    position object nObject,0,-19.9,0
next t

return
`*************************************
function checkcollision(nObjectToCheck as integer)
nCollisionFlag=0
for nCheck = nCollisionStart to nCollisionEnd
    if object collision(nObjectToCheck,nCheck)
        nCollisionFlag = 1
    endif
next nCheck
endfunction nCollisionFlag
`*************************************
function getdistance(x1 as float,y1 as float,z1 as float,x2 as float,y2 as float,z2 as float)
xd=x1-x2
yd=y1-y2
zd=z1-z2
nDistance#=sqrt((xd*xd)+(yd*yd)+(zd*zd))
endfunction nDistance#
`*************************************
function outlinetext(text$ as string, x as integer, y as integer, tsize as integer)
set text size tsize
ink cBlack,cBlack
center text x+3,y,text$
center text x-3,y,text$
center text x,y-3,text$
center text x,y+3,text$
center text x-3,y-3,text$
center text x+3,y+3,text$
center text x+3,y-3,text$
center text x-3,y+3,text$
ink cWhite,cBlack
center text x,y,text$
endfunction
`*************************************
EndSimulation:
outlinetext("VEHICLE DESTROYED",400,200,50)
outlinetext("SIMULATION TERMINATED",400,240,50)
return
`*************************************
ShowScore:
nFinalScore = ceil((nHits*50)*(nTankHealth*.01))
outlinetext("STAGE COMPLETED",400,200,50)
outlinetext("SCORE: "+str$(nFinalScore),400,240,50)
return

create bitmap 1,100,100
set current bitmap 1
	cls rgb(255, 128, 0)
	ink 0,0
	for a=0 to 9
		line a*10+9,1,a*10+9,100
	next a
	get image 1,1,1,100,100
set current bitmap 0
delete bitmap 1

make object sphere 1,1
scale object 1,100,90,100
texture object 1,1
sync on
sync rate 30
position object 1,0,1,0
do
	yrotate camera camera angle y()+mousemovex()/3.0
	xrotate camera camera angle x()+mousemovey()/3.0
	if mouseclick()=1 then move camera 0.1
	if mouseclick()=2 then move camera -0.1
	sync
loop

set display mode 800, 600, 32

#constant cLighterOrange = rgb(255,180,0)
#constant cOrange = rgb(235,150,0)
#constant cDarkerOrange = rgb(175,85,0)

cls cOrange
ink cDarkerOrange,0

for a = 0 to 16
    box a*50,0,(a+1)*50,100,cLighterOrange,cLighterOrange,cOrange,cOrange
    box (a+1)*50-1,0,(a+1)*50,100
next a

ink 0
for a = 20 to 0 step -1
    line 425-a,25+(a/2),425+a,25+(a/2)
    line 325-a,25+(a/2),325+a,25+(a/2)
next a

get image 1,0,0,800,100

make object sphere 1,20,36,36
scale object 1,100,60,100
texture object 1,1
position object 1,0,0,0
position camera 8,8,-20
point camera 0,0,0
sync on
sync rate 60

do
    turn object left 1,.5
    sync
loop

Sync On:Sync Rate 0:Autocam Off
`Set Camera Range .05,50000
`Fog Distance 400,800
`Fog On
Disable Escapekey

_Initialize_Game()

_Main_Loop()

_CleanUp()

End



`========================================================================
`=HIGH-LEVEL GAME FUNCTIONS==============================================
`========================================================================
`Constants used
`Object Types
#CONSTANT GROWER     1
#CONSTANT SHRINKER   2
#CONSTANT PAINTER    3
#CONSTANT WASHER     4

`Growers increase the size of the player
`Shrinkers reduce the size of the player
`Painters color the player
`Washers remove color from the player.


Function _Initialize_Game()
  `Declare variables
  Global PlayerSpeed as Float = .5
  Global PlayerTurn as Float = 3.0
  Global PlayerSize as Integer = 1
  Dim TickLastTimer(0) as DWord
  Dim Tick(0) as Boolean

  `Load Files

  `Perform other housekeeping
  `Make Player
  Make_Player()

  `Make ten growers
  For i =1 to 10
      Make_Grower()
  Next i

  `Make ten shrinkers
  For i =1 to 10
      Make_Shrinker()
  Next i

  `Make ten painters
  For i =1 to 10
      Make_Painter()
  Next i

  `Make ten washers
  For i =1 to 10
      Make_Washer()
  Next i
EndFunction

Function _Main_Loop()

   Repeat
      `Call main game code functions here
      Move_Player(1,PlayerSpeed * TimeFactor(60), PlayerTurn * TimeFactor(60))
      Position_Camera(1)
      Update_Tick()
      Process_Collisions(1)

      TimeFactor_Sync
   Until EscapeKey()

EndFunction

Function _Cleanup()
   `Perform any cleanup maintenance

   `Put credits here

EndFunction


`========================================================================
`=PLAYER FUNCTIONS=======================================================
`========================================================================

Function Make_Player()
   Make Object Cone 1,.5
   Make Mesh From Object 1,1
   Delete Object 1
   Make Object Sphere 1,.5
   Add Limb 1,1,1
   Rotate Limb 1,1,90,0,0
   Offset Limb 1,1,0,0,.25
   `Size the player object so we are sure it is size 1.
   Adjust_Object_Size(1,1)
   Adjust_Object_Color(1,128,128,128)
EndFunction



`Basic WASD Controls
Function Move_Player(ObjectID as DWord, MoveRate# as Float, TurnRate# as Float)
   `Defensive code: Ensure the object is valid.
   If ObjectID<1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction
   `Turn and move the object
   Turn Object Right ObjectID,(KeyState(32)-KeyState(30))*TurnRate#
   Move Object ObjectID,(KeyState(17)-KeyState(31))*MoveRate#
   `Reposition the object to compensate for its size
   Position Object ObjectID,Object Position X(ObjectID),Object Size Y(ObjectID)*.5,Object Position Z(ObjectID)

EndFunction

`Positions the camera behind the object and up a little.
Function Position_Camera(ObjectID as Dword)
   `Defensive code: Ensure the object is valid.
   If ObjectID<1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction
   `Position the camera at the object location.
   Position Camera Object Position X(ObjectID),1,Object Position Z(ObjectID)
   `Orient the camera
   Rotate Camera 0,0,0
   `Move the Camera back and up a little.
   Move Camera -40
   Position Camera Camera Position X(),Camera Position Y()+40,Camera Position Z()
   `Point the camera toward the player
   Point Camera Object Position X(ObjectID),Object Position Y(ObjectID),Object Position Z(ObjectID)
   `Re-Align Camera to 0
   Rotate Camera 40,0,0
EndFunction

`========================================================================
`=ATTRIBUTE MANAGEMENT FUNCTIONS=========================================
`========================================================================

Function Process_Collisions(ObjectID as Dword)
   `Defensive code: Ensure the object is valid.
   If ObjectID<1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction
   `Check for collision
   Collide = Object Collision(ObjectID,0)
   `If no collision, then exit the function
   If Collide = 0 Then ExitFunction
   `If the Tick(0) is 0, then exit the function since it is too soon after the last update.
   If Not Tick(0) Then ExitFunction
   `Set Tick to 0
   Tick(0) = 0
   `Get the collided object's index from the attribute list.
   Index = ObjectAttributes_Find_Entity(Collide)
   `If the index is not valid, then exit the function
   If Index < 0 Then ExitFunction
   `Get the Object Type
   ObjType = ObjectAttributes(Index).ObjType
   `Process base don the object type
   Select ObjType
      Case GROWER
         `Increase the player by 1 and reduce the grower by 1
         Adjust_Object_Size(ObjectID,1)
         Adjust_Object_Size(Collide,-1)
         `Check the size of the grower. If it is 1, then delete the object.
         If ObjectAttributes(Index).Size < 2
            Delete Object Collide
            ObjectAttributes_Delete_Element(Index)
         EndIf
      EndCase
      Case SHRINKER
         `Reduce the player by 1 and reduce the shrinker by 1
         Adjust_Object_Size(ObjectID,-1)
         Adjust_Object_Size(Collide,-1)
         `Check the size of the shrinker. If it is 1, then delete the object.
         If ObjectAttributes(Index).Size < 2
            Delete Object Collide
            ObjectAttributes_Delete_Element(Index)
         EndIf
      EndCase
      Case PAINTER
         `Get the RGB adjustments from the Painter Object
         Color = ObjectAttributes(Index).Color
         AdjRed = (RGBR(Color)>0) * 20
         AdjGrn = (RGBG(Color)>0) * 20
         AdjBlu = (RGBB(Color)>0) * 20
         `Increase the player colors and reduce the painter's colors.
         Adjust_Object_Color(ObjectID,AdjRed,AdjGrn,AdjBlu)
         Adjust_Object_Color(Collide,-AdjRed,-AdjGrn,-AdjBlu)
         `Check the color of the painter. If all colors are less than 5, then delete the object.
         color = ObjectAttributes(Index).Color
         If RGBR(color) + RGBG(color) + RGBB(color) < 20
            Delete Object Collide
            ObjectAttributes_Delete_Element(Index)
         EndIf
      EndCase
      Case WASHER
         `Get the RGB adjustments from the Washer Object
         Color = ObjectAttributes(Index).Color
         AdjRed = (RGBR(Color)>0) * 20
         AdjGrn = (RGBG(Color)>0) * 20
         AdjBlu = (RGBB(Color)>0) * 20
         `Decrease the player colors and reduce the washer's colors.
         Adjust_Object_Color(ObjectID,-AdjRed,-AdjGrn,-AdjBlu)
         Adjust_Object_Color(Collide,-AdjRed,-AdjGrn,-AdjBlu)
         `Check the color of the painter. If all colors are less than 5, then delete the object.
         color = ObjectAttributes(Index).Color
         If RGBR(color) + RGBG(color) + RGBB(color) < 20
            Delete Object Collide
            ObjectAttributes_Delete_Element(Index)
         EndIf
      EndCase
   EndSelect
EndFunction


`========================================================================
`=GAME ELEMENT FUNCTIONS=================================================
`========================================================================

Function Make_Grower()
   `Get a free object
   ObjectID = Get_Free_Object()
   `Get a random size
   Size = Rnd(4) + 2
   `Make the object
   Make Object Cone ObjectID,1
   `Add the object to the attributes array.
   `Note: This will automatically add the object to the attributes list.
   Adjust_Object_Size(ObjectID,Size)
   `Color the object Green
   Adjust_Object_Color(ObjectID,0,200,0)
   `Add the object type
   Index = ObjectAttributes_Find_Entity(ObjectID)
   ObjectAttributes(Index).ObjType = GROWER
   `Position the object. Make sure it isn't touching anything else.
   Repeat
      Position Object ObjectID, Rnd(200)-100,Size * .5, Rnd(200)-100
   Until Not Object Collision(ObjectID,0)

EndFunction

Function Make_Shrinker()
   `Get a free object
   ObjectID = Get_Free_Object()
   `Get a random size
   Size = Rnd(4) + 2
   `Make the object
   Make Object Cone ObjectID,1
   Rotate Limb ObjectID,0,180,0,0
   `Make sure the object is not culled so it can be clearly seen.
   Set Object Cull ObjectID,0
   `Add the object to the attributes array.
   `Note: This will automatically add the object to the attributes list.
   Adjust_Object_Size(ObjectID,Size)
   `Color the object Red
   Adjust_Object_Color(ObjectID,200,0,0)
   `Add the object type
   Index = ObjectAttributes_Find_Entity(ObjectID)
   ObjectAttributes(Index).ObjType = SHRINKER
   `Position the object. Make sure it isn't touching anything else.
   Repeat
      Position Object ObjectID, Rnd(200)-100,Size * .5, Rnd(200)-100
   Until Not Object Collision(ObjectID,0)

EndFunction

Function Make_Painter()
   `Get a free object
   ObjectID = Get_Free_Object()
   `Get a random size
   Size = 2
   `Make the object
   Make Object Cylinder ObjectID,1
   `Make sure the object is not culled so it can be clearly seen.
   Set Object Cull ObjectID,0
   `Add the object to the attributes array.
   `Note: This will automatically add the object to the attributes list.
   Adjust_Object_Size(ObjectID,Size)
   `Select the object color
   channel = Rnd(2)
   Select channel
      Case 0: Color = RGB(rnd(250)+5,0,0):EndCase `Red adjuster
      Case 1: Color = RGB(0,Rnd(250)+5,0):EndCase `Green adjuster
      Case 2: Color = RGB(0,0,Rnd(250)+5):EndCase `Blue adjuster
   EndSelect
   `Color the object.
   Adjust_Object_Color(ObjectID,RGBR(Color),RGBG(Color),RGBB(Color))
   `Add the object type
   Index = ObjectAttributes_Find_Entity(ObjectID)
   ObjectAttributes(Index).ObjType = PAINTER
   `Position the object. Make sure it isn't touching anything else.
   Repeat
      Position Object ObjectID, Rnd(200)-100,Size * .5, Rnd(200)-100
   Until Not Object Collision(ObjectID,0)

EndFunction

Function Make_Washer()
   `Get a free object
   ObjectID = Get_Free_Object()
   `Get a random size
   Size = 2
   `Make the object
   Make Object Cube ObjectID,1
   Rotate Limb ObjectID,0,45,0,45
   `Make sure the object is not culled so it can be clearly seen.
   Set Object Cull ObjectID,0
   `Add the object to the attributes array.
   `Note: This will automatically add the object to the attributes list.
   Adjust_Object_Size(ObjectID,Size)
   `Select the object color
   channel = Rnd(2)
   Select channel
      Case 0: Color = RGB(rnd(250)+5,0,0):EndCase `Red adjuster
      Case 1: Color = RGB(0,Rnd(250)+5,0):EndCase `Green adjuster
      Case 2: Color = RGB(0,0,Rnd(250)+5):EndCase `Blue adjuster
   EndSelect
   `Color the object.
   Adjust_Object_Color(ObjectID,RGBR(Color),RGBG(Color),RGBB(Color))
   `Add the object type
   Index = ObjectAttributes_Find_Entity(ObjectID)
   ObjectAttributes(Index).ObjType = WASHER
   `Position the object. Make sure it isn't touching anything else.
   Repeat
      Position Object ObjectID, Rnd(200)-100,Size * .5, Rnd(200)-100
   Until Not Object Collision(ObjectID,0)

EndFunction

`========================================================================
`=SIZE AND COLOR FUNCTIONS===============================================
`========================================================================

`Scale object changes the object size only relative to the current size
`Size_Object changes the size of an object to an absolute size.
Function Adjust_Object_Size(ObjectID as DWord, AdjustSize# as Float)
   `Defensive code: Ensure the object is valid.
   If ObjectID<1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction
   `Declarations
   Local NewSize#    as Float
   `Capture the current size. Start by retrieving the attributes.
   Index = ObjectAttributes_Find_Entity(ObjectID)
   `Defensive Code: The index does not exist.
   If Index < 0
      `Add the object to the attributes list.
      Index = ObjectAttributes_Add_EntityID(ObjectID)
   EndIf
   `Capture the current object size
   CurrentSize# = ObjectAttributes(Index).Size
   `Capture the acutal object size
   ActualSize# = Object Size(ObjectID)
   `Defensive code: Ensure CurrentSize# is not 0 to avoid a divide by 0 error. We also don't want negative values.
   If CurrentSize# <= 0 Then CurrentSize# = 1
   `Cap the size
   NewSize#       = CapVal(CurrentSize# + AdjustSize# ,1,10)
   `Determine how much we need to scale the object by.
   Scale#         = NewSize# / ActualSize#
   `Multiply by 100 to correct for the way Scale Object works
   Scale#         = Scale# * 100.0
   `Scale the object
   Scale Object ObjectID, Scale#,Scale#,Scale#
   `Set the attribute size
   ObjectAttributes(Index).Size = NewSize#
EndFunction

Function Adjust_Object_Color(ObjectID as DWord, AdjustRed as Integer, AdjustGreen as Integer, AdjustBlue as Integer)
   `Defensive code: Ensure the object is valid.
   If ObjectID<1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction
   `Declarations
   Local OldColor    as DWord
   Local OldRed      as Byte
   Local OldGreen    as Byte
   Local OldBlue     as Byte
   Local NewColor    as DWord
   Local NewRed      as Byte
   Local NewGreen    as Byte
   Local NewBlue     as Byte
   `Capture the current colors. Start by retrieving the attributes.
   Index = ObjectAttributes_Find_Entity(ObjectID)
   `Defensive Code: The index does not exist.
   If Index < 0
      `Add the object to the attributes list.
      Index    = ObjectAttributes_Add_EntityID(ObjectID)
   EndIf
   `Retrieve the current color attribute
   OldColor    = ObjectAttributes(Index).Color
   `Divide the color out into RGB components.
   OldRed      = RGBR(OldColor)
   OldGreen    = RGBG(OldColor)
   OldBlue     = RGBB(OldColor)
   `Adjust the colors
   NewRed      = CapVal(OldRed + AdjustRed,0,255)
   NewGreen    = CapVal(OldGreen + AdjustGreen,0,255)
   NewBlue     = CapVal(OldBlue + AdjustBlue,0,255)
   `Get the new color.
   NewColor    = RGB(NewRed,NewGreen,NewBlue)
   `Store the new color
   ObjectAttributes(Index).Color = NewColor
   `Color the object
   Color Object ObjectID,NewColor
   Set Object Emissive ObjectID,RGB(NewRed,NewGreen,NewBlue)

EndFunction

`========================================================================
`=TICK FUNCTIONS=========================================================
`========================================================================

Function Update_Tick()
   If Timer() - TickLastTimer(0) < 1000 Then Exitfunction `Update every second
   TickLastTimer(0) = Timer()
   Tick(0) = 1
EndFunction

`========================================================================
`=MISC FUNCTIONS=========================================================
`========================================================================

`CapVal will return the value if it is in range of the minimum and maximum values,
`       otherwise, it will return the minimum value if it is lower than the range,
`       or the maximum value if it is greater than the range.
Function CapVal(Value as Integer,Minimum as Integer, Maximum as Integer)
   `Defensive code: Ensure there is a range, otherwise this will get stuck in an infinite loop.
   If Minimum = Maximum Then ExitFunction Minimum
   `Defensive code: Ensure the Min/Max values are correctly Lower/Higher respectively.
   If Minimum  > Maximum
      `Swap the min and max values
      Temp     = Maximum
      Maximum  = Minimum
      Minimum  = Temp
   EndIf
   `Ensure the value is at least the minimum
   If Value    < Minimum
      Value    = Minimum
   EndIf
   `Ensure the value is at most the maximum
   If Value    > Maximum
      Value    = Maximum
   EndIf
EndFunction Value

Function Get_Free_Object()
   i = 1
   While Object Exist(i)
      inc i
   EndWhile
EndFunction i

`============================================================================================================================
`=TIMER BASED MOVEMENT FUNCTIONS=============================================================================================
`============================================================================================================================

`When calling the TimeFactor() function, pass the target virtual frame rate (FrameRate)
`to achieve (i.e. 60 for 60 FPS, or 30 for 30 FPS). A value of 0 defaults to 60 FPS.
`The return value is a percentage; multiply movement, turning, or other timer-based
`factor by the TimeFactor() return value.

`Example:  Move Object ObjectID, 1.0 * TimeFactor(60)
`will move an object 1 DBP unit every 1/60th of a second regardless of the actual FPS.
Function TimeFactor(dwdFrameRate as DWord)
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   Local fltMS as Float = 0.0 `HI-res Ticks (originally miliseconds)
   Local fltTF as Float = 0.0 `TimeFactor results
   `Defensive coding (set default framerates
   If dwdFrameRate=0 Then dwdFrameRate=60
   `Calculate hi-res ticks required to achieve the desired framerate.
   fltMS=15000000.0/dwdFrameRate
   `Calculate the ratio between the actual time-span of the last update to the target framerate in hi-res ticks
   fltTF=dwdTimeDiff(0)/fltMS
   `Defensive programming...
   `This caps the Virtual Framerate to 50% of the Actual Framerate to keep "jumping" from happening.
   `2 = 200%, which is twice as many hi-res ticks.
   `You can remark out or alter this line as needed.
   If fltTF>2.0 then fltTF=2.0
EndFunction fltTF

`Call the Update_TimeFactor() once each frame, ideally after the Sync command.
`Do not use this function if using the TimeFactorSync() function (in the same loop)
#CONSTANT Update_TimeFactor Update_TimeFactor()
Function Update_TimeFactor()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Defensive programming. Adjusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction

`Use this function to include a sync command while updating the TimeFactor values.
`Do not use this function if using the Update_TimeFactor() function (in the same loop)
#CONSTANT TimeFactor_Sync TimeFactor_Sync()
Function TimeFactor_Sync()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Call a screen update (Sync)
   Sync
   `Defensive programming. Adusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction




`============================================================================================================================
`=Distance Functions=========================================================================================================
`============================================================================================================================

Function Initialize_Distance_Functions()
   `Defensive programming. Prevents the function from being called more than once.
   Dim intInitDistFuncs(0)
   If intInitDistFuncs(0) Then ExitFunction
   intInitDistFuncs(0) = 1:` Set the flag to 1 so the function does not get called again.

   `Declarations
   Global dwdDistanceVector as DWord
   Local n as Integer = 0 `Just a "null" variable to contain the required return result when creating a vector

   `Set the value of the vector variable to a free vector
   dwdDistanceVector = Find Free Vector()

   `Create the vector
   n = Make Vector3(dwdDistanceVector)

EndFunction

`Returns the distance between two objects.
`Set the bolSquared flag to 1 if you want the return length squared.
Function Get_Object_Distance(dwdObjectID1 as Dword, dwdObjectID2 as DWord, bolSquared as Boolean)
   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object IDs provided are valid.
   `If the Object IDs are not valid, simply exit the function and return the value 0.0
   If dwdObjectID1<1 or dwdObjectID2<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID1) Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID2) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID1) - Object Position X(dwdObjectID2)
   dy=Object Position Y(dwdObjectID1) - Object Position Y(dwdObjectID2)
   dz=Object Position Z(dwdObjectID1) - Object Position Z(dwdObjectID2)

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance

`Returns the distance between an object and target coordinates
``Set the bolSquared flag to 1 if you want the return length squared.
Function Get_Target_Distance(dwdObjectID as Dword, fltTargetX as Float, fltTargetY as Float, fltTargetZ as Float, bolSquared as Boolean)
   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object ID provided is valid.
   `If the Object ID is not valid, simply exit the function and return the value 0.0
   If dwdObjectID<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID1) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID) - fltTargetX
   dy=Object Position Y(dwdObjectID) - fltTargetY
   dz=Object Position Z(dwdObjectID) - fltTargetZ

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance

`Returns the distance between an object and a camera.
`Set the bolSquared flag to 1 if you want the return length squared.
Function Get_Camera_Distance(dwdObjectID as Dword, dwdCameraID as DWord, bolSquared as Boolean)
   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object ID and Camera ID provided are valid.
   `If the Object ID or Camera ID are not valid, simply exit the function and return the value 0.0
   If dwdObjectID<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID) Then ExitFunction fltDistance
   If Not Camera Exist(dwdCameraID) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID) - Camera Position X(dwdCameraID)
   dy=Object Position Y(dwdObjectID) - Camera Position Y(dwdCameraID)
   dz=Object Position Z(dwdObjectID) - Camera Position Z(dwdCameraID)

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance









`=================Entity Data Navigation Array (E.D.N.A.)================
`====================Array Sort-n-Search Functionality===================

`Created 11/09/09  08:32:52

`========================================================================
`========================================================================


`Note: This library of functions is intended for use as sub modules.



Type ObjectAttributes_Type
EntityID as Integer
Color as DWord
Size as Integer
ObjType as Integer
EndType

Function Initialize_Array_ObjectAttributes()
   Dim InitArrayObjectAttributes(0)
   If InitArrayObjectAttributes(0) Then ExitFunction
   InitArrayObjectAttributes(0)=1
   Dim ObjectAttributes(999) as ObjectAttributes_Type
   Dim ObjectAttributesTop(0) as Integer
   ObjectAttributesTop(0)=-1
EndFunction


`ObjectAttributes_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.
Function ObjectAttributes_Find_Entity(EntityID as Integer)
   Initialize_Array_ObjectAttributes()
   Top=ObjectAttributesTop(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<ObjectAttributes(0).EntityID Then ExitFunction -1
   If EntityID=ObjectAttributes(0).EntityID Then ExitFunction 0
   If EntityID=ObjectAttributes(Top).EntityID Then ExitFunction Top
   If EntityID>ObjectAttributes(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=ObjectAttributes(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>ObjectAttributes(BSearch).EntityID)-(EntityID<ObjectAttributes(BSearch).EntityID)))
   Next i
EndFunction -1


`ObjectAttributes_Add_EntityID(EntityID As Integer):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.
Function ObjectAttributes_Add_EntityID(EntityID As Integer)
   Index=ObjectAttributes_Find_EntityID_Place(EntityID)
   ObjectAttributes_Insert_Element(Index)
   ObjectAttributes(Index).EntityID=EntityID
EndFunction Index


`ObjectAttributes_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.
Function ObjectAttributes_Insert_Element(Index as Integer)
   Initialize_Array_ObjectAttributes()
   ObjectAttributesTop(0)=ObjectAttributesTop(0)+1
   If ObjectAttributesTop(0)=>Array Count(ObjectAttributes())
      Array Insert At Bottom ObjectAttributes()
   EndIf
   If Index=>ObjectAttributesTop(0) Then ExitFunction
   For i =ObjectAttributesTop(0)-1 To Index Step -1
      ObjectAttributes(i+1)=ObjectAttributes(i)
   Next i
EndFunction


`ObjectAttributes_Find_EntityID_Place(EntityID as Integer):Return Integer
`This function is similar to the ObjectAttributes_Find_EntityID() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`"fits" within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.
Function ObjectAttributes_Find_EntityID_Place(EntityID as Integer)
   Initialize_Array_ObjectAttributes()
   Top=ObjectAttributesTop(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=ObjectAttributes(0).EntityID Then ExitFunction 0
   If EntityID=>ObjectAttributes(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=ObjectAttributes(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>ObjectAttributes(BSearch-1).EntityID And EntityID<=ObjectAttributes(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>ObjectAttributes(BSearch).EntityID)-(EntityID<ObjectAttributes(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top


`ObjectAttributes_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.
Function ObjectAttributes_Delete_Element(Index as Integer)
   Initialize_Array_ObjectAttributes()
   If Index<0 or Index>ObjectAttributesTop(0) Then ExitFunction
   ObjectAttributesTop(0)=ObjectAttributesTop(0)-1
   For i = Index to ObjectAttributesTop(0)
      ObjectAttributes(i)=ObjectAttributes(i+1)
   Next i
EndFunction

Sync On:Sync Rate 0:Autocam Off
`Set Camera Range .05,50000
`Fog Distance 400,800
`Fog On
Disable Escapekey

_Initialize_Game()

_Main_Loop()

_CleanUp()

End

Function _Initialize_Game()
  `Declare variables

  `Load Files

  `Perform other housekeeping
  Make Object Cube 1,1 ` Player
  Set Object Cull 1,0


  Make Object Cylinder 2,1 `Move Object
  Set Object Cull 2,0
  Rotate Limb 2,0,0,0,90
  Position Object 2,0,1,3
  _Move_Bucket_Add_Entity(2,1)

  Make Object Sphere 3,1 `Turn Object
  Position Object 3, 0,1,20
  _Turn_Bucket_Add_Entity(3,3)

  `make a playing field?
  objID = 11
  For z = -20 to 20 step 4
     For x = -20 to 20 step 4
         Make Object Box objID,4,.1,4
         Color Object objID,RGB(rnd(255),Rnd(255),Rnd(255))
         Position Object objID,x,-.1,z
         inc objID
     Next x
   Next z
EndFunction

Function _Main_Loop()

   Repeat
      Set Cursor 0,0
      Print Screen FPS()
       `Call main game code functions here
       _Process_Move_Bucket()
       _Process_Turn_Bucket()

       Update_Player()
       TimeFactor_Sync
   Until EscapeKey()

EndFunction

Function _Cleanup()
   `Perform any cleanup maintenance

   `Put credits here

EndFunction



Function Update_Player()
   Position Object 1,Object Position X(1),Object Size Y(1)*.5+1,Object Position Z(1)
   Position Camera Object Position X(1),0,Object Position Z(1)
   Rotate Camera 45,-30,0
   Move Camera -50

   Print "Use the WASD keys for movement."
   If _Move_Bucket_Find_Entity(1)<0
      Print "You cannot move until you add a wheel."
      Print "Click on the nearby cylinder"
   Else
      If _Turn_Bucket_Find_Entity(1)<0
         Print "You can move, but cannot turn."
         Print "Move forward to the sphere and click it."
      EndIf
   EndIf
EndFunction


`======================================================================
`Move Bucket
`======================================================================

`Created On 11/11/09 14:46:28


Type MoveType
   EntityID as DWord
   Speed as Float
EndType

Function _Initialize_Move_Bucket()
   Dim Init_Move_Bucket(0)
   If Init_Move_Bucket(0) Then ExitFunction
   Init_Move_Bucket(0)=1
   Dim Move_Bucket(99) as MoveType
   Dim Move_Bucket_Top(0) as Integer
   Move_Bucket_Top(0)=-1
   Dim Move_Culled_Bucket(99) as MoveType
   Dim Move_Culled_Bucket_Top(0) as Integer
   Move_Culled_Bucket_Top(0)=-1
   Dim Move_Culling_Tracker(0) as Integer
   Dim Move_Culling_C(0) as Integer
   Dim Move_Culling_F(0) as Integer
   Dim Move_CullRange(0) as Float
   Move_CullRange(0)=1000
EndFunction



`Move_Bucket_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.

Function _Move_Bucket_Find_Entity(EntityID as Integer)
   _Initialize_Move_Bucket()
   Top=Move_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<Move_Bucket(0).EntityID Then ExitFunction -1
   If EntityID=Move_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=Move_Bucket(Top).EntityID Then ExitFunction Top
   If EntityID>Move_Bucket(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Move_Bucket(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Move_Bucket(BSearch).EntityID)-(EntityID<Move_Bucket(BSearch).EntityID)))
   Next i
EndFunction -1


`Move_Bucket_Find_Entity_Place(EntityID as Integer):Return Integer
`This function is similar to the Move_Bucket_Find_Entity() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`'fits' within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.
`The Return Integer is the Index within the array where the EntityID was placed. It is not
`recommended to use this value for long-term since the index can change as new Entities are added.

Function _Move_Bucket_Find_Entity_Place(EntityID as Integer)
   _Initialize_Move_Bucket()
   Top=Move_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=Move_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=>Move_Bucket(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Move_Bucket(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>Move_Bucket(BSearch-1).EntityID And EntityID<=Move_Bucket(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Move_Bucket(BSearch).EntityID)-(EntityID<Move_Bucket(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top


`_Move_Bucket_Add_Entity(EntityID as DWord,Speed as Float):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.

Function _Move_Bucket_Add_Entity(EntityID as DWord,Speed as Float)
   _Initialize_Move_Bucket()
   Index=_Move_Bucket_Find_Entity(EntityID)
   If Index<0
      Index=_Move_Bucket_Find_Entity_Place(EntityID)
      _Move_Bucket_Insert_Element(Index)
   EndIf
   Move_Bucket(Index).EntityID=EntityID
   Move_Bucket(Index).Speed=Speed
EndFunction Index


`_Move_Bucket_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.

Function _Move_Bucket_Insert_Element(Index as Integer)
   _Initialize_Move_Bucket()
   Move_Bucket_Top(0)=Move_Bucket_Top(0)+1
   If Move_Bucket_Top(0)=>Array Count(Move_Bucket())
      Array Insert At Bottom Move_Bucket()
   EndIf
   If Index=>Move_Bucket_Top(0) Then ExitFunction
   For i =Move_Bucket_Top(0)-1 To Index Step -1
      Move_Bucket(i+1)=Move_Bucket(i)
   Next i
EndFunction


`_Remove_Entity_From_Move_Bucket(EntityID as Integer)
`This function finds the EntityID within the bucket and
`deletes the entity's element from the Bucket array.

Function _Remove_Entity_From_Move_Bucket(EntityID as Integer)
   _Initialize_Move_Bucket()
   Index=_Move_Bucket_Find_Entity(EntityID)
   If Index<0 Then ExitFunction
   _Move_Bucket_Delete_Element(Index)
EndFunction


`_Move_Bucket_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.

Function _Move_Bucket_Delete_Element(Index as Integer)
   _Initialize_Move_Bucket()
   If Index<0 or Index>Move_Bucket_Top(0) Then ExitFunction
   Move_Bucket_Top(0)=Move_Bucket_Top(0)-1
   For i = Index to Move_Bucket_Top(0)
      Move_Bucket(i)=Move_Bucket(i+1)
   Next i
EndFunction




`Process_Move_Bucket()
`This function cycles through each entity in the bucket and calls the main
`bucket function, which contains the core functionality for the bucket.

Function _Process_Move_Bucket()
   _Initialize_Move_Bucket()
   For i = 0 to Move_Bucket_Top(0)
      If i>Move_Bucket_Top(0) Then ExitFunction
      EntityID=Move_Bucket(i).EntityID
      If EntityID>0
         DIF=_Main_Move_Function(i)
         i=i-DIF
      EndIf
   Next i
   _Process_Move_Culled_Bucket()
EndFunction





Function _Main_Move_Function(Index as Integer)

   _Initialize_Move_Bucket()
   Local DeleteIndexFlag=0
   DIF=_Update_Move_Culling(Index)
   If DIF Then ExitFunction 1
   ObjectID = Move_Bucket(Index).EntityID
   Speed# = Move_Bucket(Index).Speed
   If ObjectID = 1
      Move Object ObjectID,(KeyState(17)-KeyState(31))*Speed#*TimeFactor(60)
      ExitFunction DeleteIndexFlag
   EndIf
   Dist# = Get_Object_Distance(1,ObjectID)
   If Dist#>5 Then ExitFunction DeleteIndexFlag
   If Pick Object(MouseX(),MouseY(),ObjectID,ObjectID) = 0 Then ExitFunction DeleteIndexFlag
   If MouseClick()<>1 Then ExitFunction DeleteIndexFlag
   _Move_Bucket_Add_Entity(1,Speed#)
   Make Mesh From Object 1,ObjectID
   Delete Object ObjectID
   LimbID = 1
   While Limb Exist(1,LimbID)
      Inc LimbID
   EndWhile
   Add Limb 1,LimbID,1
   Offset Limb 1,LimbID,0,-1,-.5,1
   Set Object Cull 1,0
   _Remove_Entity_From_Move_Bucket(ObjectID)
   DeleteIndexFlag = 1
EndFunction DeleteIndexFlag
`NOTE: If using an ExitFunction, be sure to include DeleteIndexFlag as the
`      return variable (or use 0). The compiler will compile the project
`      even if you omit the return variable, but this will cause problems
`      during exectution.




Function _Update_Move_Culling(Index)

   _Initialize_Move_Bucket()
   Local DeleteIndex=0
   EntityID=Move_Bucket(Index).EntityID
   If Not Object Exist(EntityID) Then ExitFunction
   d#=get_target_distance(EntityID,Camera Position X(),Camera Position Y(),Camera Position Z())
   `===NOTE: The following line is optional.===
   `if d#> Move_CullRange(0) *3 Then Hide Object EntityID Else Show Object EntityID
   If d#> Move_CullRange(0)
      _Move_Culled_Bucket_Add_Entity(Move_Bucket(Index).EntityID,Move_Bucket(Index).Speed)
      _Move_Bucket_Delete_Element(Index)
      DeleteIndex=1
   Endif
EndFunction DeleteIndex


Function _Update_Move_UnCulling(Index)
   _Initialize_Move_Bucket()
   Local DeleteIndex=0
   EntityID=Move_Culled_Bucket(Index).EntityID
   If Not Object Exist(EntityID) Then ExitFunction
   d#=get_target_distance(EntityID,Camera Position X(),Camera Position Y(),Camera Position Z())
   `===NOTE: The following line is optional.===
   `if d#> Move_CullRange(0) *3 Then Hide Object EntityID Else Show Object EntityID
   If d#<= Move_CullRange(0)
      _Move_Bucket_Add_Entity(Move_Culled_Bucket(Index).EntityID,Move_Culled_Bucket(Index).Speed)
      _Move_Culled_Bucket_Delete_Element(Index)
      DeleteIndex=1
   Endif
EndFunction DeleteIndex


`======================================================================
`Move Culled Bucket,
`======================================================================


`_Move_Culled_Bucket_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.

Function _Move_Culled_Bucket_Find_Entity(EntityID as Integer)
   _Initialize_Move_Bucket()
   Top=Move_Culled_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<Move_Culled_Bucket(0).EntityID Then ExitFunction -1
   If EntityID=Move_Culled_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=Move_Culled_Bucket(Top).EntityID Then ExitFunction Top
   If EntityID>Move_Culled_Bucket(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Move_Culled_Bucket(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Move_Culled_Bucket(BSearch).EntityID)-(EntityID<Move_Culled_Bucket(BSearch).EntityID)))
   Next i
EndFunction -1

`_Move_Culled_Bucket_Find_Entity_Place(EntityID as Integer):Return Integer
`This function is similar to the Move_Culled_Bucket_Find_Entity() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`'fits' within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.

Function _Move_Culled_Bucket_Find_Entity_Place(EntityID as Integer)
   _Initialize_Move_Bucket()
   Top=Move_Culled_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=Move_Culled_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=>Move_Culled_Bucket(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Move_Culled_Bucket(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>Move_Culled_Bucket(BSearch-1).EntityID And EntityID<=Move_Culled_Bucket(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Move_Culled_Bucket(BSearch).EntityID)-(EntityID<Move_Culled_Bucket(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top




`_Move_Culled_Bucket_Add_EntityID(EntityID As Integer):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.

Function _Move_Culled_Bucket_Add_Entity(EntityID as DWord,Speed as Float)
   _Initialize_Move_Bucket()
   Index=_Move_Culled_Bucket_Find_Entity(EntityID)
   If Index<0
      Index=_Move_Culled_Bucket_Find_Entity_Place(EntityID)
      _Move_Culled_Bucket_Insert_Element(Index)
   EndIf
   Move_Culled_Bucket(Index).EntityID=EntityID
   Move_Culled_Bucket(Index).Speed=Speed
EndFunction Index

`_Move_Culled_Bucket_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.

Function _Move_Culled_Bucket_Insert_Element(Index as Integer)
   _Initialize_Move_Bucket()
   Move_Culled_Bucket_Top(0)=Move_Culled_Bucket_Top(0)+1
   If Move_Culled_Bucket_Top(0)=>Array Count(Move_Culled_Bucket())
      Array Insert At Bottom Move_Culled_Bucket()
   EndIf
   If Index=>Move_Culled_Bucket_Top(0) Then ExitFunction
   For i =Move_Culled_Bucket_Top(0)-1 To Index Step -1
      Move_Culled_Bucket(i+1)=Move_Culled_Bucket(i)
   Next i
EndFunction

`_Remove_Entity_From_Move_Culled_Bucket(EntityID as Integer)
`This function finds the EntityID within the bucket and
`deletes the entity's element from the Bucket array.

Function _Remove_Entity_From_Move_Culled_Bucket(EntityID as Integer)
   _Initialize_Move_Bucket()
   Index=_Move_Culled_Bucket_Find_Entity(EntityID)
   If Index<0 Then ExitFunction
   _Move_Culled_Bucket_Delete_Element(Index)
EndFunction

`_Move_Culled_Bucket_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.

Function _Move_Culled_Bucket_Delete_Element(Index as Integer)
   _Initialize_Move_Bucket()
   If Index<0 or Index>Move_Culled_Bucket_Top(0) Then ExitFunction
   Move_Culled_Bucket_Top(0)=Move_Culled_Bucket_Top(0)-1
   For i = Index to Move_Culled_Bucket_Top(0)
      Move_Culled_Bucket(i)=Move_Culled_Bucket(i+1)
   Next i
EndFunction




Function _Process_Move_Culled_Bucket()
   _Initialize_Move_Bucket()
   If Move_Culling_Tracker(0)>Move_Culled_Bucket_Top(0) Then Move_Culling_Tracker(0)=0
   Move_Max=Move_Culling_Tracker(0)+(Move_Culled_Bucket_Top(0)/5)+1
   If Move_Max>Move_Culled_Bucket_Top(0) Then Move_Max=Move_Culled_Bucket_Top(0)
   For i = Move_Culling_Tracker(0) to Move_Max
      If i>Move_Culled_Bucket_Top(0) Then ExitFunction
      EntityID=Move_Culled_Bucket(i).EntityID
      If EntityID>0
         DIF=_Main_Move_Culled_Function(i)
         i=i-DIF
      EndIf
   Next i
   Move_Culling_Tracker(0)=Move_Max+1
EndFunction




Function _Main_Move_Culled_Function(Index as Integer)
   _Initialize_Move_Bucket()
   Local DeleteIndexFlag=0
   DIF=_Update_Move_UnCulling(Index)
   If DIF Then ExitFunction 1
   `Add code here.
   `Add code here.
   `Add code here.
EndFunction DeleteIndexFlag
`NOTE: If using an ExitFunction, be sure to include DeleteIndexFlag as the
`      return variable (or use 0). The compiler will compile the project
`      even if you omit the return variable, but this will cause problems
`      during exectution.


`======================================================================
`End of Move Bucket code
`======================================================================


`======================================================================
`Turn Bucket
`======================================================================

`Created On 11/11/09 14:47:55


Type TurnType
   EntityID as DWord
   Rate as Float
EndType

Function _Initialize_Turn_Bucket()
   Dim Init_Turn_Bucket(0)
   If Init_Turn_Bucket(0) Then ExitFunction
   Init_Turn_Bucket(0)=1
   Dim Turn_Bucket(99) as TurnType
   Dim Turn_Bucket_Top(0) as Integer
   Turn_Bucket_Top(0)=-1
   Dim Turn_Culled_Bucket(99) as TurnType
   Dim Turn_Culled_Bucket_Top(0) as Integer
   Turn_Culled_Bucket_Top(0)=-1
   Dim Turn_Culling_Tracker(0) as Integer
   Dim Turn_Culling_C(0) as Integer
   Dim Turn_Culling_F(0) as Integer
   Dim Turn_CullRange(0) as Float
   Turn_CullRange(0)=1000
EndFunction

`Turn_Bucket_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.

Function _Turn_Bucket_Find_Entity(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Top=Turn_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<Turn_Bucket(0).EntityID Then ExitFunction -1
   If EntityID=Turn_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=Turn_Bucket(Top).EntityID Then ExitFunction Top
   If EntityID>Turn_Bucket(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Turn_Bucket(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Turn_Bucket(BSearch).EntityID)-(EntityID<Turn_Bucket(BSearch).EntityID)))
   Next i
EndFunction -1


`Turn_Bucket_Find_Entity_Place(EntityID as Integer):Return Integer
`This function is similar to the Turn_Bucket_Find_Entity() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`'fits' within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.
`The Return Integer is the Index within the array where the EntityID was placed. It is not
`recommended to use this value for long-term since the index can change as new Entities are added.

Function _Turn_Bucket_Find_Entity_Place(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Top=Turn_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=Turn_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=>Turn_Bucket(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Turn_Bucket(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>Turn_Bucket(BSearch-1).EntityID And EntityID<=Turn_Bucket(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Turn_Bucket(BSearch).EntityID)-(EntityID<Turn_Bucket(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top



`_Turn_Bucket_Add_Entity(EntityID as DWord,Rate as Float):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.

Function _Turn_Bucket_Add_Entity(EntityID as DWord,Rate as Float)
   _Initialize_Turn_Bucket()
   Index=_Turn_Bucket_Find_Entity(EntityID)
   If Index<0
      Index=_Turn_Bucket_Find_Entity_Place(EntityID)
      _Turn_Bucket_Insert_Element(Index)
   EndIf
   Turn_Bucket(Index).EntityID=EntityID
   Turn_Bucket(Index).Rate=Rate
EndFunction Index


`_Turn_Bucket_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.

Function _Turn_Bucket_Insert_Element(Index as Integer)
   _Initialize_Turn_Bucket()
   Turn_Bucket_Top(0)=Turn_Bucket_Top(0)+1
   If Turn_Bucket_Top(0)=>Array Count(Turn_Bucket())
      Array Insert At Bottom Turn_Bucket()
   EndIf
   If Index=>Turn_Bucket_Top(0) Then ExitFunction
   For i =Turn_Bucket_Top(0)-1 To Index Step -1
      Turn_Bucket(i+1)=Turn_Bucket(i)
   Next i
EndFunction


`_Remove_Entity_From_Turn_Bucket(EntityID as Integer)
`This function finds the EntityID within the bucket and
`deletes the entity's element from the Bucket array.

Function _Remove_Entity_From_Turn_Bucket(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Index=_Turn_Bucket_Find_Entity(EntityID)
   If Index<0 Then ExitFunction
   _Turn_Bucket_Delete_Element(Index)
EndFunction


`_Turn_Bucket_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.

Function _Turn_Bucket_Delete_Element(Index as Integer)
   _Initialize_Turn_Bucket()
   If Index<0 or Index>Turn_Bucket_Top(0) Then ExitFunction
   Turn_Bucket_Top(0)=Turn_Bucket_Top(0)-1
   For i = Index to Turn_Bucket_Top(0)
      Turn_Bucket(i)=Turn_Bucket(i+1)
   Next i
EndFunction




`Process_Turn_Bucket()
`This function cycles through each entity in the bucket and calls the main
`bucket function, which contains the core functionality for the bucket.

Function _Process_Turn_Bucket()
   _Initialize_Turn_Bucket()
   For i = 0 to Turn_Bucket_Top(0)
      If i>Turn_Bucket_Top(0) Then ExitFunction
      EntityID=Turn_Bucket(i).EntityID
      If EntityID>0
         DIF=_Main_Turn_Function(i)
         i=i-DIF
      EndIf
   Next i
   _Process_Turn_Culled_Bucket()
EndFunction




Function _Main_Turn_Function(Index as Integer)

   _Initialize_Turn_Bucket()
   Local DeleteIndexFlag=0
   DIF=_Update_Turn_Culling(Index)
   If DIF Then ExitFunction 1
   ObjectID = Turn_Bucket(Index).EntityID
   Rate# = Turn_Bucket(Index).Rate
   If ObjectID = 1
      Turn Object Right ObjectID,(KeyState(32)-KeyState(30))*Rate#*TimeFactor(60)
      ExitFunction DeleteIndexFlag
   EndIf
   Dist# = Get_Object_Distance(1,ObjectID)
   If Dist#>5 Then ExitFunction DeleteIndexFlag
   If Pick Object(MouseX(),MouseY(),ObjectID,ObjectID) = 0 Then ExitFunction DeleteIndexFlag
   If MouseClick()<>1 Then ExitFunction DeleteIndexFlag
   _Turn_Bucket_Add_Entity(1,Rate#)
   Make Mesh From Object 1,ObjectID
   Delete Object ObjectID
   LimbID = 1
   While Limb Exist(1,LimbID)
      Inc LimbID
   EndWhile
   Add Limb 1,LimbID,1
   Offset Limb 1,LimbID,0,-1,.5,1
   _Remove_Entity_From_Turn_Bucket(ObjectID)
   DeleteIndexFlag = 1
EndFunction DeleteIndexFlag
`NOTE: If using an ExitFunction, be sure to include DeleteIndexFlag as the
`      return variable (or use 0). The compiler will compile the project
`      even if you omit the return variable, but this will cause problems
`      during exectution.




Function _Update_Turn_Culling(Index)
   _Initialize_Turn_Bucket()
   Local DeleteIndex=0
   EntityID=Turn_Bucket(Index).EntityID
   If Not Object Exist(EntityID) Then ExitFunction
   d#=get_target_distance(EntityID,Camera Position X(),Camera Position Y(),Camera Position Z())
   `===NOTE: The following line is optional.===
   `if d#> Turn_CullRange(0) *3 Then Hide Object EntityID Else Show Object EntityID
   If d#> Turn_CullRange(0)
      _Turn_Culled_Bucket_Add_Entity(Turn_Bucket(Index).EntityID,Turn_Bucket(Index).Rate)
      _Turn_Bucket_Delete_Element(Index)
      DeleteIndex=1
   Endif
EndFunction DeleteIndex


Function _Update_Turn_UnCulling(Index)
   _Initialize_Turn_Bucket()
   Local DeleteIndex=0
   EntityID=Turn_Culled_Bucket(Index).EntityID
   If Not Object Exist(EntityID) Then ExitFunction
   d#=get_target_distance(EntityID,Camera Position X(),Camera Position Y(),Camera Position Z())
   `===NOTE: The following line is optional.===
   `if d#> Turn_CullRange(0) *3 Then Hide Object EntityID Else Show Object EntityID
   If d#<= Turn_CullRange(0)
      _Turn_Bucket_Add_Entity(Turn_Culled_Bucket(Index).EntityID,Turn_Culled_Bucket(Index).Rate)
      _Turn_Culled_Bucket_Delete_Element(Index)
      DeleteIndex=1
   Endif
EndFunction DeleteIndex


`======================================================================
`Turn Culled Bucket,
`======================================================================


`_Turn_Culled_Bucket_Find_Entity(EntityID as Integer):Return Integer
`Binary searches through a sorted array for the specified EntityID.
`The return integer EntityID is the index of the array element for which the EntityID was found.
`If there are multiples of the same EntityID within the array, any one of the indexes may be returned.
`If the EntityID is not found, a -1 is returned.

Function _Turn_Culled_Bucket_Find_Entity(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Top=Turn_Culled_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction -1
   If EntityID<Turn_Culled_Bucket(0).EntityID Then ExitFunction -1
   If EntityID=Turn_Culled_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=Turn_Culled_Bucket(Top).EntityID Then ExitFunction Top
   If EntityID>Turn_Culled_Bucket(Top).EntityID Then ExitFunction -1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Turn_Culled_Bucket(BSearch).EntityID Then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Turn_Culled_Bucket(BSearch).EntityID)-(EntityID<Turn_Culled_Bucket(BSearch).EntityID)))
   Next i
EndFunction -1

`_Turn_Culled_Bucket_Find_Entity_Place(EntityID as Integer):Return Integer
`This function is similar to the Turn_Culled_Bucket_Find_Entity() function in that it
`searches for a EntityID within a sorted array. However, if the EntityID is
`not found in this function, an index EntityID is returned where the search EntityID
`'fits' within the sorted array. For example: The array - 1,6,8,9 and the EntityID
`is 7, the return element will be 2 since 7 falls between elements 1 and 2 (6 & 9).
`If the EntityID is lower than any EntityID within the array, a 0 is returned.
`If the EntityID is larger than any EntityID within the array, Array Count()+1 is returned.

Function _Turn_Culled_Bucket_Find_Entity_Place(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Top=Turn_Culled_Bucket_Top(0)
   Half=(Top+1)/2
   If Top<0 Then ExitFunction 0
   If EntityID<=Turn_Culled_Bucket(0).EntityID Then ExitFunction 0
   If EntityID=>Turn_Culled_Bucket(Top).EntityID Then ExitFunction Top+1
   BSearch=Half
   For i = 0 to 16:`Note, 15 is 2 Bytes worth of searching, or 2^15 elements.
      If BSearch<1 then BSearch=1
      If BSearch>Top then BSearch=Top
      If EntityID=Turn_Culled_Bucket(BSearch).EntityID Then ExitFunction BSearch
      If EntityID>Turn_Culled_Bucket(BSearch-1).EntityID And EntityID<=Turn_Culled_Bucket(BSearch).EntityID then ExitFunction BSearch
      Half=(Half+1)/2
      If Half<1 then Half=1
      BSearch=BSearch+Half*(((EntityID=>Turn_Culled_Bucket(BSearch).EntityID)-(EntityID<Turn_Culled_Bucket(BSearch).EntityID)))
   Next i
   Top=Top+1
EndFunction Top




`_Turn_Culled_Bucket_Add_EntityID(EntityID As Integer):Return Integer
`Performs a binary search for an index location in which to insert a new array element
`for the specified EntityID in sort order of ascending EntityID's. The array element is added
`and the EntityID is recorded the new array element.
`The return value is the index (array element) where the new EntityID was placed.

Function _Turn_Culled_Bucket_Add_Entity(EntityID as DWord,Rate as Float)
   _Initialize_Turn_Bucket()
   Index=_Turn_Culled_Bucket_Find_Entity(EntityID)
   If Index<0
      Index=_Turn_Culled_Bucket_Find_Entity_Place(EntityID)
      _Turn_Culled_Bucket_Insert_Element(Index)
   EndIf
   Turn_Culled_Bucket(Index).EntityID=EntityID
   Turn_Culled_Bucket(Index).Rate=Rate
EndFunction Index

`_Turn_Culled_Bucket_Insert_Element(Index as Integer)
`Increases the array by adding in an element at the specified index.
`If the Index is larger than the array size, the new element is added at
`the end of the array. Otherwise, the new element is inserted the specified
`index.

Function _Turn_Culled_Bucket_Insert_Element(Index as Integer)
   _Initialize_Turn_Bucket()
   Turn_Culled_Bucket_Top(0)=Turn_Culled_Bucket_Top(0)+1
   If Turn_Culled_Bucket_Top(0)=>Array Count(Turn_Culled_Bucket())
      Array Insert At Bottom Turn_Culled_Bucket()
   EndIf
   If Index=>Turn_Culled_Bucket_Top(0) Then ExitFunction
   For i =Turn_Culled_Bucket_Top(0)-1 To Index Step -1
      Turn_Culled_Bucket(i+1)=Turn_Culled_Bucket(i)
   Next i
EndFunction

`_Remove_Entity_From_Turn_Culled_Bucket(EntityID as Integer)
`This function finds the EntityID within the bucket and
`deletes the entity's element from the Bucket array.

Function _Remove_Entity_From_Turn_Culled_Bucket(EntityID as Integer)
   _Initialize_Turn_Bucket()
   Index=_Turn_Culled_Bucket_Find_Entity(EntityID)
   If Index<0 Then ExitFunction
   _Turn_Culled_Bucket_Delete_Element(Index)
EndFunction

`_Turn_Culled_Bucket_Delete_Element(Index as Integer)
`This function will delete an array element at the specified Index.
`If the index is not valid, the function will fail without exiting the program.

Function _Turn_Culled_Bucket_Delete_Element(Index as Integer)
   _Initialize_Turn_Bucket()
   If Index<0 or Index>Turn_Culled_Bucket_Top(0) Then ExitFunction
   Turn_Culled_Bucket_Top(0)=Turn_Culled_Bucket_Top(0)-1
   For i = Index to Turn_Culled_Bucket_Top(0)
      Turn_Culled_Bucket(i)=Turn_Culled_Bucket(i+1)
   Next i
EndFunction




Function _Process_Turn_Culled_Bucket()
   _Initialize_Turn_Bucket()
   If Turn_Culling_Tracker(0)>Turn_Culled_Bucket_Top(0) Then Turn_Culling_Tracker(0)=0
   Turn_Max=Turn_Culling_Tracker(0)+(Turn_Culled_Bucket_Top(0)/5)+1
   If Turn_Max>Turn_Culled_Bucket_Top(0) Then Turn_Max=Turn_Culled_Bucket_Top(0)
   For i = Turn_Culling_Tracker(0) to Turn_Max
      If i>Turn_Culled_Bucket_Top(0) Then ExitFunction
      EntityID=Turn_Culled_Bucket(i).EntityID
      If EntityID>0
         DIF=_Main_Turn_Culled_Function(i)
         i=i-DIF
      EndIf
   Next i
   Turn_Culling_Tracker(0)=Turn_Max+1
EndFunction




Function _Main_Turn_Culled_Function(Index as Integer)
   _Initialize_Turn_Bucket()
   Local DeleteIndexFlag=0
   DIF=_Update_Turn_UnCulling(Index)
   If DIF Then ExitFunction 1
   `Add code here.
   `Add code here.
   `Add code here.
EndFunction DeleteIndexFlag
`NOTE: If using an ExitFunction, be sure to include DeleteIndexFlag as the
`      return variable (or use 0). The compiler will compile the project
`      even if you omit the return variable, but this will cause problems
`      during exectution.


`======================================================================
`End of Turn Bucket code
`======================================================================


`============================================================================================================================
`=Distance Functions=========================================================================================================
`============================================================================================================================

Function Initialize_Distance_Functions()
   `Defensive programming. Prevents the function from being called more than once.
   Dim intInitDistFuncs(0)
   If intInitDistFuncs(0) Then ExitFunction
   intInitDistFuncs(0) = 1:` Set the flag to 1 so the function does not get called again.

   `Declarations
   Global dwdDistanceVector as DWord
   Local n as Integer = 0 `Just a "null" variable to contain the required return result when creating a vector

   `Set the value of the vector variable to a free vector
   dwdDistanceVector = Find Free Vector()

   `Create the vector
   n = Make Vector3(dwdDistanceVector)

EndFunction

`Returns the distance between two objects.
Function Get_Object_Distance(dwdObjectID1 as Dword, dwdObjectID2 as DWord)

   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object IDs provided are valid.
   `If the Object IDs are not valid, simply exit the function and return the value 0.0
   If dwdObjectID1<1 or dwdObjectID2<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID1) Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID2) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID1) - Object Position X(dwdObjectID2)
   dy=Object Position Y(dwdObjectID1) - Object Position Y(dwdObjectID2)
   dz=Object Position Z(dwdObjectID1) - Object Position Z(dwdObjectID2)

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance

`Returns the distance between an object and target coordinates
Function Get_Target_Distance(dwdObjectID as Dword, fltTargetX as Float, fltTargetY as Float, fltTargetZ as Float)

   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object ID provided is valid.
   `If the Object ID is not valid, simply exit the function and return the value 0.0
   If dwdObjectID<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID) - fltTargetX
   dy=Object Position Y(dwdObjectID) - fltTargetY
   dz=Object Position Z(dwdObjectID) - fltTargetZ

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance

`Returns the distance between an object and a camera.
Function Get_Camera_Distance(dwdObjectID as Dword, dwdCameraID as DWord)

   `Ensure the distance functions have been initialized
   Initialize_Distance_Functions()

   `Declarations
   Local fltDistance as Float  = 0.0
   Local dx as Float = 0.0
   Local dy as Float = 0.0
   Local dz as Float = 0.0

   `Defensive programming. Ensure the Object ID and Camera ID provided are valid.
   `If the Object ID or Camera ID are not valid, simply exit the function and return the value 0.0
   If dwdObjectID<1 Then ExitFunction fltDistance
   If Not Object Exist(dwdObjectID) Then ExitFunction fltDistance
   If Not Camera Exist(dwdCameraID) Then ExitFunction fltDistance

   `Set distance coordinates
   dx=Object Position X(dwdObjectID) - Camera Position X(dwdCameraID)
   dy=Object Position Y(dwdObjectID) - Camera Position Y(dwdCameraID)
   dz=Object Position Z(dwdObjectID) - Camera Position Z(dwdCameraID)

   `Set Vector3
   Set Vector3 dwdDistanceVector, dx, dy, dz

   `Retrieve the distance.
   If bolSquared
      fltDistance = Squared Length Vector3(dwdDistanceVector)
   Else
      fltDistance = Length Vector3(dwdDistanceVector)
   EndIf

EndFunction fltDistance


`============================================================================================================================
`=TIMER BASED MOVEMENT FUNCTIONS=============================================================================================
`============================================================================================================================

`When calling the TimeFactor() function, pass the target virtual frame rate (FrameRate)
`to achieve (i.e. 60 for 60 FPS, or 30 for 30 FPS). A value of 0 defaults to 60 FPS.
`The return value is a percentage; multiply movement, turning, or other timer-based
`factor by the TimeFactor() return value.

`Example:  Move Object ObjectID, 1.0 * TimeFactor(60)
`will move an object 1 DBP unit every 1/60th of a second regardless of the actual FPS.
Function TimeFactor(dwdFrameRate as DWord)
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   Local fltMS as Float = 0.0 `HI-res Ticks (originally miliseconds)
   Local fltTF as Float = 0.0 `TimeFactor results
   `Defensive coding (set default framerates
   If dwdFrameRate=0 Then dwdFrameRate=60
   `Calculate hi-res ticks required to achieve the desired framerate.
   fltMS=15000000.0/dwdFrameRate
   `Calculate the ratio between the actual time-span of the last update to the target framerate in hi-res ticks
   fltTF=dwdTimeDiff(0)/fltMS
   `Defensive programming...
   `This caps the Virtual Framerate to 50% of the Actual Framerate to keep "jumping" from happening.
   `2 = 200%, which is twice as many hi-res ticks.
   `You can remark out or alter this line as needed.
   If fltTF>2.0 then fltTF=2.0
EndFunction fltTF

`Call the Update_TimeFactor() once each frame, ideally after the Sync command.
`Do not use this function if using the TimeFactorSync() function (in the same loop)
#CONSTANT Update_TimeFactor Update_TimeFactor()
Function Update_TimeFactor()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Defensive programming. Adjusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction

`Use this function to include a sync command while updating the TimeFactor values.
`Do not use this function if using the Update_TimeFactor() function (in the same loop)
#CONSTANT TimeFactor_Sync TimeFactor_Sync()
Function TimeFactor_Sync()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Call a screen update (Sync)
   Sync
   `Defensive programming. Adusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction

`============================================================================================================
`=NOTES======================================================================================================
`============================================================================================================
`
`Objects 1 through 6 are reserved for the paddle, ball, and arena walls.




Sync On:Sync Rate 0:Autocam Off
Color Backdrop 0
`Set Camera Range .05,50000
`Fog Distance 400,800
`Fog On
Disable Escapekey

`Replay Loop
Repeat

   _Initialize_Game()

   _Main_Loop()

   _CleanUp()

Until Replay$ ="n" or Escapekey()

End




Function _Initialize_Game()
  `Declare variables
  `Catch indicates if the ball is "in game" or not (attached to the paddle).
   Dim Catch(0) as Boolean
   Catch(0) = 1
   `Lives is how many lives the player has.
   Dim Lives(0) as DWord
   Lives(0) = 3 `Three lives is common.
   `Score - need to keep track of it.
   Dim Score(0) as DWord
   Score(0) = 0
   `Level - makes the bricks tougher.
   Dim Level(0) as DWord
   Level(0) = 1

   Global Replay$

   `Load Files

   `Perform other housekeeping

   `Position the camera
   Position Camera 0,0,0,-90

   `Make Paddle. Replace this with a Load Object command to load a paddle object.
   Make Object Box 1,6,3,3
      Color Object 1,RGB(0,0,255)
      Position Object 1,0,-47,0
   `Make the ball.
   Make_New_Ball() `Since this is the second object to be made, it should default to object 2.
   `Make the arena
   Make Object Box 3,100,3,3
      Color Object 3,RGB(0,0,255)
      Position Object 3,0,-50,0 `Bottom wall

   Make Object Box 4,100,3,3
      Color Object 4,RGB(0,0,255)
      Position Object 4,0,50,0  `Top wall

   Make Object Box 5,3,103,3
      Color Object 5,RGB(0,0,255)
      Position Object 5,-50,0,0 `Left wall

   Make Object Box 6,3,103,3
      Color Object 6,RGB(0,0,255)
      Position Object 6,50,0,0  `Right wall

   `Make the bricks.
   New_Level_Setup()

EndFunction

Function _Main_Loop()

   Repeat
       `Call main game code functions here

       Move_Paddle(1) `Move the player's paddle.

       `Check to see if the ball is "in play"
       If Catch(0) = 1
         Make_New_Ball() `The ball has not been released, so place the ball at the paddle.
         `Print some instructions to the user.
         Center Text Screen Width()*.5, Screen Height()*.5 + 10,"Press Space to Start"
         Center Text Screen Width()*.5, Screen Height()*.5 + 25,"Use Left & Right Keys to Move Paddle"
         `Check the space key to see if the player wants to release the ball.
         If SpaceKey() Then Catch(0) = 0 `Release the ball when the space key is pressed.
       Else
         Move_Ball() `The ball has been released, so move the ball.
         Check_Ball_Collision() `Handle the ball collision
       EndIf

       `Print some useful information.
       Set Cursor 0,0
       Print "Lives: ";Lives(0)
       Print "Score: ";Score(0)
       Print "Level: ";Level(0)
       fps$ = "FPS("+Str$(Screen FPS())+")"
       Text Screen Width()-Text Width(fps$),Screen Height()-Text Height(fps$),fps$

       `Sync
       TimeFactor_Sync

   Until EscapeKey() or Lives(0)<1

EndFunction

Function _Cleanup()
   `Perform any cleanup maintenance
   Repeat
       Center Text Screen Width()*.5,(Screen Height()*.5) + 15, "Game Over. Would you like to play again [y] or [n]?"
       Replay$=Lower$(Inkey$())
       Set Cursor 0,0
       Print "Lives: ";Lives(0)
       Print "Score: ";Score(0)
       Print "Level: ";Level(0)
       fps$ = "FPS("+Str$(Screen FPS())+")"
       Text Screen Width()-Text Width(fps$),Screen Height()-Text Height(fps$),fps$
       TimeFactor_Sync
   Until Replay$ ="y" or Replay$ = "n"

   `Cleanup Objects incase the player wants to replay.
   Delete Objects 1,1000
   Ball(0).ObjectID = 0
   Initialize_Bricks(1)

   `Put credits here


EndFunction




`============================================================================================================
`=MAKE BRICKS================================================================================================
`============================================================================================================

Type Brick
   ObjectID as DWord
   Hits as DWord
EndType

Function Initialize_Bricks(ResetFlag as Boolean)
   `Check to see if the Bricks have been initialized and that the function call in not to reset the level.
   Dim InitBricks(0)
   If InitBricks(0) > 0 And ResetFlag = 0 then ExitFunction
   `Set the initialized flag
   InitBricks(0)=1
   `If this function is being called to reset the bricks for a new level, then clear out the old level.
   If ResetFlag
      `Cycle through the array.
      `Get Array Size is safe if the array has not been dimensioned.
      For i = 0 to Array Count(Bricks())
         `Defensive code: Make sure the ObjectID is valid (i.e. greater than 0).
         If Bricks(i).ObjectID > 0
         `Defensive code: Check to see if the object exists before trying to delete it.
            If Object Exist(Bricks(i).ObjectID)
               `Delete the object
               Delete Object Bricks(i).ObjectID
            EndIf
         EndIf
      Next i
   EndIf

   `Declare the Bricks array.
   Dim Bricks(-1) as Brick
EndFunction


Function Make_Brick(XPosition as Float, YPosition as Float, Hits as DWord, Color as Dword)
   `Initialize the bricks library.
   Initialize_Bricks(0)
   `Add a new brick
   Array Insert At Bottom Bricks()
   `Get the index if the new Brick element.
   Index = Array Count(Bricks())
   `Find a free object and store it.
   Bricks(Index).ObjectID = Find_Free_Object()
   `Make a brick object
   Make Object Box Bricks(Index).ObjectID,6,3,3
   `Place the brick
   Position Object Bricks(Index).ObjectID, XPosition, YPosition, 0
   `Set the Hits value (how many hits it will take to destroy the brick)
   Bricks(Index).Hits = Hits
   `Color the brick
   Color Object Bricks(Index).ObjectID,Color
   Set Object Emissive Bricks(Index).ObjectID,Color
EndFunction

`============================================================================================================
`=NEW BRICKS SETUP===========================================================================================
`============================================================================================================

Function New_Level_Setup()
   `Cycle through Rows
   For row = 0 to 40 step 5
      `Cycle through columns.
      For col = -40 to 40 step 8
         `Make the brick. Color should be brownish.
         Make_Brick(col,row,Level(0),RGB(60,5,0))
      Next col
   Next row
EndFunction


`============================================================================================================
`=MOVE PADDLE================================================================================================
`============================================================================================================
`A constant is used for the paddle speed so TimeFactor() is included automatically. It looks a little cleaner.
`Adjust these values to your preference.
#Constant PaddleSpeed TimeFactor(60) * 1.0

Function Move_Paddle(ObjectID as DWord)
   `Defensive code. Make sure the ObjectID provided is valid and that the object exists.
   If ObjectID <1 Then ExitFunction
   If Not Object Exist(ObjectID) Then ExitFunction

   `Move The Paddle.
   Move Object Left ObjectID, (LeftKey()-RightKey()) * PaddleSpeed

   `Defensive code. Ensure the paddle has not left the arena.
   `Note: These values are based on the arena set-up for the demo game. Change them as needed.
   Left# = -46: Right# = 46
   If Object Position X(ObjectID) < Left#
      Position Object ObjectID,Left#,-47,0
   EndIf
   If Object Position X(ObjectID) > Right#
      Position Object ObjectID,Right#,-47,0
   EndIf
EndFunction



`============================================================================================================
`=MAKE NEW BALL==============================================================================================
`============================================================================================================

Function Make_New_Ball()
   `Check to see if the ball has already been made. If not, make a new one.
   Initialize_Ball()
   `Position the ball.
   Position Object Ball(0).ObjectID,Object Position X(1),-44,0
   `Set the ball's initial direction. Make sure it is not 0.
   Repeat
      Ball(0).MomentumX# = (Rnd(20.0)-10.0)*.1 `Create a range from -1.0 (left) to 1.0 (right)
   Until Ball(0).MomentumX# <> 0.0
   Ball(0).MomentumY# = 1.0 `(up)
EndFunction

Type Ball
   ObjectID as DWord
   MomentumX# as Float
   MomentumY# as Float
EndType

Function Initialize_Ball()
   `Declarations
   Dim Ball(0) as Ball
   `Check to see if the ball object has been defined. Yes, then do nothing.
   If Ball(0).ObjectID Then ExitFunction
   `Get a Free Object
   Ball(0).ObjectID = Find_Free_Object()
   `Make the ball.
   Make Object Sphere Ball(0).ObjectID,2.5
EndFunction



`============================================================================================================
`=MOVE BALL==================================================================================================
`============================================================================================================
`This requires the Make Ball functions. Collision is handled seperately.

`A constant is used for the ball speed so TimeFactor() is included automatically. It looks a little cleaner.
`Adjust these values to your preference.
#Constant BallSpeed TimeFactor(60) * 1.0

Function Move_Ball()
   `Make sure the ball and ball vector have been initialized.
   Initialize_Move_Ball()

   `Calculate the ball's direction and store it in a vector.
   Set Vector2 BallVector(0),Ball(0).MomentumX#,Ball(0).MomentumY#
   `Normalize the vector.
   Normalize Vector2 BallVector(0),BallVector(0)
   `Scale the Vector to the ball Speed.
   Scale Vector2 BallVector(0), BallVector(0), BallSpeed

   `Calculate the new position
   x#=Object Position X(Ball(0).ObjectID) + X Vector2(BallVector(0))
   y#=Object Position Y(Ball(0).ObjectID) + Y Vector2(BallVector(0))

   `Move the ball.
   Position Object Ball(0).ObjectID, x#,y#,0
EndFunction

Function Initialize_Move_Ball()
   `Declarations
   Dim BallVector(0) as DWord
   `If the Move_Ball has been initialized already, then exit the function.
   If BallVector(0) Then ExitFunction
   `Defensive programming. Make sure the ball exists.
   Initialize_Ball()
   `Set the Ball Vector
   BallVector(0) = 1
   `Create the vector
   nothing = Make Vector2(BallVector(0))
EndFunction




`============================================================================================================
`=BALL COLLISION=============================================================================================
`============================================================================================================

Function Check_Ball_Collision()
   `Defensive Code: Make sure the ball has been initialized.
   Initialize_Ball()
   `Get the ball's collision (if any)
   CollideObject = Object Collision(Ball(0).ObjectID,0)
   `Check to see if there is a collision. If not, we can exit the function
   If Not CollideObject Then ExitFunction

   `We have object collision. Check the upper walls (left, top, and right) first.
   If CollideObject = 4 `Top wall
      `Reflect the ball down.
      Ball(0).MomentumY#=-1
      ExitFunction
   EndIf
   If CollideObject = 5 `Left wall
      `Reflect the ball to the right.
      Ball(0).MomentumX#=Abs(Ball(0).MomentumX#)
      ExitFunction
   EndIf
   If CollideObject = 6 `Right wall
      `Reflect the ball to the left
      Ball(0).MomentumX#=-Abs(Ball(0).MomentumX#)
      ExitFunction
   EndIf

   `Check to see if the collision is with the bottom wall.
   If CollideObject = 3 `Bottom wall (lose life)
      `Place the ball back on the paddle.
      Catch(0)=1
      `Reduce Lives by 1 with some defensive programming to ensure Lives cannot go below 0.
      If Lives(0) > 0 Then Lives(0) = Lives(0) - 1
   EndIf

   `Check to see if the collision was the paddle.
   If CollideObject = 1
      `Check to make sure the paddle is below the ball - prevent the paddle from moving in after the ball has passed it.
      If Object Position Y(Ball(0).ObjectID) >  Object Position Y(1) + .5 `The .5 is a small buffer space.
         `Paddle hits the ball - Reflect the ball.
         Ball(0).MomentumY# = 1.0
         `The following line move the ball along the x-axis away from the center of the paddle.
         Ball(0).MomentumX# = (Object Position X(Ball(0).ObjectID) - Object Position X(1))*.5
         `Defensive code: Limit the angle.
         If Ball(0).MomentumX# < -1.2 Then Ball(0).MomentumX# = -1.2
         If Ball(0).MomentumX# > 1.2 Then Ball(0).MomentumX# = 1.2
      EndIf
      ExitFunction
   EndIf

   `Everything else has been checked - collision must be with a brick.
   `Defensive Code: Make sure the bricks have been initialized
   Initialize_Bricks(0)
   `Set a flag to determine if the brick was found
   FoundFlag = 0
   `Cycle through all the bricks. While this is not efficient, the number of bricks should be small enough not to make
   `a difference.
   For index = 0 to Array Count(Bricks())
      `Is the Brick the Collide Object?
      If Bricks(index).ObjectID = CollideObject
         `Yes! Set the Found flag to True and exit the loop.
         FoundFlag = 1
         Exit
      EndIf
   Next Index
   `Defensive code: In case the brick was not found. This should never happen.
   If Not FoundFlag Then ExitFunction

   `Bounce the ball.
   `Determine which wall of the brick the ball is on.
   `Determine the relative position between the brick and the ball.
   dx# = Object Position X(Ball(0).ObjectID) - Object Position X(Bricks(index).ObjectID)
   dy# = Object Position Y(Ball(0).ObjectID) - Object Position Y(Bricks(index).ObjectID)

   `Record the old momentum so we can double check later to ensure there was a "bounce"
   OldMomX# = Ball(0).MomentumX#

   SideFlag = 0 `Record if the ball hit the side wall.

   If dx#>4 `The ball is on the right wall.
      Ball(0).MomentumX# = Abs(Ball(0).MomentumX#)
      SideFlag = 1
   EndIf

   If dx#<-4 `The ball is on the left wall.
      Ball(0).MomentumX# = - Abs(Ball(0).MomentumX#)
      SideFlag = 1
   EndIf

   `Double check to see if there was a "bounce".
   If Ball(0).MomentumX# = OldMomX# Then SideFlag = 0 `The ball hit the same side of the brick as it was moving.

   If SideFlag = 0 `The ball has not hit the side of the brick.
      If dy#>0 `The ball is on the top wall.
         Ball(0).MomentumY# = 1.0
      EndIf

      If dy#<0 `The ball is on the bottom wall.
         Ball(0).MomentumY# = -1.0
      EndIf
   EndIf

   Move_Ball() `Move the ball away from the brick it just hit so it has a head-start.

   `Reduce the brick hits by one hit.
   Bricks(index).Hits = Bricks(Index).Hits - 1
   `Increase the score
   Score(0) = Score(0) + 1
   `Delete the brick if it has no hits left.
   If Bricks(index).Hits < 1
      Delete Object Bricks(index).ObjectID
      Array Delete Element Bricks(),index
   EndIf

   `Check to see if there are any bricks left.
   If Array Count(Bricks())<0
      `No bricks left. New Level
      Level(0) = Level(0) + 1
      `Catch the ball.
      Catch(0) = 1
      `Make a new level
      New_Level_Setup()
   EndIf

EndFunction




`============================================================================================================================
`=TIMER BASED MOVEMENT FUNCTIONS=============================================================================================
`============================================================================================================================

`When calling the TimeFactor() function, pass the target virtual frame rate (FrameRate)
`to achieve (i.e. 60 for 60 FPS, or 30 for 30 FPS). A value of 0 defaults to 60 FPS.
`The return value is a percentage; multiply movement, turning, or other timer-based
`factor by the TimeFactor() return value.

`Example:  Move Object ObjectID, 1.0 * TimeFactor(60)
`will move an object 1 DBP unit every 1/60th of a second regardless of the actual FPS.
Function TimeFactor(dwdFrameRate as DWord)
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   Local fltMS as Float = 0.0 `HI-res Ticks (originally miliseconds)
   Local fltTF as Float = 0.0 `TimeFactor results
   `Defensive coding (set default framerates
   If dwdFrameRate=0 Then dwdFrameRate=60
   `Calculate hi-res ticks required to achieve the desired framerate.
   fltMS=15000000.0/dwdFrameRate
   `Calculate the ratio between the actual time-span of the last update to the target framerate in hi-res ticks
   fltTF=dwdTimeDiff(0)/fltMS
   `Defensive programming...
   `This caps the Virtual Framerate to 50% of the Actual Framerate to keep "jumping" from happening.
   `2 = 200%, which is twice as many hi-res ticks.
   `You can remark out or alter this line as needed.
   If fltTF>2.0 then fltTF=2.0
EndFunction fltTF

`Call the Update_TimeFactor() once each frame, ideally after the Sync command.
`Do not use this function if using the TimeFactorSync() function (in the same loop)
#CONSTANT Update_TimeFactor Update_TimeFactor()
Function Update_TimeFactor()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Defensive programming. Adjusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction

`Use this function to include a sync command while updating the TimeFactor values.
`Do not use this function if using the Update_TimeFactor() function (in the same loop)
#CONSTANT TimeFactor_Sync TimeFactor_Sync()
Function TimeFactor_Sync()
   `Declarations
   Dim dwdTimeStamp(0) as DWord
   Dim dwdTimeDiff(0) as DWord
   `Call a screen update (Sync)
   Sync
   `Defensive programming. Adusts for the first time this function is called.
   If dwdTimeStamp(0)=0 Then dwdTimeStamp(0)=PerfTimer()-16
   `Calculate the Time Difference and set the new Time Stamp
   dwdTimeDiff(0)=PerfTimer()-dwdTimeStamp(0)
   dwdTimestamp(0)=PerfTimer()

Endfunction

`============================================================================================================================
`=MISCELLENIOUS FUNCTIONS====================================================================================================
`============================================================================================================================

Function Find_Free_Object()
   i = 1
   While Object Exist(i)
      Inc i
   EndWhile
EndFunction i

Function Find_Free_Object()
   i = 1
   While Object Exist(i)
      inc i
   EndWhile
EndFunction i

`Setup
disable escapekey
window = 1
gosub window
set text size 25
ink rgb(255,255,255),0
set text opaque
randomize timer()

gosub mainmenu

`variables for file reading
global file$ as string : file$ = "highscore.mon"
global hieasy# as float : hieasy# = 0
global himed# as float : himed# = 0
global hihard# as float : hihard# = 0

`reads hiscores
if file exist(file$)
   open to read 1, file$
   read float 1, e# : hieasy# = e#
   read float 1, m# : himed# = m#
   read float 1, h# : hihard# = h#
   close file 1
endif

`ready to start playing
gosub countdown
gosub pongout

end

`sets full screen according to if window = 1 or 0
window:
`cls
`input "set screen width", screenwidth
`sync
`input "set screen height", screenheight
`sync
`input "set display depth", screendepth
`sync
`if check display mode (screenheight,screenwidth,screendepth) = 1
`   set display mode screenwidth,screenheight,screendepth
set window on : set window position 100,100
`endif
`if check display mode (screenheight,screenwidth,screendepth) = 0
`gosub window
set display mode 1024,768,16
`endif

return

`the menu screen
`draws the text on screen
mainmenu:
set text size 80
center text 512,200,"Pongout!"
set text size 30
center text 512,320,"Select Difficulty"
ink 0,rgb(255,255,255)
center text 300,400,"Easy"
center text 500,400,"Medium"
center text 700,400,"Hard"
center text 400,450,"Mouse"
ink rgb(255,255,255),0
center text 600,450,"Keyboard"
set text size 25
ink rgb(255,255,255),0
center text 512,500,"Created by Monk"
control$ = "mouse"

`basic mouse pos checking
repeat
if mouseclick() = 1
   if mousey() > 400 and mousey() < 430
      if mousex() > 267 and mousex() < 333
         level$ = "easy"
      endif
      if mousex() > 450 and mousex() < 550
         level$ = "medium"
      endif
      if mousex() > 667 and mousex() < 733
         level$ = "hard"
      endif
   endif
   if mousey() > 450 and mousey() < 480
      if mousex() > 360 and mousex() < 440
         set text size 30
         ink 0,rgb(255,255,255)
         center text 400,450,"Mouse"
         ink rgb(255,255,255),0
         center text 600,450,"Keyboard"
         control$ = "mouse"
         set text size 25
      endif
      if mousex() > 535 and mousex() < 665
         set text size 30
         ink 0,rgb(255,255,255)
         center text 600,450,"Keyboard"
         ink rgb(255,255,255),0
         center text 400,450,"Mouse"
         control$ = "keyboard"
         set text size 25
      endif
   endif
endif
until level$ = "easy" or level$ = "medium" or level$ = "hard"
return

`lets player get ready
countdown:
cls
set text size 100
center text 512,200,"3"
wait 1000
center text 512,200,"2"
wait 1000
center text 512,200,"1"
wait 1000
center text 512,200,"Play!"
wait 100
set text size 25
return

`actual game
pongout:
`dont want to see the mouse so we hide it and pos ready fro start
Position mouse 212,389
hide mouse

`variables for the game
global pbx# as float : pbx# = 662.0
global pby# as float : pby# = 389.0
global bbx# as float : bbx# = 212.0
global bby# as float : bby# = 480.0
global pex# as float : pex# = 950.0
global pey# as float : pey# = 389.0
global pbky# as float : pbky# = 389.0
global bbkx# as float : bbkx# = 212.0
global points# as float : points# = 0
global lives as integer : lives = 5
global pespd as integer : pespd = 10

`sets all block to visible
dim blocks(48,1)
for block = 1 to 32
      blocks(block,1) = 1
next block

`draws objects
Makepball(662,389,8)
Makepebat(950,389,70,10)
Makepbat(400,389,70,10)
Makebball(212,480,10)
Makebbat(212,530,10,70)
gosub Makebblocks

`inital figures
bba# = rnd(40)+160
pba# = rnd(40)+70
spd# = 8


do

`pause
if inkey$() = "p"
repeat
until spacekey() = 1
endif

`keyboard controls
if control$ = "keyboard"
   if upkey() = 1 then pbky# = pbky# - 15
   if downkey() = 1 then pbky# = pbky# + 15
   if leftkey() = 1 then bbkx# = bbkx# - 15
   if rightkey() = 1 then bbkx# = bbkx# + 15
   if pbky# < 263 then pbky# = 263
   if pbky# > 514 then pbky# = 514
   if bbkx# < 87 then bbkx# = 87
   if bbkx# > 317 then bbkx# = 317
endif

`goes to manual checks
gosub Pongchecks
gosub breakoutchecks

`changes ball speed
pbx# = pbx# + (spd#*sin(pba#))
pby# = pby# + (spd#*cos(pba#))
spd# = spd# + 0.1
if spd# > 20 then spd# = 20

`block hit checking
if bby# < 339 and bby# >= 323 then brow = 4
if bby# < 323 and bby# >= 307 then brow = 3
if bby# < 307 and bby# >= 291 then brow = 2
if bby# < 291 and bby# >= 275 then brow = 1
if bbx# < 335 and bbx# >= 304 then bcol = 8
if bbx# < 304 and bbx# >= 273 then bcol = 7
if bbx# < 273 and bbx# >= 242 then bcol = 6
if bbx# < 242 and bbx# >= 211 then bcol = 5
if bbx# < 211 and bbx# >= 180 then bcol = 4
if bbx# < 180 and bbx# >= 149 then bcol = 3
if bbx# < 149 and bbx# >= 118 then bcol = 2
if bbx# < 118 and bbx# >= 87 then bcol = 1
if bby# > 339 or bby# < 276 then brow = 6

bblock = (brow-1)*8 + bcol
blocks(bblock,1) = 0

`if hit then block become invisible
for block = 1 to 32
      if blocks(block,1) = 1
         b = 1
      endif
next block
`if no blocks are left visible, next level
if b = 0 then blevel = 1 else b = 0

`breakout ball speed
bbx# = bbx# + (10*sin(bba#))
bby# = bby# + (10*cos(bba#))

`changes the wait speed depending on chosen level
gosub level

`clears screen
cls

`redraws objects
gosub background
Movebbat(212,530,10,70)
Movepbat(400,389,70,10)
gosub Movepebat
gosub blocks
Movebball(bbx#,bby#,10,bba#)
Movepball(pbx#,pby#,8,pba#)
gosub scored

`text
text 50,60, "Points scored: "+ str$(points#)+"  :  Lives left:  "+str$(lives)
text 0,0,"Highscore easy   "+str$(hieasy#)
text 0,20,"Highscore medium   " + str$(himed#)
text 0,40, "Highscore hard   "+str$(hihard#)

`general parameters
points# = points# + 2
if lives <= 0 then gosub endscreen
if escapekey() = 1 then gosub writefile

`moves mouse according to key presses
if control$ = "keyboard"
   position mouse bbkx#, pbky#
endif

loop


breakoutchecks:
`checks balls position against bats
mx = mousex()
if mx > 342 then mx = 342
if mx < 62 then mx = 62
if bby# > 515 and bby# < 530 and bhit = 0
   dx# = bbx# - mx
   if bbx# <= mx + 50
   if bbx# > mx - 50
      bba# = wrapvalue((180-bba#)-dx#)
      bhit = 1
   endif
   endif
endif

`if passed bat players loses a life
if bby# >= 536 then bdead = 1

`bounce off walls
if bby# < 239
   bba# = wrapvalue(180-bba#)
endif
if bbx# < 62 or bbx# > 342
   bba# = wrapvalue(360 - bba#)
endif

`resets hit value
if bby# < 505 and bhit = 1 then bhit = 0

`stops ball from going at silly angles
if bba# < 110.0 and bba# > 90.0 then bba# = bba# + 2
if bba# < 270.0 and bba# > 250.0 then bba# = bba# - 2
if bba# > 270.0 and bba# < 290.0 then bba# = bba# + 2
if bba# > 70.0 and bba# < 90.0 then bba# = bba# - 2
return


Pongchecks:
`checks if ball is near player bat
if pbx# < 415 and pbx# > (410 - spd#) and phit = 0
   dy# = pby# - mousey()
   if pby# < mousey() + 42 and pby# >= mousey()
      pba# = wrapvalue((360-pba#)-dy#)
      phit = 1
   endif
   if pby# > mousey() - 42 and pby# < mousey()
      pba# = wrapvalue((360-pba#)-dy#)
      phit = 1
   endif
endif

`checks if ball is near enemy bat
if pbx# > 935 and pbx# < 940 + spd# and pehit = 0
   dy# = pby# - pey#
   if pby# < pey#+42 and pby# >= pey#
      pba# = wrapvalue((360-pba#)+dy#)
   endif
   if pby# > pey# - 42 and pby# < pey#
      pba# = wrapvalue((360-pba#)+dy#)
      pehit = 1
   endif
   if pby# < pey# - 42 or pby# > pey# + 42
      pba# = pba#
      pehit  = 1
   endif
endif

`bounce off top and bottom
if pby# < 240 or pby# > 539
   pba# = wrapvalue(180-pba#)
endif

`increase scores if passed a bat
if pbx# < 375
   pescored = 1
endif
if pbx# > 975
   pscored = 1
endif

`resets hits
if pbx# > 420 and phit = 1 then phit = 0
if pbx# < 930 and pehit = 1 then pehit = 0

`stops ball going at silly angles
if pba# < 20.0 and pba# > 0.0 then pba# = pba# + 2
if pba# < 180.0 and pba# > 160.0 then pba# = pba# - 2
if pba# > 180.0 and pba# < 200.0 then pba# = pba# + 2
if pba# > 340.0 and pba# < 360.0 then pba# = pba# - 2
return


scored:
`resets pong if player scores
if pscored = 1
   spd# = 8
   pbx# = 662.0
   pby# = 389.0
   pba# = rnd(40)+70
   pscored = 0
   points = points + 100
   playerpscore = playerpscore + 1
endif
`resets pong if enemy scores
if pescored = 1
   spd# = 8
   pbx# = 662.0
   pby# = 389.0
   pba# = rnd(40)+70
   pescored = 0
   lives = lives - 1
   playerpescore = playerpescore + 1
endif
`resets breakout ball if ball passes bat
if bdead = 1
   bbx# = 212.0
   bby# = 480.0
   bba# = rnd(10)+170
   bdead = 0
   lives = lives - 1
   playerbdead = playerbdead + 1
endif
`redraws blocks if all blocks are invisible
if blevel = 1
   bbx# = 212.0
   bby# = 480.0
   bba# = rnd(10)+170
   blevel = 0
   points = points + 1000
   playerblevel = playerblevel + 1
   for block = 1 to 32
       blocks(block,1) = 1
   next block
endif
return


function Makebball(x,y,rad)
`draws breakout ball
Box x-rad,y-rad,x+rad,y+rad
endfunction


function Makebbat(x,y,height,width)
`draws breakout bat
Box x-(width/2),y-(height/2),x+(width/2),y+(height/2)
endfunction


Makebblocks:
`draws the breakout blocks
xtop = 88
ytop = 276
sizex = 30
sizey = 15
by = 1
bx = 1
for block = 1 to 32
   if block <= 8 then bx = block : ink rgb(255,0,0),0
   if block > 8 and block <= 16 then by = 2 : bx = block - 8 : ink rgb(255,255,0),0
   if block > 16 and block <= 24 then by = 3 : bx = block - 16 : ink rgb(0,255,0),0
   if block > 24 and block <= 32 then by = 4 : bx = block - 24 : ink rgb(0,255,255),0
   blocks(block,1) = 1
   box xtop+((bx-1)*sizex)+(bx-1),ytop+((by-1)*sizey)+(by-1),xtop+(bx-1)+(bx*sizex),ytop+(by-1)+(by*sizey)
next block
return


function Movebbat(x,y,height,width)
`redraws breakout bat at new position
mx = Mousex()
if mx > 317 then mx = 317
if mx < 87 then mx = 87
Box mx-(width/2),y-(height/2),mx+(width/2),y+(height/2)
endfunction


function Movebball(x,y,rad,ang)
`redraws the breakout ball at new position
Box x-rad,y-rad,x+rad,y+rad
endfunction


blocks:
`draws the breakout blocks
xtop = 88
ytop = 276
sizex = 30
sizey = 15
by = 1
bx = 1
for block = 1 to 32
   if block <= 8 then bx = block : ink rgb(255,0,0),0
   if block > 8 and block <= 16 then by = 2 : bx = block - 8 : ink rgb(255,255,0),0
   if block > 16 and block <= 24 then by = 3 : bx = block - 16 : ink rgb(0,255,0),0
   if block > 24 and block <= 32 then by = 4 : bx = block - 24 : ink rgb(0,255,255),0
   if blocks(block,1) = 1
      box xtop+((bx-1)*sizex)+(bx-1),ytop+((by-1)*sizey)+(by-1),xtop+(bx-1)+(bx*sizex),ytop+(by-1)+(by*sizey)
   endif
   `draws black if iinvisible
   if blocks(block,1) = 0
      ink 0,0
      box xtop+((bx-1)*sizex)+(bx-1),ytop+((by-1)*sizey)+(by-1),xtop+(bx-1)+(bx*sizex),ytop+(by-1)+(by*sizey)
   endif
next block
ink rgb(255,255,255),0
return


function Makepball(x,y,rad)
`Draw square for pong ball
Box x-rad,y-rad,x+rad,y+rad
endfunction


function Makepbat(x,y,height,width)
`Draw a box as the pong bat
Box x-(width/2),y-(height/2),x+(width/2),y+(height/2)
endfunction


function Makepebat(x,y,height,width)
`Draw a box as the pong enemy bat
Box x-(width/2),y-(height/2),x+(width/2),y+(height/2)
endfunction


function Movepbat(x,y,height,width)
`Should move the pong bat along the y-axis in relation with mousey
my = mousey()
if my > 514 then my = 514
if my < 263 then my = 263
Box x-(width/2),my-(height/2),x+(width/2),my+(height/2)
endfunction


Movepebat:
`Should move enemy bat towards ball position
if pbx# < 950
if pby# >= pey# then pey# = pey# + pespd
if pby# < pey# then pey# = pey# - pespd
endif
if pey# > 514 then pey# = 514
if pey# < 263 then pey# = 263
Box pex#-5,pey#-35,pex#+5,pey#+35
return


function Movepball(x,y,rad,ang)
`Draw square for pong ball
Box x-rad,y-rad,x+rad,y+rad
endfunction

background:
`draws the lines for the court lines
line 52,549,52,229
line 52,229,990,229
line 52,549,990,549
line 990,229,990,549
line 352,229,352,549
line 950,229,950,549
line 400,229,400,549
line 52,530,352,530
return

endscreen:
`game over hiscore screen
cls
set text size 50

p$ = str$(points#)
if len(p$) < 5
   repeat
   p$ = str$(0) + p$
   until len(p$) = 5
endif

`sets hiscores
if level$ = "easy"
   if points# > hieasy# then hieasy# = points#
   hiscore# = hieasy#
endif
if level$ = "medium"
   if points# > himed# then himed# = points#
   hiscore# = himed#
endif
if level$ = "hard"
   if points# > hihard# then hihard# = points#
   hiscore# = hihard#
endif

hs$ = str$(hiscore#)
if len(hs$) < 5
   repeat
   hs$ = str$(0) + hs$
   until len(hs$) = 5
endif

`draws screen
repeat
text 100,100,"Game over!!"
text 100,200,"Your Score: " + p$
text 100,300,"Highscore: " + hs$
text 100,400,"Play Again? Y/N"
until keystate(21) = 1 or keystate(49) = 1

set text size 25

if keystate(49) = 1 then gosub writefile
if keystate(21) = 1 then gosub mainmenu

end
return


writefile:
`adds zeros to score until 5 figures long
he$ = str$(hieasy#)
if len(he$) < 5
   repeat
   he$ = str$(0) + he$
   until len(he$) = 5
endif

hm$ = str$(himed#)
if len(hm$) < 5
   repeat
   hm$ = str$(0) + hm$
   until len(hm$) = 5
endif

hh$ = str$(hihard#)
if len(hh$) < 5
   repeat
   hh$ = str$(0) + hh$
   until len(hh$) = 5
endif

`deletes, makes open and writes a new hiscore file
delete file file$
open to write 1,file$
if level$ = "easy"
   write float 1, val(he$)
endif
if level$ = "medium"
   write float 1, val(he$)
   write float 1, val(hm$)
endif
if level$ = "hard"
   write float 1, val(he$)
   write float 1, val(hm$)
   write float 1, val(hh$)
endif
close file 1
end
return

level:
`sets wait value and ai speed dependin on level
if level$ = "easy"
   wait 40
   pespd = 8
endif

if level$ = "medium"
   wait 30
   pespd = 12
endif

if level$ = "hard"
   wait 20
   pespd = 15
endif

return

return `pongout

`   'Aargh - not another Pong Clone!' by Ric.

if check display mode(1024,768,32)=1 then set display mode 1024,768,32
hide mouse
sync on
sync rate 50
autocam off
hide light 0
color backdrop rgb(0,0,0)
set ambient light 80
make light 1
position light 1,100,100,20
set light range 1,100000
color light 1,rgb(255,220,180)

fog on
fog color 0
fog distance 1000

`create green texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 103,0,0,100,100

cls

`create purple texture
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 102,0,0,100,100

cls

`create blue texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100

`create star texture
for x=0 to 100
for y=0 to 100
d=rnd(20)
ink rgb(100+rnd(100),100+rnd(100),rnd(100)+100),0
if d=1 then dot x,y
next y
next x
get image 1,0,0,100,100

`create tile texture
cls
ink rgb(0,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20

set text font "sf automaton_mod"
set text size 25

`create starsphere
make object sphere 1000,-1000,50,50
texture object 1000,1
scale object texture 1000,5,5
xrotate object 1000,-90

`player paddle
make object sphere 1,20,20,20
scale object 1,100,400,100
ghost object on 1
texture object 1,102
set object emissive 1,rgb(200,200,200)
set object specular 1,rgb(250,250,250)
set object specular power 1,10
set object fog 1,0
set object collision on 1
set object collision to boxes 1


`reflection of player paddle
clone object 302,1 `top
scale object 302,100,400,100
fade object 302,90
clone object 303,1 `bottom
scale object 303,100,400,100
fade object 303,90

`computer paddle
make object sphere 2,20,20,20
scale object 2,100,400,100
ghost object on 2
texture object 2,103
set object emissive 2,rgb(200,200,200)
set object specular 2,rgb(250,250,250)
set object specular power 2,10
set object fog 2,0
set object collision on 2
set object collision to boxes 2

`reflection of computer paddle
clone object 304,2 `top
scale object 304,100,400,100
fade object 304,90
clone object 305,2 `bottom
scale object 305,100,400,100
fade object 305,90

`ball
make object sphere 3,20,40,40
texture object 3,101
set object specular 3,rgb(200,200,200)
set object specular power 3,15
set object emissive 3,rgb(150,150,100)
set object ambient 3,0
set object collision on 3
set object fog 3,0

`reflection of ball
clone object 300,3 `top reflection
fade object 300,50
clone object 301,3 `bottom reflection
fade object 301,50

`bottom wall
make object plain 4,500,800
xrotate object 4,90
set object collision on 4
texture object 4,2
scale object texture 4,5,5
set object transparency 4,1

`top wall
make object plain 5,500,800
xrotate object 5,90
set object collision on 5
texture object 5,2
scale object texture 5,5,5
set object transparency 5,1

`back wall
make object plain 6,500,100
texture object 6,101
scale object texture 6,2,10
set object texture 6,2,0
set object transparency 6,1
set object fog 6,0
ghost object on 6

`position walls
position object 4,0,-150,100
position object 5,0,150,100
position object 6,0,0,300

`restart point for new game (the goto command is not dead yet!)
newgame:

for object=300 to 305
hide object object
next object

`zoom in
paddlex#=0
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
position object 3,0,0,0


zrotate camera 0
camz#=-2000.0
position camera 0,0,0,camz#
while camz#<-500.0
inc camz#,5
position camera 0,0,camz#
sync
endwhile
position camera 0,0,0,-500

`set paddle positions

while paddlex#<180
inc paddlex#
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
sync
endwhile



do
text screen width()/2-100,200,"Gravity on? (y/n)"
if inkey$()="y" then gravity=1:exit
if inkey$()="n" then gravity=0:exit
sync
loop

text screen width()/2-70,240,"GET READY!"
sync
wait 600

for object=300 to 305
show object object
next object

`set initial variables
level=1
pscore=0
cscore=0
pv#=10 `player paddle velocity
bvx#=10 `ball velocity
if gravity=1
cv#=3.5 `computer paddle velocity
g#=0.5
else
cv#=2
g#=0
endif

`restart point for new serve or new level
restart:
randomize timer()
wait 800
py#=-10+rnd(20) `player's initial y position
cy#=-10+rnd(20)           `computer's initial y position
bx#=0           `ball x
by#=0           `ball y
bvy#=1.5+rnd(10)/10          `ball direction (in degrees:- horizontal=0)
bvx#=abs(bvx#)
`main loop

do

text 0,0,str$(screen fps())

`player input
remstart
if upkey()>0 and object collision (1,5)=0
   py#=py#+pv#
endif

if downkey()>0 and object collision (1,4)=0
   py#=py#-pv#
endif
remend


py#=py#-mousemovey()
if py#>110 then py#=110
if py#<-110 then py#=-110

`move player paddle
position object 1,-180,py#,100
position object 302,-180,-py#-300,100
position object 303,-180,-py#+300,100
`position object 401,-180,py#,100

`ball motion
bvy#=bvy#+g#
bx#=bx#+bvx#
by#=by#-bvy#

`collision with court
if by#>140
by#=by#-10
bvy#=bvy#*-1
endif

if by#<-140
by#=by#+10
bvy#=bvy#*-1
endif

`collision with player paddle
if object collision (3,0)=1
  bvx#=bvx#*-1 `reverse velocity
  bx#=-150 `prevent embedding
`measure offset between player paddle and ball and adjust direction
    po#=by#-py#
    bvy#=bvy#-po#*0.15
endif

`and same for computer paddle.....
if object collision (3,0)=2
  bvx#=bvx#*-1
  bx#=150
    co#=by#-cy#
    bvy#=bvy#-co#*0.15
endif

if bvy#>15.0 then bvy#=15.0
if bvy#<-15.0 then bvy#=-15.0

`new ball position
position object 3,bx#,by#,100
position object 300,bx#,-by#+300,100
position object 301,bx#,-by#-300,100

`computer paddle A.I.

`return to middle
if bvx#<0
  if cy#>2 then a#=-cv#
  if cy#<2 then a#=cv#
  if cy#<=2 and cy#>=-2 then a#=0
  cy#=cy#+a#
endif

`move towards ball
if bvx#>0
  if by#>cy# then a#=cv#
  if by#<cy# then a#=-cv#
  cy#=cy#+a#
endif

position object 2,180,cy#,100
position object 304,180,-cy#+300,100
position object 305,180,-cy#-300,100

`win or lose
if object position x(3) < -250
   cscore=cscore+1
   vb#=vb#*-1
   goto restart
endif

if object position x(3) > 250
  pscore = pscore +1
  goto restart
endif

`print score
text screen width()/2-20,screen height()/2-12,str$(pscore)+" : "+str$(cscore)

`goto next level, increase difficulty and reset scores
if pscore>2
   bv#=bv#+1
   pv#=pv#+0.3
   cv#=cv#+0.5
   level=level+1
   pscore=0
   cscore=0
   goto restart
endif

`display level
text screen width()/2-40,screen height()/2-100,"Level "+str$(level)


`game over text
if cscore>2
set text font "impact"
ink rgb(0,200,0),0
text screen width()/2-50,screen height()/2+200,"Game Over"
text screen width()/2-80,screen height()/2+250,"You reached level "+str$(level)
text screen width()/2-100,screen height()/2+280,"Press any key to restart"
sync
wait key
set text font "sf automaton_mod"
ink rgb(0,0,255),0
goto newgame
endif

if inkey$()="q" then goto restart

if level>3
  `scroll textures
  scroll object texture 1000,0,-0.014
  scroll object texture 4,0,0.08
  scroll object texture 5,0,0.08

  if clockwise=1 then roll camera right 0.1
  if camera angle z()>30 then clockwise=0:turn camera left 0.1
  if clockwise=0 then roll camera left 0.1
  if camera angle z()<-30 then clockwise=1:turn camera right 0.1

else

 `scroll textures
  scroll object texture 1000,0,-0.004
  scroll object texture 4,0,0.004
  scroll object texture 5,0,0.004

endif

sync
loop

REM Project: SpriteFun
REM Created: 12/25/2006 11:15:28 AM
REM
REM ***** Main Source File *****
REM
makesprite(1,255,127,63,32,32)
show sprite 1

hide mouse

do
sprite 1,mousex(),mousey(),1
show sprite 1
  if mouseclick()=1
    for splash=1 to 99
      makesprite(splash,rnd(255),rnd(255),rnd(255),rnd(48)+16,rnd(48)+16)
      show sprite splash
    next splash
  endif
loop

function makesprite(num as integer,R as integer, G as integer, B as integer, xsize as integer, ysize as integer)

   create bitmap 1,xsize+8,ysize+8
   ink rgb(255,255,255),0
   box 0,0,xsize+4,ysize+4
   get image 999,1,1,xsize,2,1
   sprite 999,0,0,999
   hide sprite 999
   box 1,1,xsize,ysize,rgb(R,G,B),rgb(R/3,G/3,B/3),rgb(R,G,B),rgb(R/3,G/3,B/3)
   set sprite alpha 999,222
   paste sprite 999,1,1
   set sprite alpha 999,182
   paste sprite 999,1,2
   set sprite alpha 999,142
   paste sprite 999,1,3
   set sprite alpha 999,102
   paste sprite 999,1,4
   set sprite alpha 999,62
   paste sprite 999,1,5
   ink rgb(22,22,22),0:line 1,1,xsize,1:line 1,1,1,ysize:line xsize,1,xsize,ysize:line 1,ysize,xsize,ysize:dot xsize,ysize
   dot 2,2:dot 2,ysize-1:dot xsize-1,2:dot xsize-1,ysize-1
   ink rgb(0,0,0),0:dot 1,1:dot 1,2:dot 2,1:dot xsize-1,1:dot xsize,1:dot xsize,2:dot 1,ysize-1:dot 1,ysize:dot 2,ysize:dot xsize-1,ysize:dot xsize,ysize:dot xsize,ysize-1
   get image num,1,1,xsize+1,ysize+1,1
   sprite num,rnd(screen width()-xsize),rnd(screen height()-ysize),num
   hide sprite 1
   delete bitmap 1

   set current bitmap 0

endfunction

//DBPro Coding Challenges "Not your average breakout game" entry
//27.11.2009
//by valle
#CONSTANT FIELDW 800
#CONSTANT FIELDH 600
#CONSTANT XTILES 6
#CONSTANT YTILES 4

`maximale Aulösung einstellen
load dll "user32.dll",1
SCREENW = call dll(1,"GetSystemMetrics",0)
SCREENH = call dll(1,"GetSystemMetrics",1)
delete dll 1

set display mode SCREENW, SCREENH, 32
sync on : sync rate 0 : sync
hide mouse

gosub FirstInit
gosub NewGame

FirstInit:
   type tVec
      x as float
      y as float
   endtype

   type tBall
      p as tVec
      v as tVec
      radius as integer
   endtype

   type tBlock
      p as tVec
      size as tVec
      layer as boolean
      on as boolean
      fade as float
      colour as dword
   endtype

   type tPaddle
      p as tVec
      oldX as integer
      v as integer
      vTimer as float
      size as tVec
   endtype

   type tGame
      round as integer
      state as integer :`0 = fade in ; 1 = shoot ball ; 2 = play ; 3 = fade out
      fadeIn as float
      fadeOut as float
      fieldPos as tVec
      blockSize as tVec
      frontLayer as boolean
      layerState as float
      tiles as integer
      layer1Blocks as integer
      layer2Blocks as integer
      allBlocks as integer
      score as integer
      scoreFlash as float
      timeScore as float
      showTimeScore as integer
      nextRoundTimer as float
      roundEnd as boolean
      gameEnd as boolean
      gameOverTime as float
      newHighScore as boolean
      newHighLevel as boolean
      highScore as integer
      highLevel as integer
   endtype

   dT as float
   pl as tPaddle
   ball as tBall
   game as tGame
   game.tiles = XTILES*YTILES
   dim block(game.tiles-1) as tBlock
   tempStr as string

   game.fieldPos.x = (SCREENW-FIELDW)/2
   game.fieldPos.y = (SCREENH-FIELDH)/2
   game.blockSize.x = ((FIELDW-200)/XTILES)-10
   game.blockSize.y = 20
   if file exist("breakout_score")=1
      open to read 1, "breakout_score"
      read long 1, game.highScore
      read long 1, game.highLevel
      close file 1
   endif
   ball.radius = 8
   pl.size.x = 90 : pl.size.y = 20
   pl.p.y = FIELDH-50
   index = 0
   for x = 0 to XTILES-1
      for y = 0 to YTILES-1
         block(index).p.x = 100+x*((FIELDW-200)/XTILES)
         block(index).p.y = 50+y*30
         block(index).size.x = game.blockSize.x
         block(index).size.y = game.blockSize.y
         inc index
      next y
   next x

   //BlockImage
   for y = 0 to game.blockSize.y
      ink rgb(255-y*3, 255-y*3, 255-y*3), 0
      line 0, y, game.blockSize.x, y
   next y
   remstart ink rgb(225, 225, 225), 0
   for x = 0 to 10
      line game.blockSize.x/2-10+x, game.blockSize.y, game.blockSize.x/2+x, -1
   next x remend

   get image 1, 0, 0, game.blockSize.x, game.blockSize.y, 1
   sprite 1, 0, 0, 1 : set sprite 1, 0, 1 : hide sprite 1
   //PaddleImage
   for y = 0 to pl.size.y
      ink rgb(255-y*3, 255-y*3, 255-y*3), 0
      line 0, y, pl.size.x, y
   next y
   get image 2, 0, 0, pl.size.x, pl.size.y, 1
   sprite 2, 0, 0, 2 : set sprite 2, 0, 1 : hide sprite 2
   //BallImage
   cls
   for x = 0 to ball.radius*2
      for y = 0 to ball.radius*2
         dist = sqrt((x-ball.radius)^2+(y-ball.radius)^2)
         if dist < ball.radius then dot x, y, rgb(255-dist*3, 255-dist*3, 255-dist*3)
      next y
   next x
   get image 3, 0, 0, ball.radius*2, ball.radius*2, 1
   sprite 3, 0, 0, 3 : set sprite 3, 0, 1 : hide sprite 3
   offset sprite 3, ball.radius, ball.radius
return

NewGame:
   game.round = 0
   game.score = 0
   game.gameEnd = 0
   gosub NewRound
   gosub main
return

NewRound:
   inc game.round
   game.state = 0
   game.fadeIn = 0
   pl.p.x = FIELDW/2-pl.size.x/2
   ball.p.x = FIELDW/2
   ball.p.y = FIELDH/2
   for t = 0 to game.tiles-1
      block(t).on = 1
      block(t).layer = rnd(1)
   next t
   game.frontLayer = 0
   game.layerState = 0.2
   game.timeScore = 4000
   game.roundEnd = 0
return

main:
   oldTime = timer()
   do

      dT = (timer()-oldTime)*0.001
      oldTime = timer()

      gosub Process
      gosub DrawGame

      sync
   loop
return

Process:
   select game.state
      case 0:
         inc game.fadeIn, dT
         game.layerState = 0.3-game.fadeIn*0.3
         if game.fadeIn >= 1 then inc game.state
         ball.p.x = pl.p.x+pl.size.x/2
         ball.p.y = pl.p.y-ball.radius
      endcase
      case 1:
         ball.p.x = pl.p.x+pl.size.x/2
         ball.p.y = pl.p.y-ball.radius
         if mouseclick()=1
            ball.v.y = -300-game.round*100
            ball.v.x = -75+rnd(1)*150
            inc game.state
         endif
      endcase
      case 2:
         inc ball.p.x, ball.v.x*dT
         inc ball.p.y, ball.v.y*dT
         //Ballkollision
         if ball.v.y < 0
            if ball.p.y-ball.radius < 0
               ball.p.y = ball.radius : ball.v.y = abs(ball.v.y)
            endif
            for t = 0 to game.tiles-1
               if block(t).on and block(t).layer = game.frontLayer
                  if ball.p.x+ball.radius > block(t).p.x and ball.p.x-ball.radius < block(t).p.x+block(t).size.x
                     if ball.p.y-ball.radius < block(t).p.y+block(t).size.y
                        if ball.p.y-ball.radius > block(t).p.y+block(t).size.y-20
                           ball.p.y = block(t).p.y+block(t).size.y+ball.radius
                           inc ball.v.x, -20+rnd(40)
                           ball.v.y = abs(ball.v.y)
                           block(t).on = 0 : block(t).fade = 1.0
                           inc game.score, 100 : game.scoreFlash = 1.0
                        endif
                     endif
                  endif
               endif
            next t
         endif
         if ball.v.y > 0
            if ball.p.y+ball.radius > FIELDH
               game.state = 4
               game.gameOverTime = 0
               //gosub NewGame
            endif
            for t = 0 to game.tiles-1
               if block(t).on and block(t).layer = game.frontLayer
                  if ball.p.x+ball.radius > block(t).p.x and ball.p.x-ball.radius < block(t).p.x+block(t).size.x
                     if ball.p.y+ball.radius > block(t).p.y
                        if ball.p.y+ball.radius < block(t).p.y+20
                           ball.p.y = block(t).p.y-ball.radius
                           inc ball.v.x, -20+rnd(40)
                           ball.v.y = -abs(ball.v.y)
                           block(t).on = 0 : block(t).fade = 1.0
                           inc game.score, 100 : game.scoreFlash = 1.0
                        endif
                     endif
                  endif
               endif
            next t
         endif
         if ball.v.x < 0
            if ball.p.x-ball.radius < 0
               ball.p.x = ball.radius : ball.v.x = abs(ball.v.x)
            endif
            for t = 0 to game.tiles-1
               if block(t).on and block(t).layer = game.frontLayer
                  if ball.p.y+ball.radius > block(t).p.y and ball.p.y-ball.radius < block(t).p.y+block(t).size.y
                     if ball.p.x-ball.radius < block(t).p.x+block(t).size.x
                        if ball.p.x-ball.radius > block(t).p.x+block(t).size.x-20
                           ball.p.x = block(t).p.x+block(t).size.x+ball.radius
                           inc ball.v.y, -20+rnd(40)
                           ball.v.x = abs(ball.v.x)
                           block(t).on = 0 : block(t).fade = 1.0
                           inc game.score, 100 : game.scoreFlash = 1.0
                        endif
                     endif
                  endif
               endif
            next t
         endif
         if ball.v.x > 0
            if ball.p.x+ball.radius > FIELDW
               ball.p.x = FIELDW-ball.radius : ball.v.x = -abs(ball.v.x)
            endif
            for t = 0 to game.tiles-1
               if block(t).on and block(t).layer = game.frontLayer
                  if ball.p.y+ball.radius > block(t).p.y and ball.p.y-ball.radius < block(t).p.y+block(t).size.y
                     if ball.p.x+ball.radius > block(t).p.x
                        if ball.p.x+ball.radius < block(t).p.x+20
                           ball.p.x = block(t).p.x-ball.radius
                           inc ball.v.y, -20+rnd(40)
                           ball.v.x = -abs(ball.v.x)
                           block(t).on = 0 : block(t).fade = 1.0
                           inc game.score, 100 : game.scoreFlash = 1.0
                        endif
                     endif
                  endif
               endif
            next t
         endif

         //timeScore
         dec game.timeScore, dT*50
         if game.timeScore < 0 then game.timeScore = 0

         //wie viele Blocks insd noch übrig
         game.allBlocks = 0
         game.layer1Blocks = 0
         game.layer2Blocks = 0
         for t = 0 to game.tiles-1
            if block(t).on
               inc game.allBlocks
               if block(t).layer = 0
                  inc game.layer1Blocks
               else
                  inc game.layer2Blocks
               endif
            endif
         next t

         if (game.frontLayer = 0 and game.layer1blocks = 0) or (game.frontLayer = 1 and game.layer2blocks = 0)
            game.frontLayer = 1-game.frontLayer
         endif

         //Nächste Runde
         if game.allBlocks <= 0
            //if game.timeScore > 0
               //inc game.score, game.timeScore
               //game.scoreFlash = 1.0
            //endif
            //gosub NewRound
            inc game.state
            game.nextRoundTimer = 0
         endif


         //Ballkollision mit Spieler
         if ball.v.y > 0
            if ball.p.x+ball.radius > pl.p.x and ball.p.x -ball.radius < pl.p.x+pl.size.x
               if ball.p.y+ball.radius > pl.p.y and ball.p.y+ball.radius < pl.p.y+20
                  ball.v.y = -abs(ball.v.y)
                  inc ball.v.x, (ball.p.x-(pl.p.x+pl.size.x/2))*5+pl.v*5
                  if game.frontLayer = 0
                     if game.layer2Blocks > 0 then game.frontLayer = 1
                  else
                     if game.layer1Blocks > 0 then game.frontLayer = 0
                  endif
               endif
            endif
         endif
      endcase

      case 3:
         if game.roundEnd = 0
            //Nächste Runde
            if game.timeScore > 0
               inc game.score, game.timeScore
               game.scoreFlash = 1.0
            endif
            game.showTimeScore = game.timeScore
            game.roundEnd = 1
         endif
         inc game.nextRoundTimer, dT
         if game.nextRoundTimer >= 1
            gosub NewRound
         endif
      endcase

      case 4:
         inc game.gameOverTime, dT*0.5
         if game.gameOverTime > 1 then game.gameOverTime = 1
         if game.gameEnd = 0
            //GameOver
            for t = 0 to game.tiles-1
               if block(t).on
                  block(t).on = 0
                  block(t).fade = (block(t).layer = game.frontLayer)*0.5+rnd(50)*0.01
               endif
            next t
            if game.score > game.highScore
               game.highScore = game.score
               game.newHighScore = 1
            else
               game.newHighScore = 0
            endif
            if game.round > game.highLevel
               game.highLevel = game.round
               game.newHighLevel = 1
            else
               game.newHighLevel = 0
            endif
            if game.newHighScore = 1 or game.newHighLevel = 1
               if file exist("breakout_score")=1
                  open to read 1, "breakout_score"
                  read long 1, old_hs : read long 1, old_hl
                  close file 1
                  delete file "breakout_score"
               else
                  old_hs = 0 : old_hl = 0
               endif

               open to write 1, "breakout_score"
               if game.newHighScore = 1
                  write long 1, game.highScore
               else
                  write long 1, old_hs
               endif
               if game.newHighLevel = 1
                  write long 1, game.highLevel
               else
                  write long 1, old_hl
               endif
               close file 1
            endif
            game.gameEnd = 1
         endif
         if mouseclick() then gosub NewGame
      endcase

   endselect

   //Tote Blocks ausfaden
   if game.state = 4
      For t = 0 to game.tiles-1
         if block(t).on = 0
            dec block(t).fade, dT
         endif
      next t
   else
      For t = 0 to game.tiles-1
         if block(t).on = 0
            dec block(t).fade, dT*4
         endif
      next t
   endif

   //Spieler kontrollieren
   pl.p.x = mousex()-game.fieldPos.x-pl.size.x/2
   if pl.p.x < 0 then pl.p.x = 0
   if pl.p.x+pl.size.x > FIELDW then pl.p.x = FIELDW-pl.size.x
   inc pl.vTimer, dT
   if pl.vTimer >= 0.04
      pl.v = int(pl.p.x)-pl.oldX
      pl.oldX = int(pl.p.x)
      pl.vTimer = 0
   endif

   //Scoreflash
   dec game.scoreFlash, dt
   if game.scoreFlash < 0 then game.scoreFlash = 0

   //Layer wechseln
   if game.frontLayer = 1 and game.state <> 0
      inc game.layerState, dT*2
      if game.layerState > 1 then game.layerState = 1
   else
      dec game.layerState, dT*2
      if game.layerState < 0 then game.layerState = 0
   endif
return

DrawGame:
   //Field
   cls
   ink 0xffffff, 0
   box game.fieldPos.x-2, game.fieldPos.y-2, game.fieldPos.x+FIELDW+2, game.fieldPos.y+FIELDH+2
   ink 0, 0
   box game.fieldPos.x, game.fieldPos.y, game.fieldPos.x+FIELDW, game.fieldPos.y+FIELDH

   if game.state <> 4
      //Player
      paste sprite 2, game.fieldPos.x+pl.p.x, game.fieldPos.y+pl.p.y
   endif
   //Blocks
   for t = 0 to game.tiles-1
      if block(t).on or block(t).fade > 0
         if block(t).layer = 0
            colour = interpolate_color(rgb(200, 200, 200), rgb(40, 40, 40), game.layerState, 2)
         else
            colour = interpolate_color(rgb(40, 40, 40), rgb(200, 200, 200), game.layerState, 2)
         endif
         if block(t).on = 0
            colour = interpolate_color(0, rgb(255, 255, 255), block(t).fade, 2)
            py = 3-block(t).fade*7
         else
            py = 0
         endif
         set sprite diffuse 1, rgbr(colour), rgbg(colour), rgbb(colour)
         paste sprite 1, game.fieldPos.x+block(t).p.x, game.fieldPos.y+block(t).p.y-py
      endif
   next t
   if game.state <> 4
      //Ball
      paste sprite 3, game.fieldPos.x+ball.p.x, game.fieldPos.y+ball.p.y
   endif

   if game.state <> 4
      ink 0xffaaaaaa, 0
      text game.fieldPos.x+2, game.fieldPos.y+2, "level "+str$(game.round)
      colour = interpolate_color(0xffffffff, 0xff00ff00, game.scoreFlash, 3)
      ink colour, 0
      text game.fieldPos.x+2+game.scoreFlash*4, game.fieldPos.y+17, str$(game.score)
      if game.timeScore > 0
         ink 0xffffffff, 0
         text game.fieldPos.x+2, game.fieldPos.y+32, "+"+str$(int(game.timeScore))
      endif
      if game.highScore > 0
         tempStr = "hs "+str$(game.highScore)
         text game.fieldPos.x+FIELDW-text width(tempStr)-2, game.fieldPos.y+2, tempStr
         tempStr = "bl "+str$(game.highLevel)
         text game.fieldPos.x+FIELDW-text width(tempStr)-2, game.fieldPos.y+17, tempStr
      endif
   else
      ink 0xffdddddd, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-70*game.gameOverTime, "game over"
      if game.newHighScore
         ink 0xff00ff00, 0
         center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-45*game.gameOverTime, "new highscore!"
      endif
      if game.newHighLevel
         ink 0xffff0000, 0
         center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-30*game.gameOverTime, "new best level!"
      endif
      ink 0xffaaaaaa, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-15*game.gameOverTime, "level "+space$(len(str$(game.round)))
      ink 0xffff0000, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-15*game.gameOverTime, "      "+str$(game.round)
      ink 0xffaaaaaa, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2, "score "+space$(len(str$(game.score)))
      ink 0xff00ff00, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2, "      "+str$(game.score)
      ink 0xffdddddd, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2+25*game.gameOverTime, "click to replay"
   endif

   if game.state = 3
      colour = interpolate_color(0xff888888, 0xffffffff, game.nextRoundTimer, 3)
      ink colour, 0
      center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2-game.nextRoundTimer*20, "good!"
      if game.showTimeScore > 0
         ink 0xff00ff00, 0
         center text game.fieldPos.x+FIELDW/2, game.fieldPos.y+FIELDH/2+15-game.nextRoundTimer*20, "+"+str$(game.showTimeScore)
      endif
   endif
return

function interpolate_color(color1 as dword, color2 as dword, prog as float, mode)
   color3 as dword
   `--
   r1 = rgbr(color1) : g1 = rgbg(color1) : b1 = rgbb(color1)
   r2 = rgbr(color2) : g2 = rgbg(color2) : b2 = rgbb(color2)
   r = interpolate(r1, r2, prog, mode)
   g = interpolate(g1, g2, prog, mode)
   b = interpolate(b1, b2, prog, mode)
   color3 = rgb(r, g, b)
endfunction color3

function interpolate(num1 as float, num2 as float, progress as float, mode)
   local res as float
   local true_progress as float
   `--
   select mode
      case 0 : true_progress = progress                     : endcase :`linear
      case 1 : true_progress = sin(-90+progress*90)+1       : endcase :`Anfang langsam
      case 2 : true_progress = sin(progress*90)             : endcase :`Ende langsam
      case 3 : true_progress = sin(-90+progress*180)/2+0.5  : endcase :`Anfang und Ende langsam
   endselect
   res = num1+(num2-num1)*true_progress
endfunction res