Sorry your browser is not supported!

remstart
Controls:
Press the 2 button while the race is on to change camera view
Enter bid amount using the number keys
Enter horse number using the number keys
remend
sync on
sync rate 60
set display mode 1024,768,16
autocam off
hide mouse
randomize timer()

set global collision on
global speed# = 10.0
global size = 200
global money = 500
global bid = 0
global amount = 0
global winner

intro()
textures()
media()
camera()
bets()

do
   winner = check_winner()
   if winner > 0 then post_winner(winner)
   race()
   camera_change()
   sync
loop


function post_winner(winner)
center text screen width()/2,screen height()/2,"The WINNER is horse "+str$(winner)
winnings = money+5*amount
 center text screen width()/2,screen height()/2-100,"You could WIN!!! "+str$(winnings)
sync
check()
endfunction

function check_winner()
hitnum = object collision(100,0)
endfunction hitnum

function media()
`make horses
for h = 1 to 5
make object box h,3,3,3
next h
`make wall object
make object box 100,60,5,5
position object 100,20,0,200
ghost object on 100
`make matrix
make matrix 1,50,size,10,10
prepare matrix texture 1,1,1,1
position matrix 1,0,-1,0
`positioning horses
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
endfunction

function camera_change()
`different camera position
if keystate(3)
position camera 0,30,10,140
`point camera 0,0,-10,-100
point camera 0,object position x(3),object position y(3),object position z(3)
else
position camera 0,170,50,100
point camera 0,-100,0,100
endif
endfunction

function camera()
`camera position
position camera 0,170,50,100
point camera 0,-100,0,100
endfunction

function race()
`set info box
box 0,0,1024,100,rgb(125,120,250),rgb(15,220,50),rgb(212,20,50),rgb(75,70,80)
set cursor 450,10
print "Current money: $",money,
set cursor 450,25
print "Betting horse: ",bid,
`store values
ran1# = rnd(12)/speed#
ran2# = rnd(12)/speed#
ran3# = rnd(12)/speed#
ran4# = rnd(12)/speed#
ran5# = rnd(12)/speed#
`move horses
move object 1,ran1#
move object 2,ran2#
move object 3,ran3#
move object 4,ran4#
move object 5,ran5#
endfunction

function textures()
`makes textures for game
for x = 1 to 300
for y = 1 to 300
color = rgb(rnd(50),rnd(200),rnd(169))
dot x,y,color
next x
next y
get image 1,0,0,300,300
endfunction

function intro()
`Give introduction
set text font "Arial"
ink rgb(255,0,0),0
set text size 27
sync
center text 512,300,"Horbox Racing"
ink rgb(0,192,23),0
set text size 17
center text 512,330,"Place your bets, watch your horses and hopefully"
center text 512,360,"win some more money! Bid carfully though or you might"
center text 512,390,"end up broke!"
ink rgb(24,24,255),0
center text 768,690,"Bronze edition Created by Benjamin"
sync
wait key
cls
endfunction

function bets()
`place your bets!
`reset every all the hores
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
`reset the camera position
position camera 0,170,50,100
point camera 0,-100,0,100
`on with the game!!
cls
sync
`sets the text colour and size
ink rgb(255,255,255),0
set text size 20
set text to bold
`makes the two boxes that will hold my text positionins them and rotates them
make object box 200,0,0.3,2
make object box 210,0,0.3,2
make object box 220,0,0.3,2
`rotate objects
for i = 200 to 220 step 10
xrotate object i,0
zrotate object i,0
next i
`positions all the objects
position object 200,camera position x(0)-5,camera position y(0)-0,camera position z(0)
position object 210,camera position x(0)-5,camera position y(0)-0.8,camera position z(0)
`position object 220,camera position x(0)-5,camera position y(0)+1,camera position z(0)
`get all the text into images for our objects
ink rgb(255,255,255),0
check$ = "Set bid amount:"
info$ = "Choose horse 1-5:"
text 0,0,check$
get image 2,0,0,text width(check$),text height(check$),1
texture object 200,2
`next image
cls
ink rgb(255,255,255),0
sync
text 0,0,info$
get image 3,0,0,text width(info$),text height(info$),2
texture object 210,3
`Another text box!
cls
ink rgb(255,255,255),0
sync
set cursor 0,0
`get image 4,0,0,text width(),text height(),3
`texture object 220,4
`sets object lights down
set object light 200,0
set object light 210,0
set object light 220,0
`get amount
money:
set cursor 512,300
input amount
if amount > money then gosub money
money = money-amount
bid:
set cursor 512,390
input bid
if bid > 5 then gosub bid
`refresh screen and sets text colours back to normal
ink rgb(255,255,255),0
`deletes objects
for i = 200 to 220 step 10
delete object i
next i
`bye bye
endfunction

function winning()
`shows you have won
center text 512,384,"YOU WIN MONEY!!!"
money = money+5*amount
sync
wait key
bets()
endfunction

function losing()
`shows that you have lost
center text 512,384,"YOU LOSE MONEY!!!"
money = money
if money = 0 then exit_()
sync
wait key
bets()
endfunction

function check()
`check to see if you have won
wait key
ink rgb(255,255,255,),0
cls
if bid = winner
winning()
else
if bid <> winner
losing()
endif
endif
endfunction

function exit_()
cls
ink rgb(255,255,255,),0
center text 512,384,"Sorry kid your out of Mula!!"
sync
wait key
end
endfunction

Rem Project: PriDe
Rem Created: 3/26/2006 10:27:53 AM

Rem ***** Main Source File *****


`Gambling game called PRIDE


Game:


Game_SetUp:
Set Display Mode 800,600,32
CLS
Print "Welcome to PRIDE"
Print
Print "Pride is a thinking gambling game."
Print "The object is to outwit your opponent on several levels."
Print
Print "First, is the Player Selection: Choose either the"
Print "Alpha Player (Red), or the Numeric Player (White)"
Print "(Note: there is no advantage to either player)"
Print "[1] Alpha (Red)"
Print "[2] Numeric (White)"
Global Player
Global Player$
Player$="Numeric (White)"
Do
   Input "Select: ",Player
   If Player = 1
      Player$="Alpha (Red)"
      Exit
   Endif
   If Player = 2 Then exit
Loop

CLS
Print
Print "Next, you will see the game board."
Print "Like this:"
Print "   1  2"
Print "A [ ][ ]"
Print "B [ ][ ]"
Print
Print "The Game:"
Print "Dealing: Each section will have a red or white number from 1 to 5 in it."
Print
Print "Betting: Each player reviews the board and bets to Win or Lose."
Print "         You can bet 1 minimum to 5 maximum. This will not be the whole bet amount."
Print "         Bets are kept secret until the Payout phase."
Print
Print "Select Row/Column: The Alpha Player selects either row A or B."
Print "                   The Numeric Player selects either column 1 or 2."
Print
Print "Playing: Both player's reveal their selections simultaniously."
Print "         The color/number selected is value in the row and column selected by"
Print "         the players."
Print
Print "Scoring: If the selected value is Red, the Alpha player 'wins'. Numeric 'loses'."
Print "         If the selected value is White, the Numeric player 'wins'. Alpha 'loses'."
Print "         Each initial bet amount is multiplied by the selected value and the results"
Print "         are added together. This amount is deducted from each player's funds and"
Print "         added to to the pot."
Print
Print "Payout: If no player bets correctly (to win or lose), the total amount remains in"
Print "        the 'pot'. If one player bet correctly, that player wins the total pot."
Print "        If both players bet correctly, the total amount remains in the 'pot'."
Print
Print "Press any key to continue"
Wait Key
Cls
Print "Strategies to consider:"
Print
Print "Your bet is 50% controlled by you and 50% controlled by your opponent. Consider your"
Print "bet carefully. If you think you have a good chance to win, you will probably want to"
Print "force the highest bet you can. Otherwise, you may want to limit the bet as much as"
Print "possible. The dilemma comes when it appears you have a 50% chance of winning."
Print
Print "You can try to trick your opponent. One option may look like a sure win, but it may"
Print "also have a lower bet multiplier. Consider the possibility of going against the sure"
Print "bet in order to get the higher payout. Of course, your opponent might consider this"
Print "as well."
Print
Print "If you have a 50-50 chance of winning a hand, consider the payout strategies. Which"
Print "choice you make will have the most potential and the least risk. Consider what your"
Print "opponent might think is a great strategy as well. And then throw in the possibility"
Print "that your opponent is taking what you are thinking into consideration as well."
Print
Print "Press any key to continue."

Wait Key

Dim board(3)
Global Pot

Global Funds1
Funds1=500
Global Funds2
Funds2=500

Global Bet1
Global BetType1
Global Bet2
Global BetType2

Do
   `Deal phase
   Deal

   `Bet Phase
   Bet2=Rnd(4)+1
   BetType2=Rnd(1)+1
   Set Cursor 0,110
   Ink Rgb(200,200,255),0
   Do
      Input "Bet to [1]Win or [2]Lose? :",BetType1
      If BetType1=1 or BetType1=2 then Exit
   Loop
   Do
      Input "Amount to bet (1-5)? :",Bet1
      If Bet1=>1 and Bet1<=5 then Exit
   Loop

   `Select Phase
   If Player=1
      Do
         Input "Select Row ([1]Row A or [2]Row B): ",Row
         If Row = 1 or Row=2 Then exit
      Loop
      Col=rnd(1)+1
      ABet=Bet1:AType=BetType1
      NBet=Bet2:NType=BetType2
   Else
      Do
         Input "Select Column ([1]Col 1 or [2]Col 2): ",Col
         If Col = 1 or Col=2 Then exit
      Loop
      Row=rnd(1)+1
      NBet=Bet1:NType=BetType1
      ABet=Bet2:AType=BetType2
   Endif

   `Play Phase
   Print "Bets and selections are made. Press any key to continue."
   Wait Key
   Print
   Print "Alpha Player bet ";ABet;" to ";
   If AType=1 Then Print "Win." Else Print "Lose."
   Print "Alpha Player selected Row ";
   If Row=1 Then Print "A." Else Print "B."

   Print
   Print "Numeric Player bet ";NBet;" to ";
   If NType=1 Then Print "Win." Else Print "Lose."
   Print "Numeric Player selected Col ";Col
   Print
   If row=1 then s=col-1 else s=col+2
   Print "The selected Value is ";Abs(Board(s));"-";
   If Board(s)>0
      Print "White."
   Else
      Print "Red."
   Endif
   totalbet=(Abs(Board(s))*Bet1+Abs(Board(s))*Bet2)*2
   Print "Total Bet = ";totalbet;". Pot = ";pot+totalbet*2;"."
   Print "Press any key to continue."
   Wait Key

   `Scoring phase
   Funds1=Funds1-totalbet
   Funds2=Funds2-totalbet
   pot=pot+totalbet*2
   win1=0
   win2=0
   `Scoring if player=1
   If Board(s)<0
      If AType=1 Then Win1=1
      If NType=2 then Win2=1
   Endif
   If Board(s)>0
      If AType=2 Then Win1=1
      If NType=1 then Win2=1
   Endif
   `Flip win values if Player=2
   If Player=2
      Win1=(Win1=0)
      Win2=(Win2=0)
   Endif

   `Payout phase
   If Win1<>Win2
      If Win1=1
         Print "You have won the pot for ";pot;"!"
         Funds1=Funds1+pot
      Else
         Print "The AI has won the pot for ";pot;"."
         Funds2=Funds2+pot
      Endif
      pot=0
   Else
      If Win1=0
         Print "You have both bet incorrectly. This hand is a draw."
      Else
         Print "You have both bet correctly. This hand is a draw."
      Endif
   Endif
   Print
   Print "Press any key to deal the next hand."
   Wait key


Loop

End

#Constant Deal Deal()
Function Deal()
   Cls
   Ink Rgb(50,50,255),0
   Box 30,30,60,60
   Box 70,30,100,60
   Box 30,70,60,100
   Box 70,70,100,100
   Ink Rgb(255,255,255),0
   Center Text 45,5,"1"
   Center Text 85,5,"2"
   Ink Rgb(255,0,0),0
   Center Text 10,40,"A"
   Center Text 10,80,"B"
   For i = 0 to 3
      board(i)=(rnd(4)+1)*(Rnd(1)*2-1)
   Next i
   if board(0)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 45,40,Str$(Abs(board(0)))
   if board(1)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 85,40,Str$(Abs(board(1)))
   if board(2)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 45,80,Str$(Abs(board(2)))
   if board(3)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 85,80,Str$(Abs(board(3)))
   Ink Rgb(200,200,255),0
   Text 120,5,"Pot = "+Str$(Pot)
   Text 120,20,"Player has "+Str$(Funds1)
   Text 120,35,"AI has "+Str$(Funds2)
   Text 120,55,"Player is "+Player$
Endfunction

`Coding Challenge #5 - Casino Gambling Game - Pachinko
`Bill Robinson
`Started 3-17-06 --- Deadline 3-29-06
`All Rights Reserved for use as a published game.
`
`Shoot balls into playing area, trying to get them in the win pockets.
`The mouse x-direction controls the Power Meter
`The Left Mouse button Fires Balls.
`The Right Mouse button controls the firing rate of the balls
`
set display mode 1024,768,32
sync on : sync rate 0

`hide mouse
autocam off
set ambient light 25
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000

` Create the ODE World
ode start
ode set world gravity 0,-5,0       :`was 0,-20,0
ode set world step  0.3             :`was 0.3
ode set world erp (0.2)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing

dim pocketinfo(10,6)
dim doorstatus(10)

#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)

global numlevels=5
global level
global levelflag
global numballs
global money

global screenxcenter
global screenycenter

`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=100
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=100
global ballsleft
global mx
global my

`walls
global leftwall=500
global rightwall=3500
global floor=0
global ceiling=4000
global backwall=250
global backwallheight
global barrierheight

`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0

`pins
global nextpinptr=3000

`Camera
global camx=2000
global camy=2000
global camz=-10000

`ODE - globals
global odeballptr

_ball_textures()                :`build textures for balls
_backwall_graphics()

screenxcenter=screen width()/2

rem --- make left wall
make object box 310,backwall,ceiling+100,50
yrotate object 310,90
color object 310,rgb(150,150,0)
position object 310,leftwall/2,ceiling/2,backwall/2
set object emissive 310,rgb(100,100,0)

rem --- make right wall
make object box 311,backwall,ceiling+100,50
yrotate object 311,-90
color object 311,rgb(150,150,0)
position object 311,rightwall+leftwall/2,ceiling/2,backwall/2

rem --- make left floor
make object box 303,rightwall/2-120,backwall+100,50
xrotate object 303,-90
zrotate object 303,-6
color object 303,rgb(0,200,0)
position object 303,rightwall/4-70+leftwall/2,floor+70,backwall/2
rem --- make right floor
make object box 306,rightwall/2-120,backwall+100,50
xrotate object 306,-90
zrotate object 306,6
color object 306,rgb(0,200,0)
position object 306,rightwall-rightwall/4+70+leftwall/2,floor+70,backwall/2

rem --- make back wall
make object box 304,rightwall,ceiling,3
color object 304,rgb(0,0,200)
position object 304,rightwall/2+leftwall/2,ceiling/2,backwall   :`position backwall
texture object 304,10

rem --- make front wall
make object box 307,rightwall,ceiling,3
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,ceiling/2,backwall-ballsize-40   :`position front wall
ode create static box 307
`ghost object on 307
hide object 307

rem --- make ceiling
make object box 305,rightwall,backwall,50
xrotate object 305,90
color object 305,rgb(0,200,200)
position object 305,rightwall/2+leftwall/2,ceiling,backwall/2
set object emissive 305,rgb(0,70,70)

rem --- Create ODE tennis balls ---
for i=1 to maxballs
   make object sphere i,ballsize          :`was i,30
   set object i,1,1,0
   color object i,rgb(255,0,0)
   set object collision off i
   position object i, 5000,5000,-5000      :`move object WAY off screen
   texture object i,rnd(5)+1
   hide object i
next i

rem --- make power bar
make object box 201,100,100,2
color object 201,rgb(255,255,0)
`position object 201,leftwall+150,ceiling-120,160   :`position power bar

rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,ceiling-120,160

rem --- win pocket placement in game ---
pocketdata:
data 800,900
data 1400,500
data 2000,700
data 2600,500
data 3200,900
data 2000,2000
restore pocketdata
pocketsize=150
for i=1 to 6
   read pocketinfo(i,1)
   read pocketinfo(i,2)
   pocketinfo(i,3)=pocketinfo(i,2)+pocketsize/2    :`y1 limit for pocket capture of ball
   pocketinfo(i,4)=pocketinfo(i,2)-pocketsize/2    :`y2 limit for pocket capture of ball
   pocketinfo(i,5)=pocketinfo(i,1)-pocketsize/2    :`x1 limit for pocket capture of ball
   pocketinfo(i,6)=pocketinfo(i,1)+pocketsize/2    :`x2 limit for pocket capture of ball
next i

rem --- make win pockets with boxes
for i=1 to 30 step 5
   make object box 320+i,pocketsize,pocketsize,3
   yrotate object 320+i,-90
   color object 320+i,rgb(255,0,0)

   make object box 321+i,pocketsize,pocketsize,3
   color object 321+i,rgb(0,255,0)

   make object box 322+i,pocketsize,pocketsize,3
   yrotate object 322+i,90
   color object 322+i,rgb(255,0,255)

   make object box 323+i,pocketsize,pocketsize,3
   xrotate object 323+i,-90
   color object 323+i,rgb(255,255,0)

   make object box 324+i,pocketsize,pocketsize,3
   color object 324+i,rgb(0,0,0)
next i

for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=0
   position object 316+i*5,locx-pocketsize/2,locy,backwall-pocketsize/2
   position object 317+i*5,locx,locy,backwall-pocketsize
   if i<6
      if i=3
         texture object 317+i*5,103
      else
         texture object 317+i*5,101
      endif
   else
      texture object 317+i*5,200
   endif
   position object 318+i*5,locx+pocketsize/2,locy,backwall-pocketsize/2
   position object 319+i*5,locx,locy-pocketsize/2,backwall-pocketsize/2
   position object 320+i*5,locx,locy,backwall-3
next i

for i=321 to 350
   ode create static box i
next i
for i=324 to 350 step 5
   color object i,rgb(0,255,255)
next i

for i=1 to 6
   if i<=5
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,4,0)
   else
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,6,0)
   endif
next i

_pin_pattern1(730,2700,5)
_pin_pattern2(870,2700,5)

_pin_pattern1(1930,3100,5)
_pin_pattern2(2070,3100,5)

_pin_pattern1(3100,2500,5)
_pin_pattern2(3240,2500,5)

rem --- make win pocket doors
doorsize=175
for i=1 to 12 step 2
   make object box 209+i,doorsize,doorsize,20
   color object 209+i,rgb(200,0,0)
   if i<=10
      zrotate object 209+i,45
   else
      zrotate object 209+i,-30
   endif
   yrotate object 209+i,-90

   make object box 210+i,doorsize,doorsize,20
   color object 210+i,rgb(200,0,200)
   if i<=10
      zrotate object 210+i,-45
   else
      zrotate object 210+i,30
   endif
   yrotate object 210+i,-90
next i

for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=backwall-pocketsize/2
   if i<=5 then doorstatus(i)=1 else doorstatus(i)=0
   if i<=5
      position object 208+i*2,locx-pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 208+i*2,locx-pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 208+i*2

   if i<=5
      position object 209+i*2,locx+pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 209+i*2,locx+pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 209+i*2
next i

`-------------------------------------------------------

ode create static box 303     :`floor left
ode create static box 306     :`floor right
ode create static box 305     :`ceiling
ode create static box 310     :`left wall
ode create static box 311     :`right wall
ode create static box 304     :`tell ODE about backwall
`ode set contact bounce 304,1
ode set contact fdir1 303,0.0                 :` was 30.0  Add FRICTION
ode set contact fdir1 306,0.0                 :` was 30.0  Add FRICTION
`--------------------------------------------------------

nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=100         :`how many balls on screen at the same time
numballs=500            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=150          :`pause between each ball being fired
level=1                 :`start at this level

set camera FOV 25
position camera camx,camy,camz
point camera camx,camy,camz+1500         :`was targetx#,targety#,targetz#
position mouse screenxcenter,screenycenter
ballcheck=1


ink rgb(255,255,255),0
rem ----- main loop -----------------------------------------------------
do
`   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
`   if keypress>0 then _key_action(keypress)

   mx=mousex()

   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_tennis_ball         :`FIRE!
   if mousebutton=2
      balltiming=120-mx/10                               :`faster shooting rate adjust
      position object 202,rightwall-1050+mx,ceiling-120,160
   else
      position object 201,leftwall+mx,ceiling-120,160
   endif

`  --- clear balls falling thru bottom hole
   if object position y(ballcheck)<-100
      position object ballcheck,5000,500,-5000
      hide object ballcheck
      ode destroy object ballcheck
      dec ballcount
   endif
   inc ballcheck
   if ballcheck>maxballs then ballcheck=1

   if pocketsopen=0
      if bonusopenflag=0
         _open_bonus(6)
      endif
   else
      if bonusopenflag=1
         _close_bonus(6)
      endif
   endif

   gosub _check_pockets
   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   sync
loop
rem --------------------------------------------------------------------
ode end
end


function _open_bonus(pocketnum)
if doorstatus(pocketnum)=1 then exitfunction
_open_doors(pocketnum)
doorstatus(pocketnum)=1
bonusopenflag=1
endfunction


function _close_bonus(pocketnum)
if doorstatus(pocketnum)=0 then exitfunction
_close_doors(pocketnum)
doorstatus(pocketnum)=0
bonusopenflag=0
endfunction


rem --- show score on screen
_show_score:
set cursor 1,1
print screen fps()
center text screenxcenter,2,"Money Left: $"+str$(numballs)
`print "ballcount=";ballcount
`print "pocketsopen=";pocketsopen
`print "bonusflag=";bonusopenflag
return


rem ---------- fires tennis balls ----------
_fire_tennis_ball:
if ballcount=ballsatonce then return
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of tennis balls
if numballs=0                          :`out of tennis balls to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif

ballx#=300
bally#=3300
ballz#=backwall-ballsize-20

`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
show object odeballptr

ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,40                 :`was 20
ode set contact bounce odeballptr,1

ode set linear velocity odeballptr,50+mx*2,mx,0.0
ode set contact fdir1 odeballptr,0.0                 :` was 30.0  Add FRICTION

dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired

inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return


_check_pockets:
for i=1 to maxballs
   y=object position y(i)
   for j=1 to 6
      if y<pocketinfo(j,3)
         if y>pocketinfo(j,4)
            x=object position x(i)
            if x>pocketinfo(j,5)
               if x<pocketinfo(j,6)
                  hide object i
                  ode destroy object i
                  position object i, 5000,5000,-5000
                  dec ballcount
                  _change_doors(j)
                  sync
               endif
            endif
         endif
      endif
   next j
next i
return


function _change_doors(pocketnum)
if doorstatus(pocketnum)=1
   inc numballs,1
   _close_doors(pocketnum)
   if pocketnum=6
      for i=1 to 5
         _open_doors(i)
      next i
      inc numballs,100
      bonusopenflag=0
   endif
else
   inc numballs,3
   _open_doors(pocketnum)
endif
endfunction


function _open_doors(pocketnum)
if doorstatus(pocketnum)=0
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=1
   if pocketnum=6
      ang=0
      offset=pocketsize/2
   else
      ang=45
      offset=pocketsize
      inc pocketsopen
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _close_doors(pocketnum)
if doorstatus(pocketnum)=1
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=0
   if pocketnum=6
      ang=-30
      offset=pocketsize/4
   else
      ang=0
      offset=pocketsize/2
      dec pocketsopen
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _finished_level(level)
set cursor 1,200
print "YOU FINISHED LEVEL - ";level
print "Press a key to continue"
sync
wait key
if level=numlevels
   print "  "
   print "That's all there is for now - Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction


function _key_action(keypress)
select keypress
   case 20
      if level>=8
         balltiming=balltiming-10
         wait 100
         if balltiming<40 then balltiming=100
      endif
   endcase
endselect
endfunction


function _ball_textures()
for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i,0,0,50,50
   delete bitmap i
next i
endfunction


function _make_pin(x,y)
make object box nextpinptr,12,200,12
xrotate object nextpinptr,90
zrotate object nextpinptr,45
position object nextpinptr,x,y,backwall-100
ode create static box nextpinptr
endfunction


function _pin_pattern1(x,y,numpins)
xspacing=50
yspacing=50
xpos=x      :`-(numpins*xspacing/2)
ypos=y      :`+(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
dec xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
dec xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   dec xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern2(x,y,numpins)
xspacing=50
yspacing=50
xpos=x         :`-(numpins*xspacing/2)
ypos=y         :`-(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
inc xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
inc xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   inc xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern3(x,y,numrows,startpins,pininc)
xspacing=120
yspacing=110
if startpins=1
   xpos=x
   offset=0
else
   offset=xspacing/2
   xpos=x-((startpins-1)*xspacing/2)
endif
ypos=y
for i=1 to numrows
   for j=1 to startpins
      _make_pin(xpos,ypos)
      inc xpos,xspacing
      inc nextpinptr
   next j
   inc ypos,yspacing
   if offset<>0 then offset=offset*-1
      if offset<0
         xpos=x-((startpins-1)*xspacing/2)-offset
      else
         xpos=x-((startpins-1)*xspacing/2)
      endif
next i
endfunction


function _backwall_graphics()
ink rgb(255,255,255),rgb(0,0,200)
`ink rgb(0,0,200),0
`box 0,0,1024,768
`ink rgb(255,255,255),0
cls rgb(0,200,00)
set cursor 5,5
print 1
get image 101,0,0,20,20
cls rgb(0,200,00)
set cursor 5,5
print 3
get image 103,0,0,20,20
cls rgb(0,200,00)
set cursor 0,5
set text size 10
print 100
get image 200,0,0,30,30
remstart
for i= 1 to 30
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   ellipse rnd(400),50+rnd(400),rnd(100),rnd(100)
next i
blur bitmap 0,2
remend
cls
`ink rgb(255,255,255),0
set cursor 55,25
set text size 16
print "POWER METER"
for i=30 to 200 step 20
   line i,5,i,25
next i

set cursor 340,25
print "FIRING RATE METER"
for i=320 to 480 step 20
   line i,5,i,25
next i
get image 10,0,0,512,512,1
endfunction

Have to enter a bid amount.
Have to enter a horse number to bid on

sync on
sync rate 40
set display mode 1024,768,16
autocam off
hide mouse
randomize timer()

set global collision on
global speed# = 10.0
global size = 200
global money = 500
global bid = 0
global amount = 0
global winner
global weather
global weather_name$

intro()
textures()
media()
camera()
bets()

do
   winner = check_winner()
   if winner > 0 then post_winner(winner)
   race()
   camera_change()
   sync
loop


function post_winner(winner)
center text screen width()/2,screen height()/2,"The WINNER is horse "+str$(winner)
sync
check()
endfunction

function check_winner()
hitnum = object collision(100,0)
endfunction hitnum

function media()
`make horses
for h = 1 to 5
make object box h,3,3,3
next h
`make wall object
make object box 100,60,5,5
position object 100,20,0,200
ghost object on 100
`make matrix
make matrix 1,50,size,10,10
prepare matrix texture 1,1,1,1
position matrix 1,0,-1,0
`positioning horses
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
endfunction

function camera_change()
`different camera position
if keystate(3)
position camera 0,30,10,140
`point camera 0,0,-10,-100
point camera 0,object position x(3),object position y(3),object position z(3)
else
position camera 0,170,50,100
point camera 0,-100,0,100
endif
endfunction

function camera()
`camera position
position camera 0,170,50,100
point camera 0,-100,0,100
endfunction

function race()
`set info box
box 0,0,1024,100,rgb(125,120,250),rgb(15,220,50),rgb(212,20,50),rgb(75,70,80)
set cursor 450,10
print "Current money: $",money,
set cursor 450,25
print "Betting horse: ",bid,
set cursor 450,40
print "Weather conditions:",weather_name$,
if weather < 10
`store sunny weather values
ran1# = rnd(8)/speed#+rnd(0.8)
ran2# = rnd(8)/speed#+rnd(0.7)
ran3# = rnd(7)/speed#+rnd(0.6)
ran4# = rnd(8)/speed#+rnd(0.4)
ran5# = rnd(8)/speed#+rnd(0.5)
else
if weather > 10
`store rainy weather values
ran1# = rnd(7)/speed#+rnd(0.7)
ran2# = rnd(8)/speed#+rnd(0.6)
ran3# = rnd(8)/speed#+rnd(0.7)
ran4# = rnd(8)/speed#+rnd(0.5)
ran5# = rnd(8)/speed#+rnd(0.6)
endif
endif
`move horses
move object 1,ran1#
move object 2,ran2#
move object 3,ran3#
move object 4,ran4#
move object 5,ran5#
endfunction

function textures()
`makes textures for game
for x = 1 to 300
for y = 1 to 300
color = rgb(rnd(50),rnd(200),rnd(169))
dot x,y,color
next x
next y
get image 1,0,0,300,300
`make another texture
for x = 1 to 300
for y = 1 to 300
color1 = rgb(rnd(148),rnd(128),rnd(100))
dot x,y,color1
next x
next y
get image 2,0,0,300,300
endfunction

function intro()
`Give introduction
set text font "Arial"
ink rgb(255,0,0),0
set text size 27
sync
center text 512,300,"Horbox Racing"
ink rgb(0,192,23),0
set text size 17
center text 512,330,"Place your bets, watch your horses and hopefully"
center text 512,360,"win some more money! Bid carfully though or you might"
center text 512,390,"end up broke!"
ink rgb(24,24,255),0
center text 768,690,"Bronze edition Created by Benjamin"
sync
wait key
cls
ink rgb(255,0,0),0
set text to bold
center text 512,280,"Gameplay:"
set text to normal
ink rgb(0,192,23),0
center text 512,295,"Place your bet on the horse you think will win watch them"
center text 512,310,"in the arena and see if you win! Becareful though, weather"
center text 512,325,"will effect your horse. For better or worse!"
ink rgb(255,0,0),0
set text to bold
center text 512,340,"Controls:"
set text to normal
ink rgb(0,192,23),0
center text 512,355,"While the game is in play press the number '2' button to"
center text 512,370,"change the camera view to a more cinematic look and feel!"
ink rgb(255,0,0),0
set text to bold
center text 512,385,"Weather:"
set text to normal
ink rgb(0,192,23),0
center text 512,400,"There are currently two different types of weather that can"
center text 512,415,"effect your horse, Sun and Rain. Being simple humans we can not"
center text 512,430,"predict the weather! We have to wait for the race to begin!"
ink rgb(255,0,0),0
set text to bold
center text 512,445,"Horses:"
set text to normal
ink rgb(0,192,23),0
center text 512,460,"Horse one: Fast in the sun, quick in the rain. Odds 1:2"
center text 512,475,"Horse two: Quick in the sun, average in the rain. Odds 1:3"
center text 512,490,"Horse three: Average in the sun, quick in the rain. Odds 1:5"
center text 512,505,"Horse four: Slow in the sun, average in the rain. Odds 1:10"
center text 512,520,"Horse five: Average in the sun, average in the rain. Odds 1:8"
sync
wait 2000
center text 512,550,"Press any key"
sync
wait key
endfunction

function bets()
`place your bets!
`reset every all the hores
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
`reset the camera position
position camera 0,170,50,100
point camera 0,-100,0,100
`make the weather effect
weather = rnd(20)
if weather < 10
prepare matrix texture 1,1,1,1
weather_name$ = "Sunny"
else
if weather > 10
prepare matrix texture 1,2,1,1
weather_name$ = "Rainy"
endif
endif
`on with the game!!
cls
sync
`sets the text colour and size
ink rgb(255,255,255),0
set text size 20
set text to bold
`makes the two boxes that will hold my text positionins them and rotates them
make object box 200,0,0.3,2
make object box 210,0,0.3,2
`rotate objects
for i = 200 to 210 step 10
xrotate object i,0
zrotate object i,0
next i
`positions all the objects
position object 200,camera position x(0)-5,camera position y(0)-0,camera position z(0)
position object 210,camera position x(0)-5,camera position y(0)-0.8,camera position z(0)
`get all the text into images for our objects
ink rgb(255,255,255),0
check$ = "Set bid amount:"
info$ = "Choose horse 1-5:"
text 0,0,check$
get image 3,0,0,text width(check$),text height(check$),1
texture object 200,3
`next image
cls
ink rgb(255,255,255),0
sync
text 0,0,info$
get image 4,0,0,text width(info$),text height(info$),2
texture object 210,4
set object light 200,0
set object light 210,0
`Another text box!
cls
ink rgb(255,0,0),0
center text 512,384,"Current Money:$"+str$(money)
center text 512,404,"Press any key"
sync
wait key
ink rgb(255,255,255),0
`get amount
money:
set cursor 512,300
input amount
if amount > money then gosub money
if amount <= 0 then gosub money
money = money-amount
bid:
set cursor 512,390
input bid
if bid > 5 then gosub bid
if bid <= 0 then gosub bid
`refresh screen and sets text colours back to normal
ink rgb(255,255,255),0
`deletes objects
for i = 200 to 210 step 10
delete object i
next i
`bye bye
endfunction

function winning()
`shows you have won
center text 512,384,"YOU WIN MONEY!!!"
`horse one
if bid = 1 and winner = 1
money = amount*2+money
endif
`horse two
if bid = 2 and winner = 2
money = amount*3+money
endif
`horse three
if bid = 3 and winner = 3
money = amount*5+money
endif
`horse one
if bid = 4 and winner = 4
money = amount*10+money
endif
`horse one
if bid = 5 and winner = 5
money = amount*8+money
endif
sync
wait key
bets()
endfunction

function losing()
`shows that you have lost
center text 512,384,"YOU LOSE MONEY!!!"
money = money
if money = 0 then exit_()
sync
wait key
bets()
endfunction

function check()
`check to see if you have won
wait key
ink rgb(255,255,255,),0
cls
if bid = winner
winning()
else
if bid <> winner
losing()
endif
endif
endfunction

function exit_()
cls
ink rgb(255,255,255,),0
center text 512,384,"Sorry kid your out of Mula!!"
sync
wait key
end
endfunction

Rem Project: PriDe
Rem Created: 3/26/2006 10:27:53 AM

Rem ***** Main Source File *****


`Initialize Neural Net
Rem Project: ANNTM ("Auntie Em"): Artificial Neural Network Through Memblocks
Rem Created: 12/30/2005 7:15:12 PM

#Constant G_Curve 0
#Constant G_Weight 1
#Constant G_Threshold 2


`Each "Cluster" memblock is a group of 32 neurons. One cluster can be attached to a second cluster.
`That second cluster can be attached to a third cluster, and so on.
`Each neuron in a cluster can be "linked" to any or all of the 32 neurons in the attached cluster.

`End Clusters: Clusters do not have to be assigned a target cluster. If this is the case, the neurons in the cluster will never fire.
`Neurons that do not fire, do not lose their charge (and will eventually max out). It is advisable to read an End Cluster periodically
`and do something with the charges in the neurons, then set all the neurons in that cluster to 0 (see Clear_Charges)

`Neurons have 5 parts: Charge, Threshold, Curve, Weight, and Links.
`  Charge: This is how much "electricity" the neuron is holding, represented as a value between 0 and 15
`  Threshold: This is at what point the neuron will release it's charge. If the Charge value => Threshold, then the neuron "fires".
`  Curve: This is used to scale the input values coming into a neuron.
`  Weight: This is the amount of "charge" a neuron releases when it fires.
`  Links: 4 bytes long. Each bit represents a link to a relative neuron in a linked cluster of neurons. The 3rd bit would represent the 3rd neuron.


Global AI_Score
Global AI_Average
Global Epoch_Timer as DWord
Global Epoch_Counter as DWord
`Epoch_Length is how many frames make a single Epoch
Global Epoch_Length = 4
`Pain is an offset from 0 to 14 which adjusts each neuron's charge by -Pain
`Basically: this mathematically reflects negative "pain" values without storing negative values (which requires an extra bit)
`Remember that this value lowers the maximum output as well.
Global Pain = 7


`Set up initial clusters (read about clusters above).
`Some arrays are based on how many cluster there are, so it is important to initialize all the clusters first.
`Also, clusters must be sequential and start with Memblock 1. The Make_Free_Cluster function handles this automatically.
`If you need to create other memblocks, you should start those at a much higher value (like Memblock 100).
Global Mem1
Global Mem2
Mem1=Make_Free_Cluster
Mem2=Make_Free_Cluster

Type Genes
   Curve as Integer
   Weight as Integer
   Threshold as Integer
Endtype
`Gene is the learning "genetic code". Typically, the "genetic code" would record and consider the population
`of all AI of the same type.
`In this case though, we only have one AI, and that type of evolution would take a really long time.
`So we are going to take the population of possibilities and use those instead. Since a neuron can hold a value of
`0 to 15, we will track how well each setting does and keep track over many Epochs.
`We are tracking: # of Clusters, 32 neurons (0-31), and 16 possible settings (0-15).
`So our Dim is:
`Dim Gene( Clusters ,31, 15) as Genes
`The BestGenes array records which single Gene setting (0-15) is the best.
Dim BestGenes( Clusters ,31 ) as Genes
`Note: A future update would be to convert this to a memblock as well.


`LinkCrawler is a genetic array that handles the evolution of the neuron links, one at a time per cluster.
`The crawler stays with each neuron for specific number of epochs, and then moves on to the next neuron.
Dim LinkCrawler( Clusters , 33 ) as Integer


`=============Prime the Neural Net AI=================

If File Exist("PrideNet1.ann")
   Open To Read 1,"PrideNet1.ann"
   Read Memblock 1,Mem1
   Close File 1
   Open To Read 1,"PrideNet2.ann"
   Read Memblock 1,Mem2
   Close File 1
Else
   ` Create and Attach two Neuron Clusters
   Assign_Cluster(Mem1,Mem2)

   Initialize_Links()
   For i =0 to 7
      For j = 0 to 5
         Link_Neuron(Mem1,i,j)
      Next j
   Next i
   For i =8 to 11
      Link_Neuron(Mem1,i,0)
      Link_Neuron(Mem1,i,1)
   Next i

   Epoch_Timer=Epoch_Length+1
   Epoch()

   `Increase all the 1st cluster's neuron charges by 2.
   Pump_Charges(Mem1)

Endif

`=====================================================GAME=====================================================


`Gambling game called PriDe


Game:


Game_SetUp:
Set Display Mode 800,600,32
CLS
Print "Welcome to PRIDE"
Print
Print "Pride is a thinking gambling game."
Print "The object is to outwit your opponent on several levels."
Print
Print "First, is the Player Selection: Choose either the"
Print "Alpha Player (Red), or the Numeric Player (White)"
Print "(Note: there is no advantage to either player)"
Print "[1] Alpha (Red)"
Print "[2] Numeric (White)"
Global Player
Global Player$
Player$="Numeric (White)"
Do
   Input "Select: ",Player
   If Player = 1
      Player$="Alpha (Red)"
      Exit
   Endif
   If Player = 2 Then exit
Loop

CLS
Print
Print "Next, you will see the game board."
Print "Like this:"
Print "   1  2"
Print "A [ ][ ]"
Print "B [ ][ ]"
Print
Print "The Game:"
Print "Dealing: Each section will have a red or white number from 1 to 5 in it."
Print
Print "Betting: Each player reviews the board and bets to Win or Lose."
Print "         You can bet 1 minimum to 5 maximum. This will not be the whole bet amount."
Print "         Bets are kept secret until the Payout phase."
Print
Print "Select Row/Column: The Alpha Player selects either row A or B."
Print "                   The Numeric Player selects either column 1 or 2."
Print
Print "Playing: Both player's reveal their selections simultaniously."
Print "         The color/number selected is value in the row and column selected by"
Print "         the players."
Print
Print "Scoring: If the selected value is Red, the Alpha player 'wins'. Numeric 'loses'."
Print "         If the selected value is White, the Numeric player 'wins'. Alpha 'loses'."
Print "         Each initial bet amount is multiplied by the selected value and the results"
Print "         are added together. This amount is deducted from each player's funds and"
Print "         added to to the pot."
Print
Print "Payout: If no player bets correctly (to win or lose), the total amount remains in"
Print "        the 'pot'. If one player bet correctly, that player wins the total pot."
Print "        If both players bet correctly, the total amount remains in the 'pot'."
Print
Print "Press any key to continue"
Wait Key
Cls
Print "Strategies to consider:"
Print
Print "Your bet is 50% controlled by you and 50% controlled by your opponent. Consider your"
Print "bet carefully. If you think you have a good chance to win, you will probably want to"
Print "force the highest bet you can. Otherwise, you may want to limit the bet as much as"
Print "possible. The dilemma comes when it appears you have a 50% chance of winning."
Print
Print "You can try to trick your opponent. One option may look like a sure win, but it may"
Print "also have a lower bet multiplier. Consider the possibility of going against the sure"
Print "bet in order to get the higher payout. Of course, your opponent might consider this"
Print "as well."
Print
Print "If you have a 50-50 chance of winning a hand, consider the payout strategies. Which"
Print "choice you make will have the most potential and the least risk. Consider what your"
Print "opponent might think is a great strategy as well. And then throw in the possibility"
Print "that your opponent is taking what you are thinking into consideration as well."
Print
Print "Press any key to continue."

Wait Key

Dim board(3)
Global Pot

Global Funds1
Funds1=500
Global Funds2
Funds2=500

Global Bet1
Global BetType1
Global Bet2
Global BetType2

Do
   `Save Neural Net
   If File Exist("PrideNet1.ann")
      Delete File "PrideNet1.ann"
   Endif
   Open To Write 1,"PrideNet1.ann"
   Write Memblock 1,Mem1
   Close File 1
   If File Exist("PrideNet2.ann")
      Delete File "PrideNet2.ann"
   Endif
   Open To Write 1,"PrideNet2.ann"
   Write Memblock 1,Mem2
   Close File 1
   Epoch()

   `Deal phase
   Deal


   `Bet Phase
   Set_All_Charges(Mem2,0)
   Fire_Neurons(Mem1)

   b=Read_Charge(Mem2,0)+Read_Charge(Mem2,1)
   b=Sigmoidal(b-(b*.5),1)*4+1
   Bet2=b
   t1=Read_Charge(Mem2,2):t2=Read_Charge(Mem2,3)
   t=(t2>t1)+1
   BetType2=t
   Set Cursor 0,110

   Ink Rgb(200,200,255),0
   Do
      Input "Bet to [1]Win or [2]Lose? :",BetType1
      `BetType1=rnd(1)+1
      If BetType1=1 or BetType1=2 then Exit
   Loop
   Do
      Input "Amount to bet (1-5)? :",Bet1
      `Bet1=Rnd(4)+5
      If Bet1=>1 and Bet1<=5 then Exit
   Loop

   `Select Phase
   a1=Read_Charge(Mem2,4):a2=Read_Charge(Mem2,5)
   a=(a2>a1)+1
   If Player=1
      Do
         Input "Select Row ([1]Row A or [2]Row B): ",Row
         `Row=Rnd(1)+1
         If Row = 1 or Row=2 Then exit
      Loop
      Col=a
      ABet=Bet1:AType=BetType1
      NBet=Bet2:NType=BetType2
   Else
      Do
         Input "Select Column ([1]Col 1 or [2]Col 2): ",Col
         `Col=Rnd(1)+1
         If Col = 1 or Col=2 Then exit
      Loop
      Row=a
      NBet=Bet1:NType=BetType1
      ABet=Bet2:AType=BetType2
   Endif

   `Play Phase
   Print "Bets and selections are made. Press any key to continue."
   Wait Key
   Print
   Print "Alpha Player bet ";ABet;" to ";
   If AType=1 Then Print "Win." Else Print "Lose."
   Print "Alpha Player selected Row ";
   If Row=1 Then Print "A." Else Print "B."

   Print
   Print "Numeric Player bet ";NBet;" to ";
   If NType=1 Then Print "Win." Else Print "Lose."
   Print "Numeric Player selected Col ";Col
   Print
   s=(row-1)*2+(col-1)
   Print "The selected Value is ";Abs(Board(s));"-";
   If Board(s)>0
      Print "White."
   Else
      Print "Red."
   Endif
   totalbet=(Abs(Board(s))*Bet1+Abs(Board(s))*Bet2)*2
   Print "Total Bet = ";totalbet;". Pot = ";pot+totalbet*2;"."
   Print "Press any key to continue."
   Wait Key

   `Scoring phase
   Funds1=Funds1-totalbet
   Funds2=Funds2-totalbet
   pot=pot+totalbet*2
   win1=0
   win2=0
   `Scoring if player=1
   If Board(s)<0
      If AType=1 Then Win1=1
      If NType=2 then Win2=1
   Endif
   If Board(s)>0
      If AType=2 Then Win1=1
      If NType=1 then Win2=1
   Endif
   `Flip win values if Player=2
   If Player=2
      Win1=(Win1=0)
      Win2=(Win2=0)
   Endif

   `Payout phase
   If Win1<>Win2
      If Win1=1
         Print "You have won the pot for ";pot;"!"
         Funds1=Funds1+pot
         AI_Score=AI_Score-pot
      Else
         Print "The AI has won the pot for ";pot;"."
         Funds2=Funds2+pot
         AI_Score=AI_Score+pot
      Endif
      pot=0
   Else
      If Win1=0
         Print "You have both bet incorrectly. This hand is a draw."
      Else
         Print "You have both bet correctly. This hand is a draw."
      Endif
   Endif
   Print
   Print "Press any key to deal the next hand."
   Wait key
   If Funds1<0 Then Funds1=Funds1+300
   If Funds1>1000 Then Funds1=Funds1-300
   If Funds2<0 Then Funds2=Funds2+300
   If Funds2>1000 Then Funds2=Funds2-300

Loop

End

#Constant Deal Deal()
Function Deal()
   Cls
   Ink Rgb(50,50,255),0
   Box 30,30,60,60
   Box 70,30,100,60
   Box 30,70,60,100
   Box 70,70,100,100
   Ink Rgb(255,255,255),0
   Center Text 45,5,"1"
   Center Text 85,5,"2"
   Ink Rgb(255,0,0),0
   Center Text 10,40,"A"
   Center Text 10,80,"B"
   For i = 0 to 3
      board(i)=(rnd(4)+1)*(Rnd(1)*2-1)
      if Player=1
         c=board(i)+5
      Else
         c=5-board(i)
      Endif
      Set_Charge(Mem1,i,c)
      if Player=1
         c=5-board(i)
      Else
         c=board(i)+5
      Endif
      Set_Charge(Mem1,i+4,c)
      t=t+board(i)
   Next i
   t=Sigmoidal(t,1)*15
   Set_Charge(Mem1,8,t)
   if board(0)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 45,40,Str$(Abs(board(0)))
   if board(1)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 85,40,Str$(Abs(board(1)))
   if board(2)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 45,80,Str$(Abs(board(2)))
   if board(3)>0 Then Ink RGB(255,255,255),0 Else Ink Rgb(255,0,0),0
   Center Text 85,80,Str$(Abs(board(3)))
   Ink Rgb(200,200,255),0
   Text 120,5,"Pot = "+Str$(Pot)
   c=Sigmoidal(Pot-(pot*.5),75)*15
   Set_Charge(Mem1,9,c)
   Text 120,20,"Player has "+Str$(Funds1)
   c=Sigmoidal(Funds1-(Funds1*.5),250)*15
   Set_Charge(Mem1,10,c)
   Text 120,35,"AI has "+Str$(Funds2)
   c=Sigmoidal(Funds2-(Funds2*.5),250)*15
   Set_Charge(Mem1,11,c)
   Text 120,55,"Player is "+Player$
Endfunction




`=========================================================ANNTM==================================================


Charges:
`Set_Charge is used to set a neuron's charge to a specific value between 0 and 15
Function Set_Charge(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Add_Charge is used to add a "charge" value to the neuron's existing charge.
Function Add_Charge(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   Value=lft+Value
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Deduct_Charge is used to subtract a charge value from the neuron's existing charge.
Function Deduct_Charge(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   If lft>Value
      Value=lft-Value
   Else
      Value=0
   Endif
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

Function Read_Charge(Memblock, Neuron)
   If Neuron>31 then ExitFunction 0
   If Memblock Exist(Memblock)=0 Then ExitFunction 0
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   lft=Get_Left_Nibble(Byt)-Pain
Endfunction lft


`Clear_Charges: sets all the neuron charges to the provided Value in the given cluster.
Function Set_All_Charges(Memblock,Value)
   For i = 0 to 31
      Set_Charge(Memblock,i,Value)
   Next i
Endfunction

`Drain_Charges: Subtracts 1 from all the neuron charges in the given cluster. Useful for a timer or score drain.
Function Drain_Charges(Memblock)
   For i = 0 to 31
      Deduct_Charge(Memblock,i,1)
   Next i
Endfunction

`Pump_Charges: Adds 1 to all the neuron charges in the given cluster. Useful for a timer or score boost.
Function Pump_Charges(Memblock)
   For i = 0 to 31
      Add_Charge(Memblock,i,1)
   Next i
Endfunction

Clusters:
`Fire_Neurons runs through all a cluster's neurons and checks if they should be fired or not.
`If a neuron is fired, it's Weight is applied to all linked neurons in the target cluster
`and the firing neuron's charge is set to 0.
`If the Cluster does not have a Target Cluster Assigned to it, then the neurons are not fired.
Function Fire_Neurons(SourceMem)
   If SourceMem=0 Then ExitFunction
   If Memblock Exist(SourceMem)=0 Then ExitFunction
   TargetMem=Cluster_Link(SourceMem)
   If TargetMem=0 Then ExitFunction
   If Memblock Exist(TargetMem)=0 Then ExitFunction
   Link as DWord
   For i = 0 to 31
      Charge=Read_Charge(SourceMem,i)
      Threshold=Read_Threshold(SourceMem,i)
      If Charge=>Threshold : `Fire Neuron
         Weight#=Read_Weight(SourceMem,i)
         Link = Neuron_Link_Dword(SourceMem,i)
         For j=0 to 31
            If (Link && 2^j) <> 0
               Curve#=Read_Curve(TargetMem,j)
               Result=Sigmoidal(Weight#-7.5,Curve#*.5)*5
               Add_Charge(TargetMem,j,Result)
            Endif
         Next j
         Set_Charge(SourceMem,i,0)
      Endif
   Next i
Endfunction

`Assign_Cluster:
`Assigns a Target Memblock Cluster to a Source Memblock Cluster (recorded in the source).
`When the Source Neurons fire, the Target Neurons will receive the resulting charges.
`This function can also be used to create the memblocks.
`A Source Cluster can only be assigned a single Target Cluster. However, a Target Cluster can be
`the target of one or more Source Clusters.
Function Assign_Cluster(Source,Target)
   If Memblock Exist(Source)=0
      Make Memblock Source,200
   Endif
   If Memblock Exist(Target)=0
      Make Memblock Target,200
   Endif
   t as word
   t=Target
   Write Memblock Word Source,198,t
Endfunction

Function Cluster_Link(Source)
   If Memblock Exist(Source)=0 Then Exitfunction 0
   target=Memblock Word(Source,198)
Endfunction target


Links:
`======================================================
`=======================Links==========================
`======================================================

`Link_Neuron:
`Links a single Source Neuron to a single Target Neuron. A Neuron can have up to 32 targets.
`The target neurons are also determined by the Source neuron's cluster target (see Assign_Cluster).
`Memblock must be a valid Memblock Cluster. Source must be a byte <= 31. Target must be a byte <= 31.
Function Link_Neuron(Memblock, Source as Byte, Target as Byte)
   If Memblock Exist(Memblock)=0 Then ExitFunction
   If Source>31 Then ExitFunction
   If Target>31 then ExitFunction
   Link as Dword
   Link = Neuron_Link_Dword(Memblock,Source)
   Link = Link || 2^Target
   Write_Neuron_Link_Dword(Memblock,Source,Link)
Endfunction

Function DeLink_Neuron(Memblock, Source as Byte, Target as Byte)
   If Memblock Exist(Memblock)=0 Then ExitFunction
   If Source>31 Then ExitFunction
   If Target>31 then ExitFunction
   Link as Dword
   Link=Neuron_Link_DWord(Memblock,Source)
   Link = Link .. Link :`Invert Link
   Link = Link || 2^Target :`OR the appropriate bit
   Link = Link .. Link : `Invert Link back to the original settings
   Write_Neuron_Link_Dword(Memblock,Source,Link)
Endfunction

Function Neuron_Link_Dword(Memblock,Neuron)
   zero as dword = 0
   If Memblock Exist(Memblock)=0 Then ExitFunction zero
   Links=Neuron*6+2
   DW as DWord
   DW=Memblock Dword(Memblock,Links)
Endfunction DW

Function Write_Neuron_Link_DWord(Memblock,Neuron,DW as DWord)
   If Memblock Exist(Memblock)=0 Then ExitFunction
   Links=Neuron*6+2
   Write Memblock DWord Memblock,Links,DW
Endfunction


`======================================================
`=====================Thresholds=======================
`======================================================
Thresholds:

`Set_Threshold is used to set a neuron's threshold to a specific value between 0 and 15
Function Set_Threshold(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Add_Threshold is used to add to the to the neuron's existing threshold value.
Function Add_Threshold(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   Value=rit+Value
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Deduct_Threshold is used to subtract a value from the neuron's existing threshold value.
Function Deduct_Threshold(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   If rit>Value
      Value=rit-Value
   Else
      Value=0
   Endif
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

Function Read_Threshold(Memblock, Neuron)
   If Neuron>31 then ExitFunction 0
   If Memblock Exist(Memblock)=0 Then ExitFunction 0
   NOff=Neuron*6
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)-Pain
Endfunction rit

`Set_All_Thresholds: sets all the neuron thresholds to the specified Value in the given cluster.
Function Set_All_Thresholds(Memblock,Value)
   For i = 0 to 31
      Set_Threshold(Memblock,i,Value)
   Next i
Endfunction

`Drain_Thresholds: Subtracts 1 from all the neuron thresholds in the given cluster.
Function Drain_Thresholds(Memblock)
   For i = 1 to 31
      Deduct_Threshold(Memblock,i,1)
   Next i
Endfunction

`Pump_Thresholds: Adds 1 to all the neuron thresholds in the given cluster.
Function Pump_Thresholds(Memblock)
   For i = 1 to 31
      Add_Threshold(Memblock,i,1)
   Next i
Endfunction


`======================================================
`=======================Curves=========================
`======================================================
Curves:

`Set_Curve is used to set a neuron's Curve to a specific value between 0 and 15
Function Set_Curve(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Add_Curve is used to add a value to the neuron's existing Curve.
Function Add_Curve(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   Value=lft+Value
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Deduct_Curve is used to subtract a Curve value from the neuron's existing Curve.
Function Deduct_Curve(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Right_Nibble(0,rit)
   If lft>Value
      Value=lft-Value
   Else
      Value=0
   Endif
   If Value>15 then Value=15
   Byt=Set_Left_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

Function Read_Curve(Memblock, Neuron)
   If Neuron>31 then ExitFunction 0
   If Memblock Exist(Memblock)=0 Then ExitFunction 0
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   lft=Get_Left_Nibble(Byt)
Endfunction lft


`Clear_Curves: sets all the neuron Curves to the specified Value.
Function Set_All_Curves(Memblock,Value)
   For i = 0 to 31
      Set_Curve(Memblock,i,Value)
   Next i
Endfunction

`Drain_Curves: Subtracts 1 from all the neuron Curves in the given cluster. Useful for a timer or score drain.
Function Drain_Curves(Memblock)
   For i = 1 to 31
      Deduct_Curve(Memblock,i,1)
   Next i
Endfunction

`Pump_Curves: Adds 1 to all the neuron Curves in the given cluster. Useful for a timer or score boost.
Function Pump_Curves(Memblock)
   For i = 1 to 31
      Add_Curve(Memblock,i,1)
   Next i
Endfunction



`======================================================
`=======================Weights========================
`======================================================
Weights:

`Set_Weight is used to set a neuron's Weight to a specific value between 0 and 15
Function Set_Weight(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Add_Weight is used to add to the to the neuron's existing Weight value.
Function Add_Weight(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   Value=rit+Value
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

`Deduct_Weight is used to subtract a value from the neuron's existing Weight value.
Function Deduct_Weight(Memblock, Neuron, Value as Byte)
   If Neuron>31 then ExitFunction
   If Memblock Exist(Memblock)=0 Then ExitFunction
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
   lft=Get_Left_Nibble(Byt)
   Byt=Set_Left_Nibble(0,lft)
   If rit>Value
      Value=rit-Value
   Else
      Value=0
   Endif
   If Value>15 then Value=15
   Byt=Set_Right_Nibble(Byt,Value)
   Write Memblock Byte Memblock,NOff,Byt
Endfunction

Function Read_Weight(Memblock, Neuron)
   If Neuron>31 then ExitFunction 0
   If Memblock Exist(Memblock)=0 Then ExitFunction 0
   NOff=Neuron*6+1
   Byt as Byte
   Byt=Memblock Byte(Memblock,NOff)
   rit=Get_Right_Nibble(Byt)
Endfunction rit

`Set_All_Weights: sets all the neuron Weights to the specified Value in the given cluster.
Function Set_All_Weights(Memblock,Value)
   For i = 0 to 31
      Set_Weight(Memblock,i,Value)
   Next i
Endfunction

`Drain_Weights: Subtracts 1 from all the neuron Weights in the given cluster.
Function Drain_Weights(Memblock)
   For i = 1 to 31
      Deduct_Weight(Memblock,i,1)
   Next i
Endfunction

`Pump_Weights: Adds 1 to all the neuron Weights in the given cluster.
Function Pump_Weights(Memblock)
   For i = 1 to 31
      Add_Weight(Memblock,i,1)
   Next i
Endfunction


`This function is added to set, or reset, our neurons randomly.
Function Initialize_AI()
   dw as DWord
   For i = 1 to Clusters
      For j=0 to 31
         Set_Threshold(i,j,Rnd(14)+1)
         Set_Weight(i,j,Rnd(14)+1)
         Set_Curve(i,j,Rnd(14)+1)
      Next j
   Next i
Endfunction

`This function is added to set, or reset, our neuron links randomly.
Function Initialize_Links()
   dw as DWord
   For i = 1 to Clusters
      For j=0 to 31
         d1=Rnd(255):d2=rnd(255):d3=Rnd(255):d4=Rnd(255)
         dw=d1+(d2 << 8) + (d3 << 16) + (d4 << 24)
         Write_Neuron_Link_DWord(i,j,dw)
      Next j
   Next i
Endfunction

Function Epoch()
   Inc Epoch_Timer
   If Epoch_Timer<Epoch_Length Then ExitFunction

   `Here's where we score our neuron settings and store them for later:
   For i = 1 to Clusters
      For j = 0 to 31
         n=Read_Curve(i,j)
         curve=Int(Sigmoidal((AI_Score-AI_Average)+(Get_Gene(i,j,n,G_Curve)*10),500)*10)
         Write_Gene(i,j,n,G_Curve,curve)
         n=Read_Weight(i,j)
         weight=Int(Sigmoidal((AI_Score-AI_Average)+(Get_Gene(i,j,n,G_Weight)*10),500)*10)
         Write_Gene(i,j,n,G_Weight,weight)
         n=Read_Threshold(i,j)
         threshold=Int(Sigmoidal((AI_Score-AI_Average)+(Get_Gene(i,j,n,G_Threshold)*10),500)*10)
         Write_Gene(i,j,n,G_Theshold,threshold)
      Next j
   Next i

   `Initialize the AI with some random values.
   Initialize_AI()
   `Now populate the AI with some best scores. The more Epochs that go by, the less mutation occurs.
   `Note: this is sort of an inverse mutation function. The gene starts off by default as mutated.
   `      Then if the random selection comes up, the mutation is replaced by a successful gene.
   `      The more Epochs that go by, the more likely the mutations will be replaced, but never 100%.
   Get_Best_Genes()
   For i = 1 to Clusters
      For j = 0 to 31
         If Rnd(20+Epoch_Counter)<Epoch_Counter
            Set_Curve(i,j,BestGenes(i,j).curve)
         Endif
         If Rnd(20+Epoch_Counter)<Epoch_Counter
            Set_Weight(i,j,BestGenes(i,j).weight)
         Endif
         If Rnd(20+Epoch_Counter)<Epoch_Counter
            Set_Threshold(i,j,BestGenes(i,j).threshold)
         Endif
      Next j
      Link_Learning()
   Next i

   `Calculate the new average score
   Inc Epoch_Counter
   `Weighted average so the current performance is based on past performance.
   AI_Average=((AI_Average * (Epoch_Counter-1))+AI_Score)/Epoch_Counter

   AI_Score=0
   Epoch_Timer=0

Endfunction


`This function chooses the "best" genes, the genes with the highest scores.
`A feature has been added to typically select 1 of the best 3 (usually) to avoid getting stuck in a niche.
Function Get_Best_Genes()
   For i = 1 to Clusters
      For j = 0 to 31
         best_curve=-9999
         best_weight=-9999
         best_threshold=-9999
         For k=0 to 15
            If best_curve<=Get_Gene(i,j,n,G_Curve) and rnd(3)=1  :`Typically will choose one of the best 3, but not always.
               best_curve=Get_Gene(i,j,n,G_Curve)
               BC=k
            Endif
            If best_weight<Get_Gene(i,j,n,G_Weight) and rnd(3)=1
               best_weight=Get_Gene(i,j,n,G_Weight)
               BW=k
            Endif
            If best_threshold<Get_Gene(i,j,n,G_Threshold) and rnd(3)=1
               best_threshold=Get_Gene(i,j,n,G_Threshold)
               BT=k
            Endif
         Next k
         BestGenes(i,j).curve=BC
         BestGenes(i,j).weight=BW
         BestGenes(i,j).threshold=BT
      Next j
   Next i
Endfunction

`Returns the Gene Setting score value from the cluster
Function Get_Gene(Cluster,Neuron as byte,Score as byte,Gene as byte)
   zero as dword = 0
   If Gene>2 Then Exitfunction zero
   If Score>15 Then Exitfunction zero
   If Neuron>31 Then Exitfunction zero
   r as Dword
   rbyte=200+Neuron*24+Int(Score/2)+(Gene*8)
   r=Memblock Byte(Cluster,rbyte)
   If Int(Score/2)*2=Score
      r=Get_Left_Nibble(r)
   Else
      r=Get_Right_Nibble(r)
   Endif
Endfunction r

`Write the Gene Setting score value to the cluster
Function Write_Gene(Cluster,Neuron as byte,Score as byte,Gene as byte, Value as Byte)
   zero as dword = 0
   If Gene>2 Then Exitfunction zero
   If Score>15 Then Exitfunction zero
   If Neuron>31 Then Exitfunction zero
   If Value>15 Then Value=15
   r as Dword
   rbyte=200+Neuron*24+Int(Score/2)+(Gene*8)
   r=Memblock Byte(Cluster,rbyte)
   If Int(Score/2)*2=Score
      r=Get_Left_Nibble(r)
   Else
      r=Get_Right_Nibble(r)
   Endif
Endfunction r


Function Link_Learning()
   links as Dword
   For i = 1 to Clusters
      `The "Crawling" part
      Inc LinkCrawler(i,33)
      If LinkCrawler(i,33)>100
         LinkCrawler(i,33)=0
         Inc LinkCrawler(i,32)
         If LinkCrawler(i,32)>31 then LinkCrawler(i,32)=0
         links = Neuron_Link_Dword(i,LinkCrawler(i,32))
         For j = 0 to 31
            bit=(Get_Bit(links,j)*2)-1
            LinkCrawler(i,j)=5*bit
         Next j
      Endif
      links=Neuron_Link_Dword(i,LinkCrawler(i,32))
      EC=Epoch_Counter-(LinkCrawler(i,32)*100)
      For j = 0 to 31
         sign=Get_Bit(links,j)*2-1
         LinkCrawler(i,j)=LinkCrawler(i,j)+((Int(Sigmoidal(AI_Score-AI_Average,500)*11)-5)*sign)
         If Rnd(20+EC)<EC
            If LinkCrawler(i,j)>0
               Link_Neuron(i,LinkCrawler(i,32),j)
            Else
               DeLink_Neuron(i,LinkCrawler(i,32),j)
            Endif
         Else
            if rnd(1)
               Link_Neuron(i,LinkCrawler(i,32),j)
            Else
               DeLink_Neuron(i,LinkCrawler(i,32),j)
            Endif
         Endif
      Next j
   Next i
Endfunction


#Constant Clusters Count_Memblocks()
Function Count_Memblocks()
   i=0
   Do
      If Memblock Exist(i+1)=0
         Exit
      Endif
      inc i
   Loop
EndFunction i

#Constant Free_Cluster Free_Memblock()
Function Free_Memblock()
   i=1
   Do
      If Memblock Exist(i)=0 Then Exit
      inc i
   Loop
Endfunction i

#Constant Make_Free_Cluster Free_Cluster()
Function Free_Cluster()
   mb=Free_Memblock()
   Make Memblock mb,1240
Endfunction mb


Function Sigmoidal(value#,curve#)
   `the sigmoidal formula. Graph this on a spreadsheet to see how it works.
   result#=1.0/(1.0+2.04541^-((value#)/(curve#*.1)))
   `The result# is a value between >0 and <1. Curve is the number standard deviations in a normal distribution.
Endfunction result#

`Simple Nibble Functions.
Function Set_Nibble(bt as byte, value as byte, nibble as byte)
   if nibble=0 then bt = Set_Right_Nibble(bt,value)
   if nibble=1 then bt = Set_Left_Nibble(bt,value)
Endfunction bt

Function Set_Left_Nibble(bt as byte,value as byte)
   value = value << 4
   bt = bt || value
Endfunction bt

Function Set_Right_Nibble(bt as byte,value as byte)
   value = value << 4
   value = value >> 4
   bt = bt || value
Endfunction bt

Function Get_Nibble(bt as byte, nibble as byte)
   if nibble=0 then bt=Get_Right_Nibble(bt)
   if nibble=1 then bt=Get_Left_Nibble(bt)
Endfunction bt

Function Get_Left_Nibble(bt as byte)
   bt = bt >> 4
Endfunction bt

Function Get_Right_Nibble(bt as byte)
   bt = bt << 4
   bt = bt >> 4
Endfunction bt

Function Get_Bit(value as DWord, bt as byte)
   bit as Dword
   bit= 2^bt
   r=Value && bit
   r=(r>0)
Endfunction r

Rem Project: Slot Machine
Rem Created: 3/18/2006 6:04:45 PM
REM Liberty Sevens
REM by MrBigger         v.1.1
Rem ***** Main Source File *****

`          DISCLAIMER
`This code was written for learning
`purposes and in no way condones gambling.
`By using this code you release the author
`of any responsiblity for your gambling
`habits.Your problem`s are your own.

`            NOTE
`If this is too loose you can tighten it up by
`unremming a different set of six data lines
`at the bottom of the program,just be sure
`to rem the set you are using now.
`Leave the last data line as is.
`............ENJOY!.............
sync on
sync rate 60
  if check display mode(800,600,32)=1
     SET DISPLAY MODE 800,600,32
     else
     SET DISPLAY MODE 800,600,16
  endif
autocam off:backdrop on:color backdrop 0:position camera (),0,-3,-50:set normalization on
set ambient light 50
randomize timer():oldtime# = timer():oldtime1# = timer()
dim virtual(64,3):dim actual(22):dim pay(3)
GOSUB PAR:GOSUB TEXTURES:GOSUB CREATE
`prep for viewport text
paid = 0:credits = 0:bet = 0:ink rgb(255,10,10),0:set text size 18
`start reels at jackpot
xrotate object 10,66:xrotate object 11,66:xrotate object 12,66
`dim all buttons
set object diffuse 21,rgb(20,20,20):set object diffuse 22,rgb(20,20,20):set object diffuse 23,rgb(20,20,20)

DO
  if timer() >= oldtime#+100 and mouseclick() = 0 then GOSUB RANDOM:oldtime# = timer()
GOSUB VIEWPORTS
button=PICK OBJECT(mouseX(), mousey(), 21, 27)
`spin reels
  if mouseclick() > 0 and button = 23 and bet > 0 and credits => bet
    dec credits,bet:go1 = 0:go2 = 0:go3 = 0:paid = 0
    set object diffuse 21,rgb(20,20,20):set object diffuse 22,rgb(20,20,20):set object diffuse 23,rgb(20,20,20)
      sp = 1:GOSUB SPIN:gosub payout:sp = 0
  endif
`bet 1
  if mouseclick() > 0 and button = 22 and timer() >= oldtime1#+150
    if bet < 3 and credits > bet
      inc bet
      else
      bet = 1
        if credits < 2 then set object diffuse 22,rgb(20,20,20)
    endif
   oldtime1# = timer()
  endif
`max bet
  if mouseclick() > 0 and button = 21 and credits > 2
    bet = 3:dec credits,bet:go1 = 0:go2 = 0:go3 = 0:paid = 0
    set object diffuse 21,rgb(20,20,20):set object diffuse 22,rgb(20,20,20):set object diffuse 23,rgb(20,20,20)
    sp = 1:GOSUB SPIN:gosub payout:sp = 0
      if bet > credits then bet = credits
  endif
if bet > credits then bet = credits
if credits > 2 and bet < 4 then set object diffuse 21,rgb(130,130,130):set object diffuse 22,rgb(130,130,130):set object diffuse 23,rgb(130,130,130)
if credits > 1 then set object diffuse 22,rgb(130,130,130):set object diffuse 23,rgb(130,130,130)
if credits = 1 then set object diffuse 23,rgb(130,130,130)
if credits > 0 and bet = 0 then bet = 1
if mouseclick() > 0 and button = 24 then end
if mouseclick() > 0 and button = 27 and credits < 200:credits = 200
  xrotate object 10,66:xrotate object 11,66:xrotate object 12,66
endif
`conrol chart
if mouseclick() > 0 and button = 26
  if scale = 0 then payout = 1
  if scale = 40 then payout = 0
endif
if payout = 1 and scale < 40
inc scale:scale sprite 1,scale:scale sprite 2,scale:scale sprite 3,scale:scale sprite 4,scale
if scale = 40 then payout = 2
endif
if payout = 0 and scale > 0
dec scale:scale sprite 1,scale:scale sprite 2,scale:scale sprite 3,scale:scale sprite 4,scale
if scale = 0 then payout = 2
endif
SYNC
LOOP
viewports:
`text 10,570,str$(screen fps())
text 25,4,"EXIT":text 25,34,"NEW":text 16,64,"CHART"
if credits = 0 and sp = 0
  ink rgb(255,255,255),0:text 214,40,"THANK YOU FOR PLAYING LIBERTY SEVENS":ink rgb(255,0,0),0
endif
text 250,347,"PAID":text 364,347,"CREDITS":text 486,347,"COINS BET"
if paid > 0 then text 230,375,str$(paid)
text 358,375,str$(credits):text 520,375,str$(bet)
return
SPIN:
do
`spin reels
  if go1 = 0 then xrotate object 10,wrapvalue(object angle x(10)-6)
  if go2 = 0 then xrotate object 11,wrapvalue(object angle x(11)-6)
  if go3 = 0 then xrotate object 12,wrapvalue(object angle x(12)-6)
`stop reels
  if timer() >= oldTime#+1200
    go1 = 1:hit = virtual(r1,1):hit1 = actual(hit):pay(1) = hit:xrotate object 10,hit1
  endif
  if timer() >= oldTime#+1800
    go2 = 1:hit = virtual(r2,2):hit1 = actual(hit):pay(2) = hit:xrotate object 11,hit1
  endif
  if timer() >= oldTime#+2300
    go3 = 1:hit = virtual(r3,3):hit1 = actual(hit):pay(3) = hit:xrotate object 12,hit1
    oldTime# = timer()
  endif
gosub viewports
sync
  if go3 = 1 then return
loop
return
payout:
`jackpot
if pay(1) = 11 and pay(2) = 11 and pay(3) = 11 then paid = 5000*bet:inc credits,5000*bet
`3 red sevens
if pay(1) = 1 or pay(1) = 13
  if pay(2) = 1 or pay(2) = 13
     if pay(3) = 1 or pay(3) = 13
        paid = 1000*bet:inc credits,1000*bet:nos = 3
endif:endif:endif
`3 white sevens
if pay(1) = 3 or pay(1) = 15
  if pay(2) = 3 or pay(2) = 15
     if pay(3) = 3 or pay(3) = 15
        paid = 200*bet:inc credits,200*bet
endif:endif:endif
`3 blue sevens
if pay(1) = 5 or pay(1) = 17
  if pay(2) = 5 or pay(2) = 17
     if pay(3) = 5 or pay(3) = 17
        paid = 100*bet:inc credits,100*bet
endif:endif:endif
`3 white bars
if pay(1) = 7 or pay(1) = 19
  if pay(2) = 7 or pay(2) = 19
     if pay(3) = 7 or pay(3) = 19
        paid = 50*bet:inc credits,50*bet
endif:endif:endif
`3 red bars
if pay(1) = 9 or pay(1) = 21
  if pay(2) = 9 or pay(2) = 21
     if pay(3) = 9 or pay(3) = 21
        paid = 25*bet:inc credits,25*bet
endif:endif:endif
`any 2 red sevens
  if nos < 3
    if pay(1) = 1 or pay(1) = 13 then inc nos,1
    if pay(2) = 1 or pay(2) = 13 then inc nos,1
    if pay(3) = 1 or pay(3) = 13 then inc nos,1
    if nos = 1 then paid = 2*bet:inc credits,2*bet
    if nos = 2 then paid = 10*bet:inc credits,10*bet
  endif
nos = 0
return
CREATE:
`backdrop
make object plain 8,256,206:texture object 8,2:position object 8,0,0,110
set object light 8,0
`wheel one
make object cylinder 10,10:scale object 10,400,100,400
position object 10,-12,0,16:texture object 10,1:zrotate object 10,90:fix object pivot 10
set object ambience 10,rgb(255,255,255)
`wheel two
make object cylinder 11,10:scale object 11,400,100,400:position object 11,0,0,16:zrotate object 11,90:fix object pivot 11:texture object 11,1
`wheel three
make object cylinder 12,10:scale object 12,400,100,400:position object 12,12,0,16:zrotate object 12,90:fix object pivot 12:texture object 12,1
`payline
make object plain 13,34,.3:color object 13,rgb(255,00,00):position object 13,0,0,-4.9
`left divider
make object box 14,2,30,30:color object 14,rgb(220,220,220):position object 14,-6,-8,10
set object ambience 14,rgb(230,230,230)
`right divider
make object box 15,2,30,30:color object 15,rgb(220,220,220):position object 15,6,-8,10
set object ambience 15,rgb(230,230,230)
`righ side
make object box 16,2,30,30:position object 16,18,0,10:color object 16,rgb(150,0,0)
set object ambience 16,rgb(255,0,0)
`left side
make object box 17,2,30,30:position object 17,-18,0,10:color object 17,rgb(150,0,0)
set object ambience 17,rgb(255,0,0)
`sign top
make object box 18,34,8,1:texture object 18,7:position object 18,0,11,-4.2
set object ambience 18,rgb(255,255,255)
`face bottom
make object box 19,35,8,1:texture object 19,6:position object 19,0,-11,-4
`tray
make object box 20,38,12,10:color object 20,rgb(0,0,120):position object 20,0,-20,-7:xrotate object 20,55
set object ambience 20,rgb(0,0,220)
`bet max button
make object box 21,6,6,1:texture object 21,5:position object 21,0,-16,-11:xrotate object 21,55
`bet one button
make object box 22,6,6,1:texture object 22,3:position object 22,-10,-16,-11:xrotate object 22,55
`spin reels button
make object box 23,6,6,1:texture object 23,4:position object 23,10,-16,-11:xrotate object 23,55
`exit button
make object box 24,7,2,1:color object 24,rgb(220,0,0):position object 24,-36,26,1
set object ambience 24,rgb(200,200,200)
`top
make object cylinder 25,2:color object 25,rgb(150,0,0):zrotate object 25,90:position object 25,0,15,-5:scale object 25,100,1900,100
set object ambience 25,rgb(255,0,0)
`pay chart button
make object box 26,7,2,1:color object 26,rgb(0,0,220):position object 26,-36,20,1
set object ambience 26,rgb(200,200,200)
`credit button
make object box 27,7,2,1:position object 27,-36,23,1
set object ambience 27,rgb(200,200,200)
`pay chart
sprite 1,3,410,8:rotate sprite 1,270:scale sprite 1,40:sprite 2,20,410,9:rotate sprite 2,270:scale sprite 2,40
sprite 3,37,410,10:rotate sprite 3,270:scale sprite 3,40:sprite 4,60,91,11:scale sprite 4,40
scale sprite 1,0:scale sprite 2,0:scale sprite 3,0:scale sprite 4,0
return
TEXTURES:
rem reel texture
create bitmap 1,1100,50
`color reels
ink rgb(170,170,170),0:for i = 0 to 1099:line i,0,i,1100:next i
`blue seven
ink rgb(0,0,220),0:for la=65 to 80:line la,11,la,39:next la:for la=0 to 45:line 64-la,28-la/3,64-la,38-la/4:next la
`1 red bar
ink rgb(220,0,0),0:for la=140 to 160:line la,11,la,39:next la
`white seven
ink rgb(255,255,255),0:for la=265 to 280:line la,11,la,39:next la:for la=0 to 45:line 264-la,28-la/3,264-la,38-la/4:next la
`wild
ink rgb(220,0,0),0:for la=361 to 373:line la,11,la,39:next la:ink rgb(255,255,255),0:for la=343 to 355:line la,11,la,39:next la:ink rgb(0,0,220),0:for la=325 to 337:line la,11,la,39:next la
`red seven
ink rgb(220,0,0),0:for la=465 to 480:line la,11,la,39:next la:for la=0 to 45:line 464-la,28-la/3,464-la,38-la/4:next la
`2 white bars
ink rgb(255,255,255),0:for la=555 to 567:line la,11,la,39:next la:for la=537 to 549:line la,11,la,39:next la
`blue seven
ink rgb(0,0,220),0:for la=665 to 680:line la,11,la,39:next la:for la=0 to 45:line 664-la,28-la/3,664-la,38-la/4:next la
`1 red bar
ink rgb(220,0,0),0:for la=740 to 760:line la,11,la,39:next la
`white seven
ink rgb(255,255,255),0:for la=865 to 880:line la,11,la,39:next la:for la=0 to 45:line 864-la,28-la/3,864-la,38-la/4:next la
`red seven
ink rgb(220,0,0),0:for la=965 to 980:line la,11,la,39:next la:for la=0 to 45:line 964-la,28-la/3,964-la,38-la/4:next la
`2 white bars
ink rgb(255,255,255),0:for la=1055 to 1067:line la,11,la,39:next la:for la=1037 to 1049:line la,11,la,39:next la:get image 1,0,0,1100,50:delete bitmap 1:set current bitmap 0
`backdrop
create bitmap 1,256,256:set current bitmap 1
for i = 0 to 127:ink rgb(255,i*2,i*2),0:line 0,i,256,i:next i
for i = 128 to 256:ink rgb(-i*2,-i*2,255),0:line 0,i,256,i:next i:ink rgb(255,255,255),0:line 0,128,256,128:
get image 2,0,0,256,256:delete bitmap 1:set current bitmap 0:cls
`viewport texture
create bitmap 1,256,256:set current bitmap 1:get image 6,0,0,256,256:delete bitmap 1:set current bitmap 0:cls
`sign texture
create bitmap 1,256,50:set current bitmap 1
ink rgb(230,230,230),0:for la=0 to 256:line la,0,la,50:next la
ink rgb(0,0,255),0:set text size 32:set text to bold:set text font "lucida calligraphy"
text 20,10,"Liberty":ink rgb(255,0,0),0:text 140,10,"Sevens"
get image 7,0,0,256,50:delete bitmap 1:set current bitmap 0:cls
`button textures
create bitmap 1,70,70:set current bitmap 1:set text font "verdana":set text size 14
ink rgb(200,200,200),0:for la=0 to 200:line la,0,la,200:next la:ink rgb(0,0,0),0:text 18,14,"BET":text 18,36,"ONE":get image 3,0,0,62,62:cls
ink rgb(200,200,200),0:for la=0 to 200:line la,0,la,200:next la:ink rgb(0,0,0),0:text 18,14,"MAX":text 18,36,"BET":get image 5,0,0,62,62:cls
ink rgb(200,200,200),0:for la=0 to 200:line la,0,la,200:next la:ink rgb(0,0,0),0:text 12,14,"SPIN":text 9,36,"REELS":get image 4,0,0,62,62:delete bitmap 1:set current bitmap 0
`pay chart
for ditto = 8 to 10
create bitmap 1,800,300
`color chart background
ink rgb(1,1,1),0:for i = 0 to 799:line i,0,i,800:next i
`wild
ink rgb(220,0,0),0:for la=761 to 773:line la,11,la,39:next la:ink rgb(255,255,255),0:for la=743 to 755:line la,11,la,39:next la:ink rgb(0,0,220),0:for la=725 to 737:line la,11,la,39:next la
`red seven
ink rgb(220,0,0),0:for la=665 to 680:line la,11,la,39:next la:for la=0 to 45:line 664-la,28-la/3,664-la,38-la/4:next la
`white seven
ink rgb(255,255,255),0:for la=565 to 580:line la,11,la,39:next la:for la=0 to 45:line 564-la,28-la/3,564-la,38-la/4:next la
`blue seven
ink rgb(0,0,220),0:for la=465 to 480:line la,11,la,39:next la:for la=0 to 45:line 464-la,28-la/3,464-la,38-la/4:next la
`2 white bars
ink rgb(255,255,255),0:for la=355 to 367:line la,11,la,39:next la:for la=337 to 349:line la,11,la,39:next la
`1 red bar
ink rgb(220,0,0),0:for la=240 to 260:line la,11,la,39:next la
if ditto < 10
`red seven
ink rgb(220,0,0),0:for la=165 to 180:line la,11,la,39:next la:for la=0 to 45:line 164-la,28-la/3,164-la,38-la/4:next la
endif
if ditto < 9
`red seven
ink rgb(220,0,0),0:for la=65 to 80:line la,11,la,39:next la:for la=0 to 45:line 64-la,28-la/3,64-la,38-la/4:next la
endif
get image ditto,0,0,800,300:delete bitmap 1:set current bitmap 0
next ditto
`pay chart text
create bitmap 1,305,800
`color chart back ground
ink rgb(1,1,1),0:for i = 0 to 799:line 0,i,800,i:next i
ink rgb(255,255,255),0:set text size 36
text 0,35, "Pays 5000 x Bet":text 0,135, "Pays 1000 x Bet":text 0,235, "Pays 200 x Bet":text 0,335, "Pays 100 x Bet"
text 0,435, "Pays 50 x Bet":text 0,535, "Pays 25 x Bet":text 0,635, "Any Pays 10 x Bet":text 0,735, "Any Pays 2 x Bet"
get image 11,0,0,305,800:delete bitmap 1:set current bitmap 0
return
Random:
ran = rnd(100000000):dom = ran/63:r1 = ran-(dom*63)+1:ran = rnd(100000000):dom = ran/63:r2 = ran-(dom*63)+1:ran = rnd(100000000):dom = ran/63:r3 = ran-(dom*63)+1
return
PAR:
restore PAR_CHART
  for reel = 1 to 3
    for vstop = 1 to 64
      read number:virtual(vstop,reel) = number
    next vstop
  next reel
 for tooth = 1 to 22
   read number:actual(tooth) = number
 next tooth
return
`**************************************************************************************
`first data set weights reels differently  (TIGHT)  Most realistic.
`second data set weights reels the same    (MEDIUM) eh.Win some Lose some.
`third data set weights reels the same     (LOOSE)  It`s fun to win.
`last data line is actual gears
PAR_CHART:
`data 3,11,17,1,19,12,22,4,5,15,10,13,5,3,14,21,19,7,10,16,11,15,1,4,21,12,9,20,10,17,21,7
`data 12,9,6,22,11,2,8,14,8,10,18,13,9,6,16,12,21,17,11,1,9,7,18,10,20,3,15,2,19,7,12,5
`data 12,5,19,10,14,2,11,8,16,18,4,5,12,9,1,17,7,11,20,8,3,17,6,16,10,21,2,9,13,21,6,15
`data 10,4,18,7,12,14,5,20,11,22,1,16,10,22,6,18,9,20,3,14,12,8,15,4,22,12,21,2,13,19,7,10
`data 8,14,2,17,12,7,16,10,20,12,5,4,10,19,12,3,10,21,9,18,6,16,10,1,22,7,12,2,17,8,14,4
`data 21,12,10,6,22,19,10,3,22,12,6,9,15,11,20,2,18,13,10,16,5,12,8,20,7,19,10,18,4,21,9,14

`data 7,14,10,3,5,17,8,1,12,10,19,14,5,22,2,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
`data 18,8,2,12,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9
`data 7,14,10,3,5,17,8,1,12,10,19,14,5,22,2,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
`data 18,8,2,12,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9
`data 7,14,10,3,5,17,8,1,12,10,19,14,5,22,2,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
`data 18,8,2,12,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9

data 7,14,10,3,5,17,8,1,12,9,19,14,5,21,7,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
data 18,8,2,19,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9
data 7,14,10,3,5,17,8,1,12,9,19,14,5,21,7,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
data 18,8,2,19,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9
data 7,14,10,3,5,17,8,1,12,9,19,14,5,21,7,12,9,15,4,20,11,13,17,7,1,19,3,21,10,22,6,16
data 18,8,2,19,15,10,18,13,9,19,12,19,7,16,4,3,21,9,20,1,17,7,22,6,12,21,10,2,21,5,15,9

data 230,246,99,115,164,180,196,147,131,82,66,50,34,17,263,344,328,312,0,279,295,213

`Coding Challenge #5 - Casino Gambling Game - Pachinko
`Bill Robinson
`Started 3-17-06 --- Deadline 3-29-06
`All Rights Reserved for use as a published game.
`
`Shoot balls into playing area, trying to get them in the win pockets.
`The mouse x-direction controls the Power Meter
`The Left Mouse button Fires Balls.
`The Right Mouse button controls the firing rate of the balls
`
set display mode 1024,768,32
sync on : sync rate 0

`hide mouse
autocam off
set ambient light 25
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000

` Create the ODE World
ode start
ode set world gravity 0,-5,0       :`was 0,-20,0
ode set world step  0.3             :`was 0.3
ode set world erp (0.2)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing

dim pocketinfo(10,6)
dim doorstatus(10)

#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)

global numlevels=5
global level
global levelflag
global numballs
global money

global screenxcenter
global screenycenter

`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=100
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=100
global ballsleft
global mx
global my

`walls
global leftwall=500
global rightwall=3500
global floor=0
global ceiling=4000
global backwall=250
global backwallheight
global barrierheight

`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0

`pins
global nextpinptr=3000

`Camera
global camx=2000
global camy=2000
global camz=-10000

`ODE - globals
global odeballptr

_ball_textures()                :`build textures for balls
_backwall_graphics()

screenxcenter=screen width()/2

rem --- make left wall
make object box 310,backwall,ceiling+100,50
yrotate object 310,90
color object 310,rgb(150,150,0)
position object 310,leftwall/2,ceiling/2,backwall/2
set object emissive 310,rgb(100,100,0)

rem --- make right wall
make object box 311,backwall,ceiling+100,50
yrotate object 311,-90
color object 311,rgb(150,150,0)
position object 311,rightwall+leftwall/2,ceiling/2,backwall/2

rem --- make left floor
make object box 303,rightwall/2-120,backwall+100,50
xrotate object 303,-90
zrotate object 303,-6
color object 303,rgb(0,200,0)
position object 303,rightwall/4-70+leftwall/2,floor+70,backwall/2
rem --- make right floor
make object box 306,rightwall/2-120,backwall+100,50
xrotate object 306,-90
zrotate object 306,6
color object 306,rgb(0,200,0)
position object 306,rightwall-rightwall/4+70+leftwall/2,floor+70,backwall/2

rem --- make back wall
make object box 304,rightwall,ceiling,3
color object 304,rgb(0,0,200)
position object 304,rightwall/2+leftwall/2,ceiling/2,backwall   :`position backwall
texture object 304,10

rem --- make front wall
make object box 307,rightwall,ceiling,3
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,ceiling/2,backwall-ballsize-40   :`position front wall
ode create static box 307
`ghost object on 307
hide object 307

rem --- make ceiling
make object box 305,rightwall,backwall,50
xrotate object 305,90
color object 305,rgb(0,200,200)
position object 305,rightwall/2+leftwall/2,ceiling,backwall/2
set object emissive 305,rgb(0,70,70)

rem --- Create ODE tennis balls ---
for i=1 to maxballs
   make object sphere i,ballsize          :`was i,30
   set object i,1,1,0
   color object i,rgb(255,0,0)
   set object collision off i
   position object i, 5000,5000,-5000      :`move object WAY off screen
   texture object i,rnd(5)+1
   hide object i
next i

rem --- make power bar
make object box 201,100,100,2
color object 201,rgb(255,255,0)
`position object 201,leftwall+150,ceiling-120,160   :`position power bar

rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,ceiling-120,160

rem --- win pocket placement in game ---
pocketdata:
data 800,900
data 1400,500
data 2000,700
data 2600,500
data 3200,900
data 2000,2000
restore pocketdata
pocketsize=150
for i=1 to 6
   read pocketinfo(i,1)
   read pocketinfo(i,2)
   pocketinfo(i,3)=pocketinfo(i,2)+pocketsize/2    :`y1 limit for pocket capture of ball
   pocketinfo(i,4)=pocketinfo(i,2)-pocketsize/2    :`y2 limit for pocket capture of ball
   pocketinfo(i,5)=pocketinfo(i,1)-pocketsize/2    :`x1 limit for pocket capture of ball
   pocketinfo(i,6)=pocketinfo(i,1)+pocketsize/2    :`x2 limit for pocket capture of ball
next i

rem --- make win pockets with boxes
for i=1 to 30 step 5
   make object box 320+i,pocketsize,pocketsize,3
   yrotate object 320+i,-90
   color object 320+i,rgb(255,0,0)

   make object box 321+i,pocketsize,pocketsize,3
   color object 321+i,rgb(0,255,0)

   make object box 322+i,pocketsize,pocketsize,3
   yrotate object 322+i,90
   color object 322+i,rgb(255,0,255)

   make object box 323+i,pocketsize,pocketsize,3
   xrotate object 323+i,-90
   color object 323+i,rgb(255,255,0)

   make object box 324+i,pocketsize,pocketsize,3
   color object 324+i,rgb(0,0,0)
next i

for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=0
   position object 316+i*5,locx-pocketsize/2,locy,backwall-pocketsize/2
   position object 317+i*5,locx,locy,backwall-pocketsize
   if i<6
      if i=3
         texture object 317+i*5,103
      else
         texture object 317+i*5,101
      endif
   else
      texture object 317+i*5,200
   endif
   position object 318+i*5,locx+pocketsize/2,locy,backwall-pocketsize/2
   position object 319+i*5,locx,locy-pocketsize/2,backwall-pocketsize/2
   position object 320+i*5,locx,locy,backwall-3
next i

for i=321 to 350
   ode create static box i
next i
for i=324 to 350 step 5
   color object i,rgb(0,255,255)
next i

for i=1 to 6
   if i<=5
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,4,0)
   else
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,6,0)
   endif
next i

_pin_pattern1(730,2700,5)
_pin_pattern2(870,2700,5)

_pin_pattern1(1930,3100,5)
_pin_pattern2(2070,3100,5)

_pin_pattern1(3100,2500,5)
_pin_pattern2(3240,2500,5)

rem --- make win pocket doors
doorsize=175
for i=1 to 12 step 2
   make object box 209+i,doorsize,doorsize,20
   color object 209+i,rgb(200,0,0)
   if i<=10
      zrotate object 209+i,45
   else
      zrotate object 209+i,-30
   endif
   yrotate object 209+i,-90

   make object box 210+i,doorsize,doorsize,20
   color object 210+i,rgb(200,0,200)
   if i<=10
      zrotate object 210+i,-45
   else
      zrotate object 210+i,30
   endif
   yrotate object 210+i,-90
next i

for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=backwall-pocketsize/2
   if i<=5 then doorstatus(i)=1 else doorstatus(i)=0
   if i<=5
      position object 208+i*2,locx-pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 208+i*2,locx-pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 208+i*2

   if i<=5
      position object 209+i*2,locx+pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 209+i*2,locx+pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 209+i*2
next i

`-------------------------------------------------------

ode create static box 303     :`floor left
ode create static box 306     :`floor right
ode create static box 305     :`ceiling
ode create static box 310     :`left wall
ode create static box 311     :`right wall
ode create static box 304     :`tell ODE about backwall
`ode set contact bounce 304,1
ode set contact fdir1 303,0.0                 :` was 30.0  Add FRICTION
ode set contact fdir1 306,0.0                 :` was 30.0  Add FRICTION
`--------------------------------------------------------

nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=100         :`how many balls on screen at the same time
numballs=500            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=150          :`pause between each ball being fired
level=1                 :`start at this level

set camera FOV 25
position camera camx,camy,camz
point camera camx,camy,camz+1500         :`was targetx#,targety#,targetz#
position mouse screenxcenter,screenycenter
ballcheck=1


ink rgb(255,255,255),0
rem ----- main loop -----------------------------------------------------
do
`   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
`   if keypress>0 then _key_action(keypress)

   mx=mousex()

   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_tennis_ball         :`FIRE!
   if mousebutton=2
      balltiming=120-mx/10                               :`faster shooting rate adjust
      position object 202,rightwall-1050+mx,ceiling-120,160
   else
      position object 201,leftwall+mx,ceiling-120,160
   endif

`  --- clear balls falling thru bottom hole
   if object position y(ballcheck)<-100
      position object ballcheck,5000,500,-5000
      hide object ballcheck
      ode destroy object ballcheck
      dec ballcount
   endif
   inc ballcheck
   if ballcheck>maxballs then ballcheck=1

   if pocketsopen=0
      if bonusopenflag=0
         _open_bonus(6)
      endif
   else
      if bonusopenflag=1
         _close_bonus(6)
      endif
   endif

   gosub _check_pockets
   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   sync
loop
rem --------------------------------------------------------------------
ode end
end


function _open_bonus(pocketnum)
if doorstatus(pocketnum)=1 then exitfunction
_open_doors(pocketnum)
doorstatus(pocketnum)=1
bonusopenflag=1
endfunction


function _close_bonus(pocketnum)
if doorstatus(pocketnum)=0 then exitfunction
_close_doors(pocketnum)
doorstatus(pocketnum)=0
bonusopenflag=0
endfunction


rem --- show score on screen
_show_score:
set cursor 1,1
print screen fps()
center text screenxcenter,2,"Money Left: $"+str$(numballs)
`print "ballcount=";ballcount
`print "pocketsopen=";pocketsopen
`print "bonusflag=";bonusopenflag
return


rem ---------- fires tennis balls ----------
_fire_tennis_ball:
if ballcount=ballsatonce then return
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of tennis balls
if numballs=0                          :`out of tennis balls to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif

ballx#=300
bally#=3300
ballz#=backwall-ballsize-20

`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
show object odeballptr

ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,40                 :`was 20
ode set contact bounce odeballptr,1

ode set linear velocity odeballptr,50+mx*2,mx,0.0
ode set contact fdir1 odeballptr,0.0                 :` was 30.0  Add FRICTION

dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired

inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return


_check_pockets:
for i=1 to maxballs
   y=object position y(i)
   for j=1 to 6
      if y<pocketinfo(j,3)
         if y>pocketinfo(j,4)
            x=object position x(i)
            if x>pocketinfo(j,5)
               if x<pocketinfo(j,6)
                  hide object i
                  ode destroy object i
                  position object i, 5000,5000,-5000
                  dec ballcount
                  _change_doors(j)
                  sync
               endif
            endif
         endif
      endif
   next j
next i
return


function _change_doors(pocketnum)
if doorstatus(pocketnum)=1
   inc numballs,1
   _close_doors(pocketnum)
   if pocketnum=6
      for i=1 to 5
         _open_doors(i)
      next i
      inc numballs,100
      bonusopenflag=0
   endif
else
   inc numballs,3
   _open_doors(pocketnum)
endif
endfunction


function _open_doors(pocketnum)
if doorstatus(pocketnum)=0
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=1
   if pocketnum=6
      ang=0
      offset=pocketsize/2
   else
      ang=45
      offset=pocketsize
      inc pocketsopen
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _close_doors(pocketnum)
if doorstatus(pocketnum)=1
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=0
   if pocketnum=6
      ang=-30
      offset=pocketsize/4
   else
      ang=0
      offset=pocketsize/2
      dec pocketsopen
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _finished_level(level)
set cursor 1,200
print "YOU FINISHED LEVEL - ";level
print "Press a key to continue"
sync
wait key
if level=numlevels
   print "  "
   print "That's all there is for now - Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction


function _key_action(keypress)
select keypress
   case 20
      if level>=8
         balltiming=balltiming-10
         wait 100
         if balltiming<40 then balltiming=100
      endif
   endcase
endselect
endfunction


function _ball_textures()
for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i,0,0,50,50
   delete bitmap i
next i
endfunction


function _make_pin(x,y)
make object box nextpinptr,12,200,12
xrotate object nextpinptr,90
zrotate object nextpinptr,45
position object nextpinptr,x,y,backwall-100
ode create static box nextpinptr
endfunction


function _pin_pattern1(x,y,numpins)
xspacing=50
yspacing=50
xpos=x      :`-(numpins*xspacing/2)
ypos=y      :`+(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
dec xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
dec xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   dec xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern2(x,y,numpins)
xspacing=50
yspacing=50
xpos=x         :`-(numpins*xspacing/2)
ypos=y         :`-(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
inc xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
inc xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   inc xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern3(x,y,numrows,startpins,pininc)
xspacing=120
yspacing=110
if startpins=1
   xpos=x
   offset=0
else
   offset=xspacing/2
   xpos=x-((startpins-1)*xspacing/2)
endif
ypos=y
for i=1 to numrows
   for j=1 to startpins
      _make_pin(xpos,ypos)
      inc xpos,xspacing
      inc nextpinptr
   next j
   inc ypos,yspacing
   if offset<>0 then offset=offset*-1
      if offset<0
         xpos=x-((startpins-1)*xspacing/2)-offset
      else
         xpos=x-((startpins-1)*xspacing/2)
      endif
next i
endfunction


function _backwall_graphics()
ink rgb(255,255,255),rgb(0,0,200)
`ink rgb(0,0,200),0
`box 0,0,1024,768
`ink rgb(255,255,255),0
cls rgb(0,200,00)
set cursor 5,5
print 1
get image 101,0,0,20,20
cls rgb(0,200,00)
set cursor 5,5
print 3
get image 103,0,0,20,20
cls rgb(0,200,00)
set cursor 0,5
set text size 10
print 100
get image 200,0,0,30,30
remstart
for i= 1 to 30
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   ellipse rnd(400),50+rnd(400),rnd(100),rnd(100)
next i
blur bitmap 0,2
remend
cls
`ink rgb(255,255,255),0
set cursor 55,25
set text size 16
print "POWER METER"
for i=30 to 200 step 20
   line i,5,i,25
next i

set cursor 340,25
print "FIRING RATE METER"
for i=320 to 480 step 20
   line i,5,i,25
next i
get image 10,0,0,512,512,1
endfunction

sync on
sync rate 40
set display mode 1024,768,16
autocam off
hide mouse
randomize timer()

set global collision on
global speed# = 10.0
global size = 200
global money = 500
global bid = 0
global amount = 0
global winner
global weather
global weather_name$

intro()
textures()
media()
camera()
bets()

do
   winner = check_winner()
   if winner > 0 then post_winner(winner)
   race()
   camera_change()
   sync
loop


function post_winner(winner)
center text screen width()/2,screen height()/2,"The WINNER is horse "+str$(winner)
sync
check()
endfunction

function check_winner()
hitnum = object collision(100,0)
endfunction hitnum

function media()
`make horses
for h = 1 to 5
make object box h,3,3,3
next h
`make wall object
make object box 100,60,5,5
position object 100,20,0,200
ghost object on 100
`make matrix
make matrix 1,50,size,10,10
prepare matrix texture 1,1,1,1
position matrix 1,0,-1,0
`positioning horses
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
endfunction

function camera_change()
`different camera position
if keystate(3)
position camera 0,30,10,140
`point camera 0,0,-10,-100
point camera 0,object position x(3),object position y(3),object position z(3)
else
position camera 0,170,50,100
point camera 0,-100,0,100
endif
endfunction

function camera()
`camera position
position camera 0,170,50,100
point camera 0,-100,0,100
endfunction

function race()
`set info box
box 0,0,1024,100,rgb(125,120,250),rgb(15,220,50),rgb(212,20,50),rgb(75,70,80)
set cursor 450,10
print "Current money: $",money,
set cursor 450,25
print "Betting horse: ",bid,
set cursor 450,40
print "Weather conditions:",weather_name$,
if weather < 10
`store sunny weather values
ran1# = rnd(8)/speed#+rnd(0.8)
ran2# = rnd(8)/speed#+rnd(0.7)
ran3# = rnd(7)/speed#+rnd(0.6)
ran4# = rnd(8)/speed#+rnd(0.4)
ran5# = rnd(8)/speed#+rnd(0.5)
else
if weather > 10
`store rainy weather values
ran1# = rnd(7)/speed#+rnd(0.7)
ran2# = rnd(8)/speed#+rnd(0.6)
ran3# = rnd(8)/speed#+rnd(0.7)
ran4# = rnd(8)/speed#+rnd(0.5)
ran5# = rnd(8)/speed#+rnd(0.6)
endif
endif
`move horses
move object 1,ran1#
move object 2,ran2#
move object 3,ran3#
move object 4,ran4#
move object 5,ran5#
endfunction

function textures()
`makes textures for game
for x = 1 to 300
for y = 1 to 300
color = rgb(rnd(50),rnd(200),rnd(169))
dot x,y,color
next x
next y
get image 1,0,0,300,300
`make another texture
for x = 1 to 300
for y = 1 to 300
color1 = rgb(rnd(148),rnd(128),rnd(100))
dot x,y,color1
next x
next y
get image 2,0,0,300,300
endfunction

function intro()
`Give introduction
set text font "Arial"
ink rgb(255,0,0),0
set text size 27
sync
center text 512,300,"Horbox Racing"
ink rgb(0,192,23),0
set text size 17
center text 512,330,"Place your bets, watch your horses and hopefully"
center text 512,360,"win some more money! Bid carfully though or you might"
center text 512,390,"end up broke!"
ink rgb(24,24,255),0
center text 768,690,"Bronze edition Created by Benjamin"
sync
wait key
cls
ink rgb(255,0,0),0
set text to bold
center text 512,280,"Gameplay:"
set text to normal
ink rgb(0,192,23),0
center text 512,295,"Place your bet on the horse you think will win watch them"
center text 512,310,"in the arena and see if you win! Becareful though, weather"
center text 512,325,"will effect your horse. For better or worse!"
ink rgb(255,0,0),0
set text to bold
center text 512,340,"Controls:"
set text to normal
ink rgb(0,192,23),0
center text 512,355,"While the game is in play press the number '2' button to"
center text 512,370,"change the camera view to a more cinematic look and feel!"
ink rgb(255,0,0),0
set text to bold
center text 512,385,"Weather:"
set text to normal
ink rgb(0,192,23),0
center text 512,400,"There are currently two different types of weather that can"
center text 512,415,"effect your horse, Sun and Rain. Being simple humans we can not"
center text 512,430,"predict the weather! We have to wait for the race to begin!"
ink rgb(255,0,0),0
set text to bold
center text 512,445,"Horses:"
set text to normal
ink rgb(0,192,23),0
center text 512,460,"Horse one: Fast in the sun, quick in the rain. Odds 1:2"
center text 512,475,"Horse two: Quick in the sun, average in the rain. Odds 1:3"
center text 512,490,"Horse three: Average in the sun, quick in the rain. Odds 1:5"
center text 512,505,"Horse four: Slow in the sun, average in the rain. Odds 1:10"
center text 512,520,"Horse five: Average in the sun, average in the rain. Odds 1:8"
center text 512,550,"Press any key"
sync
wait key
endfunction

function bets()
`place your bets!
`reset every all the hores
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
`reset the camera position
position camera 0,170,50,100
point camera 0,-100,0,100
`make the weather effect
weather = rnd(20)
if weather < 10
prepare matrix texture 1,1,1,1
weather_name$ = "Sunny"
else
if weather > 10
prepare matrix texture 1,2,1,1
weather_name$ = "Rainy"
endif
endif
`on with the game!!
cls
sync
`sets the text colour and size
ink rgb(255,255,255),0
set text size 20
set text to bold
`makes the two boxes that will hold my text positionins them and rotates them
make object box 200,0,0.3,2
make object box 210,0,0.3,2
`rotate objects
for i = 200 to 210 step 10
xrotate object i,0
zrotate object i,0
next i
`positions all the objects
position object 200,camera position x(0)-5,camera position y(0)-0,camera position z(0)
position object 210,camera position x(0)-5,camera position y(0)-0.8,camera position z(0)
`get all the text into images for our objects
ink rgb(255,255,255),0
check$ = "Set bid amount:"
info$ = "Choose horse 1-5:"
text 0,0,check$
get image 3,0,0,text width(check$),text height(check$),1
texture object 200,3
`next image
cls
ink rgb(255,255,255),0
sync
text 0,0,info$
get image 4,0,0,text width(info$),text height(info$),2
texture object 210,4
set object light 200,0
set object light 210,0
`Another text box!
cls
ink rgb(255,0,0),0
center text 512,384,"Current Money:$"+str$(money)
center text 512,404,"Press any key"
sync
wait key
ink rgb(255,255,255),0
`get amount
money:
set cursor 512,300
input amount
if amount > money then goto money
if amount <= 0 then goto money
money = money-amount
bid:
set cursor 512,390
input bid
if bid > 5 then goto bid
if bid <= 0 then goto bid
`refresh screen and sets text colours back to normal
ink rgb(255,255,255),0
`deletes objects
for i = 200 to 210 step 10
delete object i
next i
`bye bye
endfunction

function winning()
`shows you have won
center text 512,384,"YOU WIN MONEY!!!"
`horse one
if bid = 1 and winner = 1
money = amount*2+money
endif
`horse two
if bid = 2 and winner = 2
money = amount*3+money
endif
`horse three
if bid = 3 and winner = 3
money = amount*5+money
endif
`horse one
if bid = 4 and winner = 4
money = amount*10+money
endif
`horse one
if bid = 5 and winner = 5
money = amount*8+money
endif
sync
wait key
bets()
endfunction

function losing()
`shows that you have lost
center text 512,384,"YOU LOSE MONEY!!!"
money = money
if money = 0 then exit_()
sync
wait key
bets()
endfunction

function check()
`check to see if you have won
wait key
ink rgb(255,255,255,),0
cls
if bid = winner
winning()
else
if bid <> winner
losing()
endif
endif
endfunction

function exit_()
cls
ink rgb(255,255,255,),0
center text 512,384,"Sorry kid your out of Mula!!"
sync
wait key
end
endfunction

sync on
sync rate 40
set display mode 1024,768,16
autocam off
hide mouse
randomize timer()

set global collision on
global speed# = 10.0
global size = 200
global money = 500
global bid = 0
global amount = 0
global winner
global weather
global weather_name$

intro()
textures()
media()
camera()
bets()

do
   winner = check_winner()
   if winner > 0 then post_winner(winner)
   race()
   camera_change()
   sync
loop


function post_winner(winner)
center text screen width()/2,screen height()/2,"The WINNER is horse "+str$(winner)
sync
check()
endfunction

function check_winner()
hitnum = object collision(100,0)
endfunction hitnum

function media()
`make horses
for h = 1 to 5
make object box h,3,3,3
next h
`make wall object
make object box 100,60,5,5
position object 100,20,0,200
ghost object on 100
`make matrix
make matrix 1,50,size,10,10
prepare matrix texture 1,1,1,1
position matrix 1,0,-1,0
`positioning horses
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
endfunction

function camera_change()
`different camera position
if keystate(3)
position camera 0,30,10,140
`point camera 0,0,-10,-100
point camera 0,object position x(3),object position y(3),object position z(3)
else
position camera 0,170,50,100
point camera 0,-100,0,100
endif
endfunction

function camera()
`camera position
position camera 0,170,50,100
point camera 0,-100,0,100
endfunction

function race()
`set info box
box 0,0,1024,100,rgb(125,120,250),rgb(15,220,50),rgb(212,20,50),rgb(75,70,80)
set cursor 450,10
print "Current money: $",money,
set cursor 450,25
print "Betting horse: ",bid,
set cursor 450,40
print "Weather conditions:",weather_name$,
if weather < 10
`store sunny weather values
ran1# = rnd(8)/speed#+rnd(0.8)
ran2# = rnd(8)/speed#+rnd(0.7)
ran3# = rnd(7)/speed#+rnd(0.6)
ran4# = rnd(8)/speed#+rnd(0.4)
ran5# = rnd(8)/speed#+rnd(0.5)
else
if weather > 10
`store rainy weather values
ran1# = rnd(7)/speed#+rnd(0.7)
ran2# = rnd(8)/speed#+rnd(0.6)
ran3# = rnd(8)/speed#+rnd(0.7)
ran4# = rnd(8)/speed#+rnd(0.5)
ran5# = rnd(8)/speed#+rnd(0.6)
endif
endif
`move horses
move object 1,ran1#
move object 2,ran2#
move object 3,4
move object 4,ran4#
move object 5,ran5#
endfunction

function textures()
`makes textures for game
for x = 1 to 300
for y = 1 to 300
color = rgb(rnd(50),rnd(200),rnd(169))
dot x,y,color
next x
next y
get image 1,0,0,300,300
`make another texture
for x = 1 to 300
for y = 1 to 300
color1 = rgb(rnd(148),rnd(128),rnd(100))
dot x,y,color1
next x
next y
get image 2,0,0,300,300
endfunction

function intro()
`Give introduction
set text font "Arial"
ink rgb(255,0,0),0
set text size 27
sync
center text 512,300,"Horbox Racing"
ink rgb(0,192,23),0
set text size 17
center text 512,330,"Place your bets, watch your horses and hopefully"
center text 512,360,"win some more money! Bid carfully though or you might"
center text 512,390,"end up broke!"
ink rgb(24,24,255),0
center text 768,690,"Bronze edition Created by Benjamin"
sync
wait key
cls
ink rgb(255,0,0),0
set text to bold
center text 512,280,"Gameplay:"
set text to normal
ink rgb(0,192,23),0
center text 512,295,"Place your bet on the horse you think will win watch them"
center text 512,310,"in the arena and see if you win! Becareful though, weather"
center text 512,325,"will effect your horse. For better or worse!"
ink rgb(255,0,0),0
set text to bold
center text 512,340,"Controls:"
set text to normal
ink rgb(0,192,23),0
center text 512,355,"While the game is in play press the number '2' button to"
center text 512,370,"change the camera view to a more cinematic look and feel!"
ink rgb(255,0,0),0
set text to bold
center text 512,385,"Weather:"
set text to normal
ink rgb(0,192,23),0
center text 512,400,"There are currently two different types of weather that can"
center text 512,415,"effect your horse, Sun and Rain. Being simple humans we can not"
center text 512,430,"predict the weather! We have to wait for the race to begin!"
ink rgb(255,0,0),0
set text to bold
center text 512,445,"Horses:"
set text to normal
ink rgb(0,192,23),0
center text 512,460,"Horse one: Fast in the sun, quick in the rain. Odds 1:2"
center text 512,475,"Horse two: Quick in the sun, average in the rain. Odds 1:3"
center text 512,490,"Horse three: Average in the sun, quick in the rain. Odds 1:5"
center text 512,505,"Horse four: Slow in the sun, average in the rain. Odds 1:10"
center text 512,520,"Horse five: Average in the sun, average in the rain. Odds 1:8"
center text 512,550,"Press any key"
sync
wait key
endfunction

function bets()
`place your bets!
`reset every all the hores
position object 1,48,0,0
position object 2,38,0,0
position object 3,28,0,0
position object 4,18,0,0
position object 5,8,0,0
`reset the camera position
position camera 0,170,50,100
point camera 0,-100,0,100
`make the weather effect
weather = rnd(20)
if weather < 10
prepare matrix texture 1,1,1,1
weather_name$ = "Sunny"
else
if weather > 10
prepare matrix texture 1,2,1,1
weather_name$ = "Rainy"
endif
endif
`on with the game!!
cls
sync
`sets the text colour and size
ink rgb(255,255,255),0
set text size 20
set text to bold
`makes the two boxes that will hold my text positionins them and rotates them
make object box 200,0,0.3,2
make object box 210,0,0.3,2
`rotate objects
for i = 200 to 210 step 10
xrotate object i,0
zrotate object i,0
next i
`positions all the objects
position object 200,camera position x(0)-5,camera position y(0)-0,camera position z(0)
position object 210,camera position x(0)-5,camera position y(0)-0.8,camera position z(0)
`get all the text into images for our objects
ink rgb(255,255,255),0
check$ = "Set bid amount:"
info$ = "Choose horse 1-5:"
text 0,0,check$
get image 3,0,0,text width(check$),text height(check$),1
texture object 200,3
`next image
cls
ink rgb(255,255,255),0
sync
text 0,0,info$
get image 4,0,0,text width(info$),text height(info$),2
texture object 210,4
set object light 200,0
set object light 210,0
`Another text box!
cls
ink rgb(255,0,0),0
center text 512,384,"Current Money:$"+str$(money)
center text 512,404,"Press any key"
sync
wait key
ink rgb(255,255,255),0
`get amount
money:
set cursor 512,300
input amount
if amount > money then goto money
if amount <= 0 then goto money
money = money-amount
bid:
set cursor 512,390
input bid
if bid > 5 then goto bid
if bid <= 0 then goto bid
`refresh screen and sets text colours back to normal
ink rgb(255,255,255),0
`deletes objects
for i = 200 to 210 step 10
delete object i
next i
`bye bye
endfunction

function winning()
`shows you have won
center text 512,384,"YOU WIN MONEY!!!"
`horse one
if bid = 1 and winner = 1
money = amount*2+money
endif
`horse two
if bid = 2 and winner = 2
money = amount*3+money
endif
`horse three
if bid = 3 and winner = 3
money = amount*5+money
endif
`horse one
if bid = 4 and winner = 4
money = amount*10+money
endif
`horse one
if bid = 5 and winner = 5
money = amount*8+money
endif
sync
wait key
bets()
endfunction

function losing()
`shows that you have lost
center text 512,384,"YOU LOSE MONEY!!!"
money = money
if money = 0 then exit_()
sync
wait key
bets()
endfunction

function check()
`check to see if you have won
wait key
ink rgb(255,255,255,),0
cls
if bid = winner
winning()
else
if bid <> winner
losing()
endif
endif
endfunction

function exit_()
cls
ink rgb(255,255,255,),0
center text 512,384,"Sorry kid your out of Mula!!"
sync
wait key
end
endfunction

`Coding Challenge #5 - Casino Gambling Game - Pachinko
`Bill Robinson
`Started 3-17-06 --- Deadline 3-29-06
`All Rights Reserved for use as a published game.
`
`Shoot balls into playing area, trying to get them in the win pockets.
`The mouse x-direction controls the Power Meter
`The Left Mouse button Fires Balls.
`The Right Mouse button controls the firing rate of the balls
`If you get below $100, press the 'T' key spend another $100 in balls from the Teller.
`
set display mode 1024,768,32
sync on : sync rate 0

`hide mouse
autocam off
set ambient light 25
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000

` Create the ODE World
ode start
ode set world gravity 0,-5,0       :`was 0,-20,0
ode set world step  0.3             :`was 0.3
ode set world erp (0.2)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing

dim pocketinfo(10,10)
dim doorstatus(10)

#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)

global numlevels=5
global level
global levelflag
global numballs
global money

global screenxcenter
global screenycenter

`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=100
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=100
global ballsleft
global mx
global my

`walls
global leftwall=500
global rightwall=3500
global floor=0
global ceiling=4000
global backwall=250
global backwallheight
global barrierheight

`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0

`pins
global nextpinptr=3000

`Camera
global camx=2000
global camy=2000
global camz=-10000

`ODE - globals
global odeballptr

_ball_textures()                :`build textures for balls
_backwall_graphics()
gosub _intro

screenxcenter=screen width()/2

rem --- make left wall
make object box 310,backwall,ceiling+100,50
yrotate object 310,90
color object 310,rgb(100,100,0)
position object 310,leftwall/2,ceiling/2,backwall/2
set object emissive 310,rgb(100,100,0)

rem --- make right wall
make object box 311,backwall,ceiling+100,50
yrotate object 311,-90
color object 311,rgb(150,150,0)
position object 311,rightwall+leftwall/2,ceiling/2,backwall/2

remstart
rem --- make left floor
make object box 303,rightwall/2-120,backwall+100,50
xrotate object 303,-90
zrotate object 303,-6
color object 303,rgb(0,200,0)
position object 303,rightwall/4-70+leftwall/2,floor+70,backwall/2
rem --- make right floor
make object box 306,rightwall/2-120,backwall+100,50
xrotate object 306,-90
zrotate object 306,6
color object 306,rgb(0,200,0)
position object 306,rightwall-rightwall/4+70+leftwall/2,floor+70,backwall/2
remend

rem --- make back wall
make object box 304,rightwall,ceiling,3
color object 304,rgb(0,0,200)
position object 304,rightwall/2+leftwall/2,ceiling/2,backwall   :`position backwall
texture object 304,10

rem --- make front wall
make object box 307,rightwall,ceiling,3
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,ceiling/2,backwall-ballsize-40   :`position front wall
ode create static box 307
`ghost object on 307
hide object 307

rem --- make ceiling
make object box 305,rightwall,backwall,50
xrotate object 305,90
color object 305,rgb(100,100,0)
position object 305,rightwall/2+leftwall/2,ceiling,backwall/2
set object emissive 305,rgb(100,100,0)

rem --- Create ODE tennis balls ---
for i=1 to maxballs
   make object sphere i,ballsize          :`was i,30
   set object i,1,1,0
   color object i,rgb(255,0,0)
   set object collision off i
   position object i, 5000,5000,-5000      :`move object WAY off screen
   texture object i,rnd(5)+11
   hide object i
next i

rem --- make power bar
make object box 201,100,100,2
color object 201,rgb(255,255,0)
`position object 201,leftwall+150,ceiling-120,160   :`position power bar

rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,ceiling-120,160

rem --- win pocket placement in game ---
pocketdata:
data 800,900
data 1400,500
data 2000,700
data 2600,500
data 3200,900
data 2000,2000
restore pocketdata
pocketsize=150
for i=1 to 6
   read pocketinfo(i,1)
   read pocketinfo(i,2)
   pocketinfo(i,3)=pocketinfo(i,2)+pocketsize/2    :`y1 limit for pocket capture of ball
   pocketinfo(i,4)=pocketinfo(i,2)-pocketsize/2    :`y2 limit for pocket capture of ball
   pocketinfo(i,5)=pocketinfo(i,1)-pocketsize/2    :`x1 limit for pocket capture of ball
   pocketinfo(i,6)=pocketinfo(i,1)+pocketsize/2    :`x2 limit for pocket capture of ball
next i

rem --- make win pockets with boxes
for i=1 to 30 step 5
   make object box 320+i,pocketsize,pocketsize,3
   yrotate object 320+i,-90
   color object 320+i,rgb(255,0,0)

   make object box 321+i,pocketsize,pocketsize,3
   color object 321+i,rgb(0,255,0)

   make object box 322+i,pocketsize,pocketsize,3
   yrotate object 322+i,90
   color object 322+i,rgb(255,0,255)

   make object box 323+i,pocketsize,pocketsize,3
   xrotate object 323+i,-90
   color object 323+i,rgb(255,255,0)

   make object box 324+i,pocketsize,pocketsize,3
   color object 324+i,rgb(0,0,0)
next i

rem --- position win pockets and texture them
for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=0
   position object 316+i*5,locx-pocketsize/2,locy,backwall-pocketsize/2
   position object 317+i*5,locx,locy,backwall-pocketsize
   pocketinfo(i,7)=317+i*5       :`save object# for texturing later
   if i<6
      texture object 317+i*5,1
   else
      texture object 317+i*5,3
   endif
   position object 318+i*5,locx+pocketsize/2,locy,backwall-pocketsize/2
   position object 319+i*5,locx,locy-pocketsize/2,backwall-pocketsize/2
   position object 320+i*5,locx,locy,backwall-3
next i

rem --- create ODE instances of win pockets
for i=321 to 350
   ode create static box i
next i
for i=324 to 350 step 5
   color object i,rgb(0,255,255)
next i

rem --- create pin patterns above win pockets
for i=1 to 6
   if i<=5
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,4,0)
   else
      _pin_pattern3(pocketinfo(i,1),pocketinfo(i,2)+325,4,6,0)
   endif
next i

_pin_pattern1(745,2700,5)
_pin_pattern2(880,2700,5)

_pin_pattern1(1935,3100,5)
_pin_pattern2(2070,3100,5)

_pin_pattern1(3105,2500,5)
_pin_pattern2(3240,2500,5)

rem --- make win pocket doors
doorsize=175
for i=1 to 12 step 2
   make object box 209+i,doorsize,doorsize,20
   color object 209+i,rgb(200,0,200)
   if i<=10
      zrotate object 209+i,45
   else
      zrotate object 209+i,-30
   endif
   yrotate object 209+i,-90

   make object box 210+i,doorsize,doorsize,20
   color object 210+i,rgb(200,0,200)
   if i<=10
      zrotate object 210+i,-45
   else
      zrotate object 210+i,30
   endif
   yrotate object 210+i,-90
next i

for i=1 to 6
   locx=pocketinfo(i,1)
   locy=pocketinfo(i,2)
   locz=backwall-pocketsize/2
   if i<=5 then doorstatus(i)=1 else doorstatus(i)=0
   if i<=5
      position object 208+i*2,locx-pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 208+i*2,locx-pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 208+i*2

   if i<=5
      position object 209+i*2,locx+pocketsize,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   else
      position object 209+i*2,locx+pocketsize/4,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   endif
   ode create static box 209+i*2
next i

`-------------------------------------------------------

`ode create static box 303     :`floor left
`ode create static box 306     :`floor right
ode create static box 305     :`ceiling
ode create static box 310     :`left wall
ode create static box 311     :`right wall
ode create static box 304     :`tell ODE about backwall
`ode set contact bounce 304,1
`ode set contact fdir1 303,0.0                 :` was 30.0  Add FRICTION
`ode set contact fdir1 306,0.0                 :` was 30.0  Add FRICTION
`--------------------------------------------------------

nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=100         :`how many balls on screen at the same time
numballs=100            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=150          :`pause between each ball being fired
level=1                 :`start at this level

set camera FOV 25                         :`use a zoom lens
position camera camx,camy,camz            :`set camera FAR away, so pins in the game look straighter!
point camera camx,camy,camz+1500          :`was targetx#,targety#,targetz#
position mouse 10,10
ballcheck=1

rem ----- main loop -----------------------------------------------------
do
   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
   if keypress>0 then _key_action(keypress)

   mx=mousex()
   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_tennis_ball         :`FIRE!
   if mousebutton=2
      balltiming=120-mx/10                               :`faster shooting rate adjust
      position object 202,rightwall-1050+mx,ceiling-120,160
   else
      position object 201,leftwall+mx,ceiling-120,160
   endif

`  --- clear balls falling thru bottom hole
   if object position y(ballcheck)<-100
      position object ballcheck,5000,500,-5000
      hide object ballcheck
      ode destroy object ballcheck
      dec ballcount
   endif
   inc ballcheck
   if ballcheck>maxballs then ballcheck=1

   if pocketsopen=0
      if bonusopenflag=0
         _open_bonus(6)
      endif
   else
      if bonusopenflag=1
         _close_bonus(6)
      endif
   endif

   if bonusopenflag=1
      inc flash
      if flash=20
         texture object 347,4
      else
         if flash=40
            texture object 347,3
            flash=1
         endif
      endif
   endif

   gosub _check_pockets
   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   sync
loop
rem --------------------------------------------------------------------
ode end
end


function _open_bonus(pocketnum)
if doorstatus(pocketnum)=1 then exitfunction
_open_doors(pocketnum)
doorstatus(pocketnum)=1
bonusopenflag=1
texture object 347,4
endfunction


function _close_bonus(pocketnum)
if doorstatus(pocketnum)=0 then exitfunction
_close_doors(pocketnum)
doorstatus(pocketnum)=0
bonusopenflag=0
texture object 347,3
endfunction


rem --- show score on screen
_show_score:
set cursor 1,1
`print screen fps()
center text screenxcenter,2,"Money Left: $"+str$(numballs)
`print "ballcount=";ballcount
`print "pocketsopen=";pocketsopen
`print "bonusflag=";bonusopenflag
return


rem ---------- fires tennis balls ----------
_fire_tennis_ball:
if ballcount=ballsatonce then return
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of tennis balls
if numballs=0                          :`out of tennis balls to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif

ballx#=300
bally#=3300
ballz#=backwall-ballsize-20

`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
show object odeballptr

ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,40                 :`was 20
ode set contact bounce odeballptr,1

ode set linear velocity odeballptr,50+mx*2,mx,0.0
ode set contact fdir1 odeballptr,0.0                 :` was 30.0  Add FRICTION

dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired

inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return


_check_pockets:
for i=1 to maxballs
   y=object position y(i)              :`get each balls y position
   for j=1 to 6                        :`check all 6 pockets
      if y<pocketinfo(j,3)             :`check top of each pocket
         if y>pocketinfo(j,4)          :`check bottom of each pocket
            x=object position x(i)     :`get each balls x position
            if x>pocketinfo(j,5)       :`check left side of each pocket
               if x<pocketinfo(j,6)    :`check right side of each pocket
                  hide object i        :`yep, ball must be in pocket
                  ode destroy object i
                  position object i, 5000,5000,-5000
                  dec ballcount
                  _change_doors(j)
                  sync
               endif
            endif
         endif
      endif
   next j
next i
return


function _change_doors(pocketnum)
if doorstatus(pocketnum)=1
   _close_doors(pocketnum)
   if pocketnum=6
      for i=1 to 5
         _open_doors(i)
      next i
      inc numballs,50
      bonusopenflag=0
   else
      inc numballs,1
   endif
else
   inc numballs,3
   _open_doors(pocketnum)
endif
endfunction


function _open_doors(pocketnum)
if doorstatus(pocketnum)=0
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=1
   if pocketnum=6
      ang=0
      offset=pocketsize/2
   else
      ang=45
      offset=pocketsize
      inc pocketsopen
      texture object pocketinfo(pocketnum,7),1
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _close_doors(pocketnum)
if doorstatus(pocketnum)=1
   locx=pocketinfo(pocketnum,1)
   locy=pocketinfo(pocketnum,2)
   locz=backwall-pocketsize/2
   doorstatus(pocketnum)=0
   if pocketnum=6
      ang=-30
      offset=pocketsize/4
   else
      ang=0
      offset=pocketsize/2
      dec pocketsopen
      texture object pocketinfo(pocketnum,7),2
   endif

   objnum=208+pocketnum*2
   zrotate object objnum,ang
   position object objnum,locx-offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum

   objnum=209+pocketnum*2
   zrotate object objnum,-ang
   position object objnum,locx+offset,locy+pocketsize/2+doorsize/2-20,backwall-pocketsize/2
   ode destroy object objnum
   ode create static box objnum
endif
endfunction


function _finished_level(level)
set cursor 1,200
print "YOU FINISHED LEVEL - ";level
print "Press a key to continue"
sync
wait key
if level=numlevels
   print "  "
   print "That's all there is for now - Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction


function _key_action(keypress)
select keypress
   case 20
      if numballs<100
         inc numballs,100
      endif
   endcase
endselect
endfunction


function _ball_textures()
for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i+10,0,0,50,50
   delete bitmap i
next i
endfunction


function _make_pin(x,y)
make object box nextpinptr,12,200,12
xrotate object nextpinptr,90
zrotate object nextpinptr,45
position object nextpinptr,x,y,backwall-100
ode create static box nextpinptr
endfunction


function _pin_pattern1(x,y,numpins)
xspacing=50
yspacing=50
xpos=x      :`-(numpins*xspacing/2)
ypos=y      :`+(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
dec xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
dec xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   dec xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern2(x,y,numpins)
xspacing=50
yspacing=50
xpos=x         :`-(numpins*xspacing/2)
ypos=y         :`-(numpins*yspacing/2)
_make_pin(xpos,ypos)
inc ypos,yspacing
inc xpos,xspacing/2
inc nextpinptr
_make_pin(xpos,ypos)
inc ypos,yspacing
inc nextpinptr
inc xpos,xspacing/2
for i=1 to numpins
   _make_pin(xpos,ypos)
   inc xpos,xspacing
   inc ypos,yspacing
   inc nextpinptr
next i
endfunction


function _pin_pattern3(x,y,numrows,startpins,pininc)
xspacing=125      :`was 120
yspacing=115      :`was 110
if startpins=1
   xpos=x
   offset=0
else
   offset=xspacing/2
   xpos=x-((startpins-1)*xspacing/2)
endif
ypos=y
for i=1 to numrows
   for j=1 to startpins
      _make_pin(xpos,ypos)
      inc xpos,xspacing
      inc nextpinptr
   next j
   inc ypos,yspacing
   if offset<>0 then offset=offset*-1
      if offset<0
         xpos=x-((startpins-1)*xspacing/2)-offset
      else
         xpos=x-((startpins-1)*xspacing/2)
      endif
next i
endfunction


function _backwall_graphics()
ink rgb(255,255,255),rgb(0,0,200)
`ink rgb(0,0,200),0
`box 0,0,1024,768
`ink rgb(255,255,255),0
cls rgb(0,170,00)
set cursor 6,7
print 1
get image 1,0,0,20,20
cls rgb(0,170,00)
set cursor 6,7
print 3
get image 2,0,0,20,20
cls rgb(0,70,00)
set cursor 2,4
`set text size 16
print 50
get image 3,0,0,20,20
cls rgb(0,170,00)
ink rgb(255,0,0),0
set cursor 2,4
`set text size 16
print 50
get image 4,0,0,20,20
remstart
for i= 1 to 30
   ink rgb(rnd(255),rnd(255),rnd(255)),0
   ellipse rnd(400),50+rnd(400),rnd(100),rnd(100)
next i
blur bitmap 0,2
remend
cls
`ink rgb(255,255,255),0
set cursor 55,25
set text size 16
print "POWER METER"
for i=30 to 200 step 20
   line i,5,i,25
next i

set cursor 340,25
print "FIRING RATE METER"
for i=320 to 480 step 20
   line i,5,i,25
next i
get image 10,0,0,512,512,1
endfunction


_intro:
sync
set text font "Arial"
set text size 30
cx=screen width()/2
cy=100

introtext:
data "-green"
data "Pachinko Game"
data "   "
data "-purple"
data "There are 15,000 pachinko gambling arcades in Japan,"
data "and for some it is much more than mere recreation."
data "Pachinko is the most popular leisure activity in Japan."
data "   "
data "40 and 50 million people--roughly a quarter of the population--"
data "play pachinko at least occasionally, and as many as 30 million are avid players."
data "   "
data "   "
data "-cyan"
data "The LEFT mouse button FIRES!"
data "The RIGHT mouse button controls the firing rate of the balls"
data "The mouse x-direction controls the Power Meter"
data "You start with $100, if your money gets low,"
data "press 'T' to spend another $100 for more balls"
data "   "
data "(If the balls are getting stuck above pins, change ballsize=75 on line 56)"
data "   "
data "-yellow"
data "Press a key to continue"
data "999"

cls
restore introtext
read t$
while t$<>"999"
   if left$(t$,1)="-"
      if t$="-green" then ink rgb(0,255,0),0
      if t$="-purple" then ink rgb(200,0,200),0
      if t$="-yellow" then ink rgb(255,255,0),0
      if t$="-cyan" then ink rgb(0,255,255),0
   else
      center text cx,cy,t$
      inc cy,30
   endif
   read t$
endwhile

sync
wait key
ink rgb(0,255,255),0
cls
sync
return