Sorry your browser is not supported!

create bitmap 1, 1000,1000
ink rgb(99,160,84),rgb(99,160,84)
box 190,200,210,400
ink rgb(205,102,28),rgb(205,102,28)
circle 200,240, 35
circle 200,160, 35
circle 160,200, 35
circle 240,200, 35
ink rgb(241,237,73),rgb(241,237,73)
circle 200,200, 40


copy bitmap 1, 0

wait key

rem my first attempt at a world
color backdrop 0

make camera 1
position camera 1,10200,15,10200
`autocam on
set camera range 1, 1, 10000
sync on
sync rate 60


makeworld(100,200,100)

makesky(120,120,220)

set ambient light 60

housetex()

make object box 2, 250,50,200
position object 2, 10500,10,10510
texture object 2, 10

do
control camera using arrowkeys 1, 20, 2
if camera position X (1) > 30300 then position camera 1, 3500,15,camera position z(1)
if camera position X (1) < 2700 then position camera 1, 30000,15,camera position z(1)
if camera position z (1) > 30300 then position camera 1, camera position x(1),15,3500
if camera position z (1) < 2700 then position camera 1, camera position x(1),15,30000

position object 1, camera position x(1),20.0,camera position z(1)
sync
loop

function housetex()
create bitmap 10, 1000,1000
ink rgb(200,200,200), rgb(200,200,200)
box 0,0,1000,500
ink rgb(200,100,100), rgb(200,100,100)
box 200,100,500,300
box 600,100,800,500
ink rgb(255,255,255), rgb(255,255,255)
box 210,110,490,290
copy bitmap 10, 0
get image 10, 0,0,1000,500
delete bitmap 10
endfunction

function makeworld(r,g,b)
create bitmap 1, 500, 500
ink rgb(r,g,b), rgb(r,g,b)
box 0,0,200,200
copy bitmap 1, 0
get image 1, 0,0,200,200

make matrix 1, 40000,40000,200,200
position matrix 1, 0,-10,0
prepare matrix texture 1, 1, 1,1
randomize matrix 1, 10000

delete bitmap 1
makeplants(100)
endfunction

function makesky(r,g,b)
create bitmap 2, 500, 500
ink rgb(r,g,b), rgb(r,g,b)
box 0,0,200,200
copy bitmap 2,0
get image 2, 0,0,200,200

make object sphere 1, -15000
position object 1, 5000,-10,5000
texture object 1, 2

delete bitmap 2
endfunction

function makeplants(number)
endfunction

`Monks world
color backdrop 0
set display mode 800,600,32
make camera 1
position camera 1, 10200,15,10200
set camera range 1, 1, 20000
sync on
sync rate 60
set ambient light 60

global numberb=30

makeworld(100,200,100)
makesky(120,120,220)
makeplants(1500)
makeboxtocollect(numberb)
housetex()
make object box 1, 250,50,200
position object 1, 10500,0,10510
house#=get ground height(1,object position x(1),object position z(1))
position object 1,object position x(1),house#+5,object position z(1)
texture object 1, 10
boxes# = numberb

do
ink rgb(255,255,255),rgb(255,255,255)
set cursor 50,50 : print  "boxes to collect:", boxes#

if camera position X(1)  > 38000 then position camera 1, 2000,hx#,camera position z(1)
if camera position X(1)  < 2000 then position camera 1, 38000,hx#,camera position z(1)
if camera position z(1)  > 38000 then position camera 1, camera position x(1),hx#,2000
if camera position z(1)  < 2000 then position camera 1, camera position x(1),hx#,38000

for a = 18000 to 18000+numberb
if camera position x(1) > boxes(a,1)-20 and camera position x(1) < boxes(a,1)+20
if camera position z(1) > boxes(a,2)-20 and camera position z(1) < boxes(a,2)+20
if object exist(a) = 1
delete object a
boxes# = boxes#-1
endif
endif
endif
next a

control camera using arrowkeys 1,20, 2
h# = get ground height (1, camera position x(1),camera position z(1))
position camera 1, camera position x(1),h#,camera position z(1)
position object 2, camera position x(1),20,camera position z(1)
update matrix 1

sync
loop

function housetex()
create bitmap 10, 1000,1000
ink rgb(200,200,200), rgb(200,200,200)
box 0,0,1000,500
ink rgb(200,100,100), rgb(200,100,100)
box 200,100,500,300
box 600,100,800,500
ink rgb(255,255,255), rgb(255,255,255)
box 210,110,490,290
copy bitmap 10, 0
get image 10, 0,0,1000,500
delete bitmap 10
endfunction

function makeworld(r,g,b)
create bitmap 1, 500, 500
ink rgb(r,g,b), rgb(r,g,b)
box 0,0,200,200
copy bitmap 1, 0
get image 1, 0,0,200,200
delete bitmap 1

make matrix 1, 40000,40000,300,300
position matrix 1, 0,-10,0
prepare matrix texture 1, 1, 1,1
randomize matrix 1, 20
for x = 1 to 300
for z = 280 to 300
set matrix height 1, x,z,RND(70)+100
next z
for z = 230 to 280
set matrix height 1, x,z,rnd(50)+70
next z
for z = 200 to 230
set matrix height 1, x,z, rnd(20)+20
next z
for z = 0 to 20
set matrix height 1, x,z,RND(30)+100
next z
for z = 20 to 50
set matrix height 1, x,z,rnd(30)+60
next z
for z = 50 to 80
set matrix height 1, x,z, rnd(30)+20
next z
next x
endfunction

function makesky(r,g,b)
create bitmap 2, 500, 500
ink rgb(r,g,b), rgb(r,g,b)
box 0,0,200,200
copy bitmap 2,0
get image 2, 0,0,200,200

make object sphere 2, -15000
position object 2, 5000,-10,5000
texture object 2, 2

delete bitmap 2
endfunction

function makeplants(numberp)
create bitmap 1, 1000,1000
ink rgb(159,119,83),rgb(159,119,83)
box 0,0,200,200
ink rgb(80,135,84),rgb(80,135,84)
box 200,0,400,200

copy bitmap 1, 0
get image 4, 0,0,200,200
get image 3, 200,0,400,200
delete bitmap 1

for t = 100 to 3*numberp + 100 step 3
make object cone t, 50
make object cylinder t+1, 15
make object cylinder t+2, 15
position object t, rnd(4000)*10, 40, rnd(4000)*10
tree#=get ground height((1),object position x(t),object position z(t))
position object t,object position x(t),tree#+40,object position z(t)
position object t+2, object position x(t),tree#+15,object position z(t)
position object t+1, object position x(t),tree#,object position z(t)
texture object t+1,4
texture object t+2,4
texture object t,3
next t
endfunction

function makeboxtocollect(numberb)
dim boxes(18000+numberb,2)
for x = 18000 to 18000+numberb
make object cube x, 50
position object x, rnd(27000)+3000, 15, rnd(27000)+3000
box#=get ground height(1,object position x(x),object position z(x))
position object x,object position x(x),box#,object position z(x)
boxes(x,1)=object position x(x)
boxes(x,2)=object position z(x)
color object x, rgb(251,2,2)
next x
endfunction

`Crazy Ninja's Entry for Realistic Flying
sync on : sync rate 60 : hide mouse : autocam off : set ambient light 15 

`get an image for the matrix texture
create bitmap 1,256,256
get image 1,0,0,256,256
delete bitmap 1

`Set up world
make matrix 1,1000,1000,100,100
prepare matrix texture 1,1,1,1

`temporary objects
for t = 101 to 120

    make object sphere t,15
    position object t,rnd(1000),rnd(1000),rnd(1000)

next t

`Box mesh that will be added as a limb to the space ship for the camera
make object sphere 1,2
make mesh from object 1,1
delete object 1

`Set up player space ship
make object sphere 1,5
scale object 1,75,25,75                    `the player is object 1, camera limb is limb 1
add limb 1,1,1
offset limb 1,1,0,0,-30
add limb 1,2,1
scale limb 1,2,150,400,150
color object 1,rgb(0,255,0)
color limb 1,2,rgb(0,0,0)

`make object sphere 50,2
`position object 50,0,1,0

`Prepare the player's ship for flight
playerpositiony# = 1
landing = 0
takeofftext = 1

`Take Off Loop
do
    
    if takeofftext = 1
        text (Screen Width())/2,(Screen Height())/2,"PRESS SPACEBAR FOR TAKEOFF"
    endif
    
    if spacekey() = 1
        landing = 1
        takeofftext = 0
    endif
    
    if landing = 1
        playerpositiony# = playerpositiony# + 0.1
    endif
    
    if playerpositiony# > 10
        playermousex# = 0
        playermousey# = 0
        exit
    endif
    
    `Update Position and Rotation of player
    position object 1,playerpositionx#,playerpositiony#,playerpositionz#
    rotate object 1,playermousex#,playermousey#,0
    
    position camera limb position x(1,1),limb position y(1,1),limb position z(1,1)`-50
    point camera limb position x(1,0),limb position y(1,0),limb position z(1,0)
    
    text 0,12,str$(playerpositiony#)
    
sync 
loop

`Main game loop
do
      
    if landing = 1
    
    `Get Player angles from mouse movement
    playermousex# = mousemovey()*0.5 + playermousex#
    playermousey# = mousemovex()*0.5 + playermousey#
    playermousex# = wrapvalue(playermousex#)
    playermousey# = wrapvalue(playermousey#)

    `Use WASD to go faster, slower, and pan left and right
    if keystate(17) = 1
        playerspeed# = 2
    endif
    
    if keystate(31) = 1
        playerspeed# = 0.5    
    endif

    if keystate(17) = 0 and keystate(31) = 0
        playerspeed# = 1
    endif

    `Calculate new coordinates for the space ships
    playerpositionx# = newxvalue(playerpositionx#,playermousey#,playerspeed#)
    playerpositiony# = newyvalue(playerpositiony#,playermousex#,playerspeed#)
    playerpositionz# = newzvalue(playerpositionz#,playermousey#,playerspeed#)

    endif
    
    `Update Position and Rotation of player
    position object 1,playerpositionx#,playerpositiony#,playerpositionz#
    rotate object 1,playermousex#,playermousey#,0
    
    position camera limb position x(1,1),limb position y(1,1),limb position z(1,1)
    point camera limb position x(1,0),limb position y(1,0),limb position z(1,0)
    
    text 0,0,"FPS:"+str$(screen fps())

sync
loop

Rem Project: SUFO
Rem Created: 11/7/2008 2:22:51 PM

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

Rem setup
HIDE MOUSE
SYNC ON : SYNC RATE 50
SET WINDOW LAYOUT 0,0,0
SET WINDOW SIZE 1024,768
SET WINDOW TITLE "SUFO"

Rem make media and setup world
MAKE OBJECT SPHERE 2,10
AUTOCAM OFF
MAKE OBJECT SPHERE 1,2

SCALE OBJECT 2,150,30,150
MAKE MESH FROM OBJECT 1,2
DELETE OBJECT 2

MAKE OBJECT SPHERE 2,7
SCALE OBJECT 2,90,70,90
MAKE MESH FROM OBJECT 2,2
DELETE OBJECT 2

MAKE MESH FROM OBJECT 3,1

ADD LIMB 1,1,1
ADD LIMB 1,2,2
FOR a=3 TO 10
   MAKE OBJECT SPHERE a,2
   ADD LIMB a,1,3
NEXT a

OFFSET LIMB 3,1,2,(-1.25),2
OFFSET LIMB 4,1,2,(-1.25),(-2)
OFFSET LIMB 5,1,(-2),(-1.25),(-2)
OFFSET LIMB 6,1,(-2),(-1.25),2
OFFSET LIMB 7,1,3.5,(-1.25),3.5
OFFSET LIMB 8,1,3.5,(-1.25),(-3.5)
OFFSET LIMB 9,1,(-3.5),(-1.25),(-3.5)
OFFSET LIMB 10,1,(-3.5),(-1.25),3.5

DELETE MESH 3

FOR a=3 TO 10
   MAKE MESH FROM OBJECT a,a
   ADD LIMB 1,a,a
   COLOR LIMB 1,a,RGB(0,255,0)
   DELETE OBJECT a
   DELETE MESH a
NEXT a

COLOR LIMB 1,1,RGB(70,220,70)
COLOR LIMB 1,2,RGB(20,20,20)
OFFSET LIMB 1,2,0,1,0

COLOR BACKDROP RGB(0,0,0)
SCALE OBJECT 1,15,15,15

FOG ON : FOG COLOR RGB(0,255,0) : FOG DISTANCE 200

Rem make variables
rate=50
flag=0
xpos#=0
ypos#=-8.051
zpos#=0
rot#=0
tilt=0
flying=0
takeoff=0
landing=0
engine#=0.25
moving=0
playing=1
gravity#=(-0.0625)

DISABLE ESCAPEKEY

Rem main loop starts
REPEAT

Rem main menu starts here
IF playing=0
engine#=3

```this is where the main menu of the game is going to be

ENDIF
Rem main menu ends here

Rem get user input and update variables
IF flying=1
   IF RIGHTKEY()=1
      IF xpos#<=10 THEN INC xmov#,0.025
      IF roll>(-30) THEN DEC roll,2
   ENDIF
   IF LEFTKEY()=1
      IF xpos#>=(-10) THEN DEC xmov#,0.025
      IF roll<30 THEN INC roll,2
   ENDIF
   IF UPKEY()=1
      IF ypos#<=7
         INC ymov#,0.05
      ELSE
         INC ymov#,0.0125
      ENDIF
   ENDIF
   IF DOWNKEY()=1 THEN IF ypos#>=(-7 ) THEN DEC ymov#,0.05
   IF MOUSECLICK()=1 THEN INC zpos#
   IF MOUSECLICK()=2 THEN DEC zpos#
ENDIF

IF RETURNKEY()=1
   IF SHIFTKEY()=1 THEN INC rate
   IF CONTROLKEY()=1 THEN DEC rate
ELSE
   IF SHIFTKEY()=1 THEN INC gravity#,0.0025
   IF CONTROLKEY()=1 THEN DEC gravity#,0.0025
ENDIF

xpos#=xpos#+xmov#
ypos#=ypos#+ymov#

Rem bounce off the walls
IF xmov#<(-0.2) AND xpos#<=(-11) THEN xmov#=(-xmov#)
IF xmov#>0.2 AND xpos#>=11 THEN xmov#=(-xmov#)
IF ymov#<(-0.2) AND ypos#<=(-8) THEN ymov#=(-ymov#)
IF ymov#>0.2 AND ypos#>=8 THEN ymov#=(-ymov#)

IF xmov#<0.1 AND xmov#>(-0.1) AND xpos#<=(-11) THEN xmov#=0
IF xmov#>(-0.1) AND xmov#<0.1 AND xpos#>=11 THEN xmov#=0
IF ymov#<0.1 AND ymov#>(-0.1) AND ypos#<=(-8) THEN ymov#=0
IF ymov#>(-0.1) AND ymov#<0.1 AND ypos#>=8 THEN ymov#=0

Rem gravity et al
IF xmov#<0 AND xpos#<(11) THEN INC xmov#,0.0125
IF xmov#>0 AND xpos#>(-11) THEN DEC xmov#,0.0125
IF ymov#<gravity# AND ypos#<(8) THEN INC ymov#,0.025
IF ymov#>(-0.0625) AND ypos#>(-8) THEN DEC ymov#,0.025

IF xmov#<0.01 AND xmov#>(-0.01) THEN xmov#=0
IF xmov#>(-0.01) AND xmov#<0.01 THEN xmov#=0
IF ymov#<0.01 AND ymov#>(-0.01) THEN ymov#=0
IF ymov#>(-0.01) AND ymov#<0.01 THEN ymov#=0

IF roll>0 THEN DEC roll
IF roll<0 THEN INC roll
INC rot,engine#
IF rot>360 THEN rot=0

Rem takeoff
IF SPACEKEY()=1 THEN IF flying=0 AND landing=0 THEN takeoff=1
IF takeoff=1
   INC engine#,0.025
   INC ypos#,(0.3-((engine#)/10))
   IF engine#>=3 THEN flying=1 : moving=1 : takeoff=0
ENDIF

IF flying=1 AND engine#>3 THEN DEC engine#,0.025

Rem landing
IF SPACEKEY()=1 THEN IF flying=1 THEN landing=1 : flying=0
IF landing=1
   IF xmov#<0 AND xpos#<(11) THEN INC xmov#,0.0125
   IF xmov#>0 AND xpos#>(-11) THEN DEC xmov#,0.0125
   IF roll>0 THEN DEC roll
   IF roll<0 THEN INC roll
   DEC engine#,0.025
   IF ypos#>=(-7) THEN DEC ypos#,(0.25-(engine#/10))
   IF engine#<=0 THEN landing=0
ENDIF

IF flying=0 AND landing=0 AND takeoff=0 AND playing=1 THEN xmov#=0

IF moving=1 THEN IF tilt<30 THEN INC tilt

Rem update spaceship position and rotation
POSITION OBJECT 1,xpos#,ypos#,zpos#
ROTATE OBJECT 1,0,rot,roll
FOR a=3 TO 6
   ROTATE LIMB 1,a,0,(2*rot),0
NEXT a
FOR a=7 TO 10
   ROTATE LIMB 1,a,0,((-2)*rot),0
NEXT a

Rem feedback
TEXT 0,0,"FPS: "+STR$(SCREEN FPS())
TEXT 0,10,"gravity: "+STR$(gravity#)
TEXT 0,20,"engine: "+STR$(engine#)
TEXT 0,30,"repulsorlift: "+STR$(ymov#)
TEXT 0,40,"thrusters: "+STR$(xmov#)

SYNC RATE rate
SYNC

UNTIL ESCAPEKEY()=1
Rem main loop ends

Rem clearup
DELETE OBJECT 1

`Coding Challenge - Mars Flyer
`Bill Robinson
`
`The SPACE bar fires Mars Flyer cannon.
`
set display mode 1280,1024,32
sync on
sync rate 60

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


#Constant WHITEcolor=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)
#Constant REDCOLOR=rgb(255,0,0)
#Constant GREENCOLOR=rgb(0,255,0)

global landsize=20000

type TurretGun
   active as integer
   objnum as integer
   x as integer
   y as integer
   z as integer
   turretobj as integer
   radarobj as integer
   yturretangle as integer
   yradarangle as integer
endtype
dim turret(100) as TurretGun

type FlyerData
   active as integer
   objnum as integer
   x as integer
   y as integer
   z as integer
   y_oscillate_angle# as float
   z_oscillate_angle# as float
   y_oscillate_speed# as float
   z_oscillate_speed# as float
   y_oscillate_amplitude as integer
   z_oscillate_amplitude as integer
   objcolor as integer
endtype
dim flyer(100) as FlyerData


global bulletalive=0
global bulletspeed=50
global flyerspeedinc#=2.0
global flyerturninc#=0.5
global s#
global heightoffset#=50.0

`--- Mars Flyer ---
dim oscillate(100,10)
global oscillate_speed=2
global oscillate_amplitude=20
global x#
global h#
global z#
global cx#
global cy#
global cz#

`--- Turrets ---
global numturrets=30
global turretcount=0
global turretobjnum=700
global radarobjnum=800

`--- Matrix ---
global gridxmax=100
global gridzmax=100
dim gridtexture(gridxmax, gridzmax)

`--- Pyradmids ---
global numpyr=3
global pyrsize=500
global pyrheightmax=2000

`--- Boxes
global numboxes=1
global boxsize=500
global boxheightmax=2000

`--- Object Collision ---
global targetsleft=numboxes
global hitnum
global oldhitnum
global hitflag=0

`--- Camera & Screen ---
global camylookup#=0
global screenxcenter
screenxcenter=SCREEN WIDTH()/2

`--- Explosion Particles ---
rem Arrays for position, velocity and life of each explosion particle
dim partx#(300)
dim party#(300)
dim partz#(300)
dim partxvel#(300)
dim partyvel#(300)
dim partzvel#(300)
dim partxrot#(300)
dim partyrot#(300)
dim partzrot#(300)
dim partlife(300)
dim explosion(10,10)
global start_time=0
global inten#=60.0
global maxexppieces=200
global explode_object=0
global expdone=0
global exparrayindex=1
global expparticleindex=1

gosub _intro:

`--- Make Explosion Pieces ---
color=rgb(255,255,255)
piecesize=30
for i=1 to maxexppieces
   obnum=199+i
   make object plain obnum,rnd(piecesize)+piecesize,rnd(piecesize)+piecesize

   color object obnum,color
   hide object obnum
next i

sync
print "Building Textures"
sync

`--- make terrain textures ---
_terrain_textures()


for i=1 to numboxes
   obj=i+400
`   numlimbs=create_pyramid(obj,pyrsize,4,0)
   make object box obj,boxsize,boxsize,boxsize
   set object ambient obj,100
   colr=rgb(64*rnd(4),64*rnd(4),64*rnd(4))
   color object obj,colr
   set object emissive obj,colr
   set object ambient obj,25
   position object obj,18000+i*(boxsize+400),1500,21000

   `---DBPro collision---
   set object collision on obj
   `SET OBJECT COLLISION TO spheres obj
   SET OBJECT COLLISION TO boxes obj
   if obj=401 then _add_scannerbeams(obj)
next i


rem Make landscape
landsize=20000 :`was 5000
set camera range 10,landsize*5
make matrix 1,landsize*2,landsize*2,gridxmax+1,gridzmax+1 :`was 25,25 - now 50,50
`prepare matrix texture 1,44,4,4
prepare matrix texture 1,1,4,4
randomize matrix 1,200   :`was 200 - sets height of land matrix hills

rem Texture landscape
roadx=gridxmax/2
roadz=gridzmax/2
for z=0 to gridzmax  :`both for loops were 1 to grid...changed to 0 to ... to texture to the edges
   for x=0 to gridxmax
      texturenum=rnd(7)+1
      set matrix tile 1,x,z,texturenum   :`now texturenum - was rnd(11)+1
      gridtexture(x,z)=texturenum
      rem Roads
      if z=roadx or x=roadx
         lvl=rnd(2)
         lvl#=0.0-(lvl*10.0)
         set matrix tile 1,x,z,13+lvl
         set matrix height 1,x,z,lvl#
         set matrix height 1,x+1,z,lvl#
         set matrix height 1,x,z+1,lvl#
         set matrix height 1,x+1,z+1,lvl#
      endif
   next x
next z
update matrix 1

`----- Build Gun Turrets ---
for i=1 to numturrets
   spacing=15000
   turretobj=_make_turret()
`   position object 700,22000,200,20000
   position object turretobj,landsize-(Spacing/2)+rnd(spacing),200,landsize-spacing+rnd(spacing)

   turret(i).radarobj=radarobjnum
`   make object box 800,10,10,100
    radarobj=turret(i).radarobj
   make object sphere radarobj,100,4,4
   scale object radarobj,100,100,10
   position object radarobj,object position x(turretobj),object position y(turretobj)+150,object position z(turretobj)
   `hide object 800
   inc radarobjnum
next i

`---make flyer object---
_make_flyer()

flyer(1).y_oscillate_angle#=0.0
flyer(1).z_oscillate_angle#=0.0
flyer(1).y_oscillate_speed#=2.0
flyer(1).z_oscillate_speed#=1.0
flyer(1).y_oscillate_amplitude=10
flyer(1).z_oscillate_amplitude=2

x#=landsize
z#=landsize
h#=500.0
a#=180.0

`position the flyer
position object 1,x#,h#,z#
yrotate object 1,a#

cx#=landsize
cy#=2000
cz#=landsize-2000

oscillate_angle=0

position camera 20000,500,18000

rem ----- main loop -----------------------------------------------------
do
`position object 10,object position x(1),object position y(1),object position z(1)
   for i=1 to numboxes     :`rotate objects to shoot at - was numpyr
      obj=i+400
      turn object right obj,1
      turn object right obj+1000,1
   next i

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

   if upkey()=1 and s#<80.0
      if keypress=42 and s#<80.0 then s#=s#*1.5
      s#=s#+flyerspeedinc#                       :`was 4.0
   endif
   if downkey()=1 and s#>-100.0 then s#=s#-flyerspeedinc#
   if leftkey()=1
      s#=s#+0.1
      a#=wrapvalue(a#-flyerturninc#)            :`was a#-5
   endif
   if rightkey()=1
      s#=s#+0.1
      a#=wrapvalue(a#+flyerturninc#)
   endif


   `----------------------------------------
   rem Other Keypress scancodes
   keypress=scancode()
   if keypress>0              :`and keypress<>lastkeypressed
      lastkeypressed=keypress
      select keypress
         case 2
            bulletspeed=50    :`the 1 key was pressed
         endcase
         case 3
            bulletspeed=100   :`the 2 key was pressed
         endcase
         case 4
            bulletspeed=150   :`the 3 key was pressed
         endcase
         case 82
              ` --- smooth camera lookup, scans camera upward ---
`            lookupflag=1
            offset#=300.0
            camylookup#=curvevalue(offset#,camylookup#,50.0)
            if camylookup#=offset#-5 then lookupflag=0
         endcase
      endselect
   endif


   rem Control turret bullet
   if spacekey()=1 and bulletalive=0 then gosub _start_bullet
   if bulletalive>0 then gosub _move_bullet
   gosub _check_hits
   if bulletalive<0 or hitflag=1
      gosub _explode_bullet
`      _request_explosion(ex#,ey#,ez#,explosion(ex,3),explosion(ex,4),explosion(ex,5),explosion(ex,6),explosion(ex,7))
   endif

   if keystate(48)=1                            :`b key - self destruct
      `(object,num particles,intensity,particle life,color)
`      _set_explosion(2,50,30,YELLOW)
      _set_explosion(2,50,40,150,YELLOW)
`      playerdeadtime=200
wait 200
   endif


   ` --- smooth camera lookup, scans camera back down ---
   if keypress<>82 then camylookup#=curvevalue(0,camylookup#,50.0)
   if camylookup#<1.0 then camylookup#=0.0:lookupflag=0


   rem Calculate flyer data
   oldx#=x#
   oldz#=z#
   x#=newxvalue(x#,a#,s#)
   z#=newzvalue(z#,a#,s#)
   s#=s#/1.2


   rem ----- Smooth control camera -----
   cdx#=newxvalue(x#,a#,-700)
   cdz#=newzvalue(z#,a#,-700)
   cdy#=get ground height(1,cx#-mx#,cz#-mz#)+50  :`was +50
   if cdy#<225 then cdy#=225
   cx#=curvevalue(cdx#,cx#,10.0)
   cy#=curvevalue(cdy#,cy#,10.0)
   cz#=curvevalue(cdz#,cz#,10.0)


   rem Update flyer model
`   h#=get ground height(1,x#-mx#,z#-mz#)+heightoffset#
h#=500.0
   position camera cx#,h#+350.0,cz#-50:`orig didn't say -100 for z
   point camera x#,h#+camylookup#,z#

`   trackh#=(frontlefth#+frontrighth#+backlefth#+backrighth#)/4.0
`   if trackh#>h# then h#=trackh#
   position object 1,x#,h#,z#
   yrotate object 1,a#
   rotate object 2,wrapvalue(length#/4.0),0,wrapvalue(across#/4.0)
   `----------------------------------------

   _check_newexplosions()
   _continue_explosion()      :`continue to explode pieces

   _check_turrets()

   oscillate_angle#=wrapvalue(flyer(1).y_oscillate_angle# + flyer(1).y_oscillate_speed#)
   flyer(1).y_oscillate_angle#=oscillate_angle#
`   _update_oscillation(1,1,0,flyer(1).y_oscillate_amplitude,oscillate_angle#)

   oscillate_angle#=wrapvalue(flyer(1).z_oscillate_angle# + flyer(1).z_oscillate_speed#)
   flyer(1).z_oscillate_angle#=oscillate_angle#
   _update_oscillation(1,0,1,flyer(1).z_oscillate_amplitude,oscillate_angle#)

`   _update_oscillation(objnum,yposflag,bankflag,intensity#,angle#)

   mx=mousex()
   mousebutton=mouseclick()

`   gosub _show_score                               :`show score on screen

   set cursor 0,0
   print screen fps()
   print "x=";x#
   print "z=";z#

   sync
loop
end
`----END MAIN--------------------------------------------------------------------------------------------------

function _start_oscillation(objnum,pitchflag,bankflag,intensity)

endfunction


function _update_oscillation(objnum,yposflag,bankflag,intensity#,angle#)
if objnum=1
   if yposflag=1
      ypos#=h#+cos(angle#)*intensity#
      position object objnum,object position x(objnum),ypos#,object position z(1)
   endif
   if bankflag=1
`      zrot#=object angle z(objnum)+cos(angle#)*intensity#
      zrot#=cos(angle#)*intensity#

      zrotate object objnum,zrot#
   endif
endif

endfunction incval#


function _angle_diff(a1#,a2#)
a2#=(a2#-a1#) mod 360
if a2#>180 then a2#=a2#-360
endfunction a2#


function _make_Flyer()

   rem Create a tilt object (to handle "independent" X & Z axis rotation)
   make object cone 1,5
   hide limb 1,0

`   make object box 2,200,75,300
   make object box 2,1000,5,150
   color object 2,rgb(255,255,0)

   rem Glue flyer to tilt-object
   glue object to limb 2,1,0

   rem Create small bullet
   make object sphere 3,50
`   texture object 3,6
   color object 3,rgb(255,255,255)

   hide object 3
remstart
   rem ----- Create Enemy Body -----
   make object box 400+i,100,200,20        :`Enemy Body
   color object 400+i,rgb(255,150,0)

   make object box 420+i,50,50,50         :`Enemy Head
   color object 420+i,rgb(r,g,b)
   xrotate object 420+i,45
   fix object pivot 420+i

   rem Create Enemy Bazooka Tube
   make object cylinder 450+i,40          :`Enemy Tennis ball CANNON
   set object 450+i,1,1,0
   scale object 450+i,60,250,60
   color object 450+i,rgb(250,250,0)
   xrotate object 450+i,90
   fix object pivot 450+i
remend
endfunction


function _move_ailerons()
`      vis=static line of sight(camx,camy,camz,enemy#(i,3),enemy#(i,4),enemy#(i,5),1,1)
remstart
      if vis=0       :`can enemy head see me, yes then fire ready to fire
         if gunangle#(i,1)>0
            dec gunangle#(i,1),gunangleinc#
            xrotate object eobj+50,gunangle#(i,1)
            gunangle#(i,2)=0
         else
            point object eobj+50,camx,camy-500,camz
            gunangle#(i,2)=1
         endif
      else
         if gunangle#(i,1)<120
            inc gunangle#(i,1),gunangleinc#
            xrotate object eobj+50,gunangle#(i,1)
            gunangle#(i,2)=0
         endif
      endif
remend
endfunction




function _check_turrets()
dist#=3000
`flyer
flyerobj=1
x1#=object position x(flyerobj)
y1#=object position y(flyerobj)
z1#=object position z(flyerobj)

for i=1 to turretcount
   turretobj=turret(i).turretobj     :`was 700+i-1
   radarobj=turret(i).radarobj

   `each turrets position
   x2#=object position x(turretobj)
   y2#=object position y(turretobj)
   z2#=object position z(turretobj)

   `--- measure the distance of each turret to the flyer
   l#=threeD_distance(x1#, y1#, z1#, x2#, y2#, z2#)

   if l#<dist#
`      position object radarobj,x2#,y2#+150,z2#
      point object radarobj,x1#,y1#,z1#        :`point turret radar to flyer
      color object radarobj,REDCOLOR

      ang1=object angle y(turretobj)            :`turret angle
      ang2=object angle y(radarobj)            :`turret radar angle
      turret(i).yradarangle=ang2
      anglediff=_angle_diff(ang1,ang2)

      if anglediff<>0
         if anglediff>0
            newangle=wrapvalue(ang1+1)
            yrotate object turretobj,newangle
         else
            newangle=wrapvalue(ang1-1)
            yrotate object turretobj,newangle
         endif
      endif
   else
      newangle=wrapvalue(turret(i).yradarangle+2)
      turret(i).yradarangle=newangle
      yrotate object radarobj,newangle
      color object radarobj,GREENCOLOR
   endif
next i
endfunction



function _make_turret()

   make object box turretobjnum,100,120,180
   color object turretobjnum,rgb(255,0,255)

   `index into turret array - number of turrets also
   inc turretcount
   turret(turretcount).yturretangle=object angle y(turretobjnum)
   turret(turretcount).yradarangle=rnd(360)     :`was object angle y(turretobjnum)
   turret(turretcount).turretobj=turretobjnum
   tnum=turretobjnum
   inc turretobjnum

endfunction tnum




function _add_scannerbeams(objnum)
   scannerobj=objnum+1000
   make object box scannerobj,200,200,2000
   rotate object scannerobj,135,0,0
   position object scannerobj,object position x(objnum),object position y(objnum),object position z(objnum)
   color object scannerobj,rgb(255,0,0)
   set object ambient scannerobj,0
   set object emissive scannerobj,rgb(5,0,0)
OFFSET LIMB scannerobj, 0, 0, 0, 1000

fix object pivot scannerobj
GHOST OBJECT ON scannerobj, 0

`make mesh from object 1,scannerobj
`add limb objnum,1,1
`glue object to limb scannerobj,objnum,0

`set object emissive scannerobj,rgb(10,0,0)
`set limb smoothing objnum,1,100
endfunction


Rem PJY - simple function to calculate the length of a 3D vector using DBPro's inbuilt 3D maths commands
FUNCTION threeD_distance(x1# AS float, y1# AS float, z1# AS float, x2# AS float, y2# AS float, z2# AS float)
null = make vector3(1)
set vector3 1, x1# - x2#, y1# - y2#, z1# - z2#
length_vector# = length vector3(1)
null = delete vector3(1)
ENDFUNCTION length_vector#


rem --- show score on screen
_show_score:
`set cursor 1,1
`print screen fps()
center text screenxcenter,10,"Bulletspeed=: "+str$(bulletspeed)+"    TARGETS LEFT: "+str$(targetsleft)+"    SCORE: "+str$(score)
set cursor 0,50
print "keypress=";keypress
print "camylookup=";camylookup#
print "lookupflag=";lookupflag
print "exparrayindex=";exparrayindex
for i=1 to 10
`   print explosion(i,1)
   print partlife(i)
next i
return


_level_completed:
set cursor 0,100
print "Level Completed!!!"
sync
wait key
end
return


`--- check if shot hit any boxes - still working on pyramids
_check_hits:
if hitflag=0
   hitnum=object hit(3,0)
   if hitnum>=101             :`and hitnum<=101+numpyr
      bulletalive=-20
      hitflag=1
      oldhitnum=hitnum
      texture object 3,6
      ghost object on 3

      if object exist(hitnum)
         _set_explosion(hitnum,30,40,300,YELLOW)
         hide object hitnum
         exclude object on hitnum
         set object collision off hitnum
`         position object hitnum,object position x(hitnum),5000,object position z(hitnum)
hide object hitnum
exclude object on hitnum
         dec targetsleft
      endif
   endif
endif
return



function getdistance(x#,z#,obj2)
   rem Calculate distance between two objects
   dx#=object position x(obj2)-x#
   dz#=object position z(obj2)-z#
   dist#=sqrt((dx#*dx#)+(dz#*dz#))
endfunction dist#



`----------Bullet Routines--------------------------------------------------------------------------------------------
_start_bullet:
rem Calculate position of bullet creation
bx#=newxvalue(x#,a#,100)
bz#=newzvalue(z#,a#,100)
by#=get ground height(1,bx#-mx#,bz#-mz#)+50


by#=h#

rem Begin life of bullet
position object 3,bx#,by#,bz#
rotate object 3,wrapvalue(object angle x(2)-10),a#,0
scale object 3,100,50,100
color object 3,rgb(180,180,230)
fade object 3,100
ghost object off 3
show object 3
bulletalive=50

set object collision on 3
SET OBJECT COLLISION TO SPHERES 3

return




_move_bullet:
rem Arc bullet by slowly rotation X axis whilst moving
xrotate object 3,wrapvalue(object angle x(3)+.4)
move object 3,bulletspeed

rem Detect collision with ground to destroy
if get ground height(1,object position x(3)-mx#,object position z(3)-mz#)>object position y(3) or detonate=1
`if CountCollisionsPRO(3) > 0
   rem Show explosion from bullet
   bulletalive=-20
   texture object 3,6
   ghost object on 3

   rem At point of impact, make crator
   gridunitsize#=(landsize*2.0)/gridxmax  :`was 25.0 - now gridxmax
   gridx=int((object position x(3)-mx#)/gridunitsize#)
   gridz=int((object position z(3)-mz#)/gridunitsize#)

   rem Affect matrix with changes
   gridy#=get ground height(1,object position x(3)-mx#,object position z(3)-mz#)
   for tx=gridx-1 to gridx+1
      for ty=gridz-1 to gridz+1
         if tx>0 and tx<gridxmax and ty>0 and ty<gridzmax
            gridy#=get matrix height(1,tx,ty)
            ngy#=gridy#-50-rnd(20)
            if ngy#<-500.0 then ngy#=-500.0  :`was -50 in both places, sets crater depth limit
            set matrix height 1,tx,ty,ngy#
            tt=12-abs((ngy#+50.0)/10.0)
            if tt<0 then tt=0
            if tt>12 then tt=12
            if tx=gridx and ty=gridz
               set matrix tile 1,tx,ty,12 :`where shell hits, make darkest
               gridtexture(tx,ty)=12
            else
               if gridtexture(tx,ty)=12
                  set matrix tile 1,tx,ty,12 :`leave old darker shell hit darker
               else
                  texturenum=9+rnd(2)
                  set matrix tile 1,tx,ty,texturenum
                  gridtexture(tx,ty)=texturenum
               endif
            endif
         endif
      next ty
   next tx
   update matrix 1

endif
return


_explode_bullet:
rem Scale up bullet as it explodes
scl=(((50*150))-(((abs(bulletalive))*150)))-3500
scale object 3,scl,scl,scl
fd=abs(bulletalive*10)
if fd<0 then fd=0

fade object 3,fd

xrotate object 3,wrapvalue(object angle x(3)+10)

rem Count down during explosion
bulletalive=bulletalive+1
if bulletalive=0
   set object collision off 3
   hide object 3
`   position object 3,0,5000,0
   hitflag=0
endif
return




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
   `T key
   case 20
      if numballs<100
         inc numballs,100
      endif
   endcase
endselect
endfunction


function _terrain_textures()
imsize=64
cellsize=16
cellcount=0
blurflag=0
create bitmap 1,imsize,imsize
for row=1 to 4
   for col=1 to 4
      inc cellcount
      if row<=3
         ink rgb(200-(cellcount*10),70-(cellcount*5),0),0
      else
         ink rgb(100,100,100),0
      endif
      box cellsize*(col-1)+1,cellsize*(row-1)+1,cellsize*(col)+1,cellsize*(row)+1

      x1=cellsize*(col-1)
      x2=cellsize*col
      y1=cellsize*(row-1)
      y2=cellsize*row

      if row<4
         for x=1 to 50
            r=45-(rnd(20)+cellcount)
            g=32-(rnd(20)+cellcount)
            ink rgb(r,g,0),0
            dot x1+rnd(cellsize),y1+rnd(cellsize)

         next x
      endif

      if row=4
         if blurflag=0
            blur bitmap 1,3
            blurflag=1
         endif

         ink rgb(50,25,0),0

         lineinc#=cellsize/8
         for liney#=y1 to y2 step lineinc#
            line x1,liney#,x2,liney#
         next liney#
         for linex#=x1 to x2 step lineinc#
            line linex#,y1,linex#,y2
         next linex#
      endif

   next col
next row
get image 1,0,0,imsize,imsize
delete bitmap 1

ink rgb(255,255,255),0
endfunction


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

introtext:
data "-green"
data "Mars Flyer Game"
data "   "
data "-purple"
data "Fly your ship around and destroy hovering boxes and radar turret objects,"
data "   "
data "   "
data "-cyan"
data "The ARROW keys control flyer movement"
data "Keys 1,2,3 set flyer firing power"
data "The SPACE bar FIRES!"
data "   "
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(220,0,220),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

function _make_rail(objid,xsize,ysize,zsize,color,posx,posz,yangle)
make object box objid,xsize,ysize,zsize
color object objid,color
if angle<>0
   rotate object objid,0,yangle,0
endif
position object objid,posx,posy,posz
set text size 16
endfunction



`--------DB demo routines for explosions--------
`--- (explosion x,y,z, num particles, explosion intensity, life of particles, particle index, color)
function _request_explosion(ex#,ey#,ez#,particles,intensity#,life,partindex,color)
count=0
for i=partindex to partindex+particles
   partlife(i)=life + rnd(life/2)      :`was rnd(life/5)
   partx#(i)=ex#
   party#(i)=ey#
   partz#(i)=ez#
   partyvel#(i)=rnd(intensity#)-(intensity#/4)
   partxvel#(i)=rnd(intensity#)-(intensity#/2)
   partzvel#(i)=rnd(intensity#)-(intensity#/2)
   inc count

   partyrot#(i)=5+rnd(5)
   partxrot#(i)=5+rnd(5)
   partzrot#(i)=5+rnd(5)

   show object 199+i
   color object 199+i,rgb(rnd(255),rnd(255),rnd(255))      :`color
next i

endfunction


`explosion 1=active flag, 2=object, 3=#particles, 4=intensity, 5=particle life, 6=particle start num,
`          7=color, 8=rotx, 9=roty, 10=rotz
function _continue_explosion()
for ex=1 to 10
   if explosion(ex,1)=2
      for t=explosion(ex,6) to explosion(ex,6)+explosion(ex,3)
         if partlife(t)>1
            dec partlife(t)
            position object 199+t,partx#(t),party#(t),partz#(t)
            partxvel#(t)=partxvel#(t)*0.99                 :`was 0.95 then 0.98
            partyvel#(t)=partyvel#(t)*0.99
           partzvel#(t)=partzvel#(t)*0.99                 :`particles slow down from air friction
``            partzvel#(t)=0.0
partyvel#(t)=partyvel#(t)-0.15                  :`was -0.5 particles effected by gravity
            inc partx#(t),partxvel#(t)
            inc party#(t),partyvel#(t)
            inc partz#(t),partzvel#(t)
`           if party#(t)<=0 then partyvel#(t)=partyvel#(t)*-0.7     :`particles bounce on the ground
            `particles bounce on the ground
           if party#(t)<=get ground height(1,partx#(t),partz#(t)) then partyvel#(t)=partyvel#(t)*-0.7

`            rotate object t+199,wrapvalue(object angle x(t+199)+rnd(50)),wrapvalue(object angle y(t+199)+rnd(100)),0
`xrot=explosion(exparrayindex,8)
`yrot=explosion(exparrayindex,9)
`zrot=explosion(exparrayindex,10)

xrot=partxrot#(t)

yrot=partyrot#(t)
zrot=partzrot#(t)

rotate object t+199,wrapvalue(object angle x(t+199)+xrot),wrapvalue(object angle y(t+199)+xrot),0
         endif
         if partlife(t)=1
            partlife(t)=0
            hide object 199+t
            start_time=0
            expdone=1
partxvel#(t)=0
partyvel#(t)=0
partzvel#(t)=0
`            explosion(ex,1)=0
         endif
      next t
   endif
next ex
endfunction


`--- array entry for another explosion ---
function _set_explosion(object,numparticles,intensity,particlelife,color)
explosion(exparrayindex,1)=1                 :`explosion flag 1=on 0=off
explosion(exparrayindex,2)=object            :`object to explode
explosion(exparrayindex,3)=numparticles      :`number of particles
explosion(exparrayindex,4)=intensity         :`intensity
explosion(exparrayindex,5)=particlelife      :`particle life
explosion(exparrayindex,7)=color             :`color of particles
explosion(exparrayindex,8)=rnd(5)            :`x-rotation
explosion(exparrayindex,9)=rnd(5)            :`y-rotation
explosion(exparrayindex,10)=rnd(5)            :`z-rotation

inc exparrayindex
if exparrayindex>10 then exparrayindex=1
endfunction


function _check_newexplosions()
  for ex=1 to 10
      if explosion(ex,1)=1
         ex#=object position x(explosion(ex,2))
         ey#=object position y(explosion(ex,2))
         ez#=object position z(explosion(ex,2))

         if expparticleindex+explosion(ex,3)>=200
            expparticleindex=1
         endif
         explosion(ex,6)=expparticleindex
         inc expparticleindex,explosion(ex,3)
`---- explosion() 1=active flag, 2=object, 3=#particles, 4=intensity, 5=particle life, 6=particle start num, 7=color
         _request_explosion(ex#,ey#,ez#,explosion(ex,3),explosion(ex,4),explosion(ex,5),explosion(ex,6),explosion(ex,7))
         start_time=1

         hide object explosion(ex,2)               :`was explode_object
         set object collision off explosion(ex,2)  :`was explode_object
         explosion(ex,1)=2
      endif
   next ex
endfunction

Crazy Ninja and BillR

Sinisterstuf
I think that your animation and flying physics deserved to win
Congrats all

` Project: Fortune's Tower
` Created: 11/16/2008
` Author:  Halo Man
` This game is an entry into the DBP Challenge on TheGameCreators.com
` Media List
   ` Images
      ` 1-7    Top of Cards 1 through 7
      ` 8      Hero Card

` ----------

` Setup the window and tell the game to refresh as fast as possible
set window on : set window size 800,600
set window title "Fortune's Tower"
sync on : sync rate 0

` Search for available fonts on their computer
gosub FontSearch

` Create all variables/arrays that will be needed by game
bonus as byte : ` 1 = no bonus, 2 = x2 bonus, etc.
saveCard as boolean : ` 1 = you have a Save Card
heroProtect as boolean : ` 1 = there is a hero protecting the row
gold as integer = 100
curRow as integer: ` Row 1 = 2 cards; Row 2 = 3 Cards; Goes to Row 7 with 8 cards
dim cards(8): ` How many of each card is left
dim spot(7,8) as byte : ` Point value of card at row x and column y
dim amt(7) as byte : ` Stores the sum of the row

` Create all media needed by game
gosub CreateMedia

` Setup media needed by game
gosub SetupMedia

` Create a GUI
line 0,500,800,500
set text opaque


` -----MAIN LOOP-----
repeat
   ` Reset variables to "start of game" status
   restart:
   if gold < 1
      ClearTextAlert()
      center text 400,0,"It appears you have no money left!"
      sync
      wait 1500
      ClearTextAlert()
      center text 400,0,"Oh well, I'll give you a little more!"
      gold = gold+100
      sync
      wait 1500
   endif
   bonus = 1
   saveCard = 1
   allSum = 0
   curRow = 1
   gateCard = 1
   for rst = 1 to 7
      cards(rst) = 10
   next rst
   cards(8) = 4
   for spotx = 1 to 7
      for spoty = 1 to 8
         spot(spotx,spoty) = 0
      next spoty
   next spotx
   center text 400,0,"Press the spacebar to bet 15 gold."
   text 10,510,"Gold:  "+str$(gold)+"      "
   wait 500
   repeat
      sync
   until spacekey()=1
   ink 0,0
   box 121,40,800,499
   ink rgb(170,50,40),0
   sync
   wait 500


   ` ---THIS PART IS FROM THE FIRST BET TO PAY-OFF---
   ` Clear the alert bar
   ClearTextAlert()
   ` Subtract 15 gold and reestablish GUI
   dec gold,15
   text 10,510,"Gold:  "+str$(gold)+"       "
   text 10,550,"Save Card:  Yes    "
   text 300,550,"Bonus:  x1   "
   line 120,40,120,500
   line 0,40,120,40
   do
   ` Deal out number of cards for current row and update variables
   select curRow
      case 1 : curX = 345 : endcase
      case 2 : curX = 315 : endcase
      case 3 : curX = 285 : endcase
      case 4 : curX = 255 : endcase
      case 5 : curX = 225 : endcase
      case 6 : curX = 195 : endcase
      case 7 : curX = 165 : endcase
   endselect
   for numToDeal = 1 to curRow + 1
      reTry:
      randomize timer()
      wait 100+rnd(50)+rnd(50)
      curCrd = rnd(7)+1
      if cards(curCrd) > 0
         paste image curCrd,curX,50*curRow
         cards(curCrd) = cards(curCrd)-1
         if curCrd < 8
            spot(curRow,numToDeal) = curCrd
         else
            heroProtect = 1
            spot(curRow,numToDeal) = 0
         endif
         inc curX,60
         sync
         randomize timer()
         wait 100+rnd(50)+rnd(50)
      else
         goto reTry : ` I know, this is bad practice
      endif
   next numToDeal
   ` Check for Misfortune
   if heroProtect = 1 or curRow = 1 then goto SkipMisfortune
   for chk = 1 to curRow+1
      if chk = 1
         test1 = spot(curRow,chk)
         test2 = spot(curRow-1,chk)
         if test1 = test2 then allSum = -1 : ` When allSum = -1, that means Misfortune
      endif
      if chk = curRow+1
         test1 = spot(curRow,chk)
         test2 = spot(curRow-1,chk-1)
         if test1 = test2 then allSum = -1
      endif
      test1 = spot(curRow,chk)
      test2 = spot(curRow-1,chk-1)
      test3 = spot(curRow-1,chk)
      if test1 = test2 or test1 = test3 then allSum = -1
      if allSum = -1 and saveCard = 1
         ClearTextAlert()
         center text 400,0,"Thankfully, you had a Save Card. Zero points for this row."
         allSum = 0
         saveCard = 0
         text 10,550,"Save Card:  No         "
         sync
         wait 3000
         goto SkipAdding
      endif
   next chk

   SkipMisfortune:

   ` Check for any bonuses
   counter = 0
   for chk = 2 to curRow+1
      if spot(curRow,1) = spot(curRow,chk)
         inc counter
      else
         counter = 0
         exit
      endif
   next chk
   if counter = curRow
      bonus = curRow+1
      text 300,550,"Bonus:  x"+str$(bonus)
      ClearTextAlert()
      center text 400,0,"Good job! Future rows will be multiplied."
      sync
      wait 1000
   endif

   heroProtect = 0
   ` Print to side the sum of the row
   if allSum = -1
      text curX+15,50*curRow,"Misfortune"
      center text 400,0,"You lost 15 gold."
      sync
      wait 1500
      goto restart
   endif
   allSum = 0
   for add = 1 to curRow+1
      allSum = allSum + spot(curRow,add)
      amt(curRow) = allSum
   next add
   if bonus > 1
      allSum = allSum*bonus : ` Add in the bonus multiplier
   endif
   SkipAdding:
   text curX+15,50*curRow,str$(allSum)
   sync
   if curRow = 7
      ClearTextAlert()
      if saveCard = 1
         for addup = 1 to 7
            total = total + amt(addup)
         next addup
         center text 400,0,"Jackpot! You earned "+str$(total)+" gold!"
         wait 2000
         goto restart
      endif
      if allSum < 15 then center text 400,0,"You lost "+str$(15-allSum)+" gold."
      if allSum > 15 then center text 400,0,"Good job, you gained "+str$(allSum-15)+" gold!"
      if allSum = 15 then center text 400,0,"You gained no profit."
      sync
      wait 1000
      goto restart : ` I know, bad practice
   endif
   ClearTextAlert()
   center text 400,0,"Press 'space' for another row, or 'enter' to cash in."
   sync
   do
      if spacekey()=1
         ClearTextAlert()
         sync
         wait 500
         exit
      endif
      if returnkey()=1
         inc gold,allSum
         ClearTextAlert()
         if allSum < 15 then center text 400,0,"You lost "+str$(15-allSum)+" gold."
         if allSum > 15 then center text 400,0,"Good job, you gained "+str$(allSum-15)+" gold!"
         if allSum = 15 then center text 400,0,"You gained no profit."
         sync
         wait 1000
         goto restart : ` I know, bad practice
      endif
      sync
   loop
   inc curRow,1
   loop
until escapekey()=1


` -----GOSUBS-----

` Search for available fonts on their computer
FontSearch:
   set text font "Times New Roman"
   set text size 35

   perform checklist for fonts
   for font = 1 to checklist quantity()
      if checklist string$(font) = "High Tower Text"
         set text font "High Tower Text" : ` Better than Times New Roman if available
      endif
   next font
return

` Create all media needed by game
CreateMedia:
   ` Cards (Obj 1-74)
      ` 2d Top
         ` Edge
         ink rgb(150,140,90),0
         box 0,0,50,80
         ` Card Border
         ink rgb(200,190,140),0
         box 1,1,49,79
         ` Red Border
         ink rgb(170,50,40),0
         box 3,3,47,77
         ` Main Section
         ink rgb(200,190,140),0
         box 6,6,44,74
         ` Get this image and save as image 100
         get image 100,0,0,50,80
         ` Enter a loop that will create cards 1-7
         ink rgb(170,50,40),0
         for num = 1 to 7
            paste image 100,0,0
            center text 25,0,str$(num)
            get image num,0,0,50,80
         next num
         paste image 100,0,0
         center text 25,0,"H"
         get image 8,0,0,50,80
         delete image 100
         cls
return

` Setup media needed by game
SetupMedia:
   paste image 8,125,25
   paste image 8,625,25
   for crdval = 1 to 7
      for inst = 1 to 10
         paste image crdval,100+(50*inst),crdval*50
      next inst
   next crdval
   paste image 8,125,390
   paste image 8,625,390
return

` ---FUNCTIONS---
function ClearTextAlert()
   ink 0,0
   box 0,0,800,40
   ink rgb(170,50,40),0
endfunction

`Monks noughts and crosses
start:
set display mode 800,600,16
set window size 800,600
set window position 250,150
show mouse
set text size 32

gosub crosses
gosub noughts
dim squares(3,3)

gosub createboard
gosub backboard
player = 1
do
Mx = Mousex() : My = mousey() : Mc = Mouseclick()
backcolour = colval(Mx,My)
if Mc= 1 and backcolour <> 0
wait 300
gosub boardpiece
player = player +1
if player > 2 then player = 1
endif
sync
Ink RGB(255,255,255), RGB(0,0,0)
set text opaque
Text 100,100,"Player: "+Str$(Player)+" "
Text 100,150,"Square: "+Str$(squarex)+" "+Str$(squarey)+" "
gosub win
sync
loop

crosses:
create bitmap 10,100,100
line 1,1,99,99
line 1,2,98,99
line 1,3,97,99
line 2,1,99,98
line 3,1,99,97
line 99,1,1,99
line 98,1,1,98
line 97,1,1,97
line 99,2,2,99
line 99,3,3,99
get image 100,1,1,99,99
set current bitmap 0
return

noughts:
create bitmap 11,100,100
circle 50,50,49
circle 50,50,48
circle 50,50,47
circle 50,50,46
get image 101,1,1,99,99
set current bitmap 0
return

createboard:
create bitmap 1,400,400
set current bitmap 1
Ink RGB(255,255,255),RGB(255,255,255)
box 0,0,300,300
Ink RGB(0,0,0),RGB(0,0,0)
box 1,1,99,99
box 101,1,199,99
box 201,1,299,99
box 1,101,99,199
box 101,101,199,199
box 201,101,299,199
box 1,201,99,299
box 101,201,199,299
box 201,201,299,299
get image 1,0,0,300,300
set current bitmap 0
paste image 1, 250,150
delete bitmap 1
return

backboard:
create bitmap 2, 800,600
set current bitmap 2
Ink RGB(255,255,255),RGB(255,255,255)`square 1
box 251,151,349,249
Ink RGB(255,0,255),RGB(255,0,255)`square 2
box 351,151,449,249
Ink RGB(255,255,0),RGB(255,255,0)`square 3
box 451,151,549,249
Ink RGB(0,255,255),RGB(0,255,255)`square 4
box 251,251,349,349
Ink RGB(255,0,0),RGB(255,0,0)`square 5
box 351,251,449,349
Ink RGB(0,255,0),RGB(0,255,0)`square 6
box 451,251,549,349
Ink RGB(0,0,255),RGB(0,0,255)`square 7
box 251,351,349,449
Ink RGB(100,100,100),RGB(100,100,100)`square 8
box 351,351,449,449
Ink RGB(200,200,200),RGB(200,200,200)`square 9
box 451,351,549,449
set current bitmap 0
return

boardpiece:
select backcolour
case 16777215
squarex = 1
squarey = 1
If player = 1
paste image 100,251,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 16711935
squarex = 1
squarey = 2
If player = 1
paste image 100,351,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 16776960
squarex = 1
squarey = 3
If player = 1
paste image 100,451,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 65535
squarex = 2
squarey = 1
If player = 1
paste image 100,251,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 16711680
squarex = 2
squarey = 2
If player = 1
paste image 100,351,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 65280
squarex = 3
squarey = 2
If player = 1
paste image 100,451,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 255
squarex = 1
squarey = 3
If player = 1
paste image 100,251,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,351
squares(squarex,squarey) = 2
endif
endif
endcase
case 6579300
If player = 1
paste image 100,351,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,351
squares(squarex,squarey) = 2
endif
endif
endcase
case 13158600
squarex = 3
squarey = 3
If player = 1
paste image 100,451,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,351
squares(squarex,squarey) = 2
endif
endif
endcase
endselect
return


function colval(x,y)
set current bitmap 2
colour = point(x,y)
set current bitmap 0
endfunction colour

win:
for a = 1 to 2
x=1 : y=1
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x+1,y+1)=a and squares(x+2,y+2)=a then win = 1
x=3 : y=1
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x-1,y+1)=a and squares(x-2,y+2)=a then win = 1
x=1 : y=3
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x+1,y-1)=a and squares(x+2,y-2)=a then win = 1
x=3 : y=3
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x-1,y-1)=a and squares(x-2,y-2)=a then win = 1
x=2 : y=1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
x=2 : y=3
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
x=3 : y=2
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
x=1 : y=2
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
next a

if win= 1
repeat
Text 200,200,"Player: "+Str$(a)+" wins!!"
Text 200,250,"Press space to restart"
until Spacekey() = 1
win = 0
goto start:
endif
return

`Pillarofire's tic-tac-toe
set display mode 800,600,32
set window size 800,600

sync on

` To tell whos turn it is.
global PlayerTurn as integer
` An array to keep track of the game
global xDim as integer
global zDim as integer
` Boards position
global BoardX as integer
global BoardY as integer
global tileSize as integer

global TEST$ as string

` it is expandable...
makeBoard( 3, 3, 100, 40, 40 )
PlayerTurn = 1

P1Color = RGB(0,0,255)
P2Color = RGB(255,0,0)

do

  UpdateBoard()

  if checkWin( 1 ) then ink 56435,0 : text mousex(), mousey(), "Congratulations Player " + str$(1) + "!!!!!" : wait 1000 : end

  text mousex(), mousey()+20, TEST$ :` wait key

  if spacekey() then resetBoard()
  sync
loop



function resetBoard()
  for i = 0 to array count( Board(0) )
    Board(i)=0
  next i
endfunction

function UpdateBoard()
  xx = BoardX : zz = BoardY
  for x = 0 to xDim-1
    for z = 0 to zDim-1
      `Draw the tile to (xPosition,yPosition)
      xx = BoardX + x * tileSize : zz = BoardY + z * tileSize
      ovr = mousex() > xx and mousex() < xx + tileSize-1 and mousey() > zz and mousey() < zz + tileSize-1
      pos = z * xDim + x
      if ovr
        if mouseclick()=1 then makeMove(pos)
        c1 = rgb(128,128,255)
       else
        if Board(pos) <> 0
          ` This tile has been claimed
          c1 = RGB(0,0,160)
         else
          c1 = rgb(64,64,128)
        endif
      endif


      box xx, zz, xx + tileSize-1, zz + tileSize-1, c1, c1, c1, c1

      ink 0, 0
      text xx, zz, str$(c1) + " : " + str$(Board(pos))
    next z
  next x
endfunction

function makeBoard( xDimension as integer, zDimension as integer, TileSizes as integer, xPosition as integer, yPosition as integer )
  a = ( xDimension )*( zDimension )
  xDim = xDimension : zDim = zDimension : tileSize = TileSizes
  BoardX = xPosition : BoardY = yPosition
  if a>1
    dim Board(a-1) as integer
   else
    end
  endif
endfunction

function nextMove()

endfunction pos

function makeMove( pos as integer )
  ` Set the flag at pos, to the current players ID, only if flag is empty.
  if Board( pos ) = 0 then Board( pos ) = PlayerTurn else exitfunction 0
endfunction foo


`Returns 1 if the player meets the winning conditions
function checkWin( Player as integer )
  p = Player
` If there are more than greater(xDim,zDim) in a row then player wins.
  ` First check the horizontals
  for z = 0 to zDim-1
    for x = 0 to xDim-1
      pos = z*xDim+x
      if Board(pos) = p then win = win + 1 else win = 0 : exit
    next x
    if win = xDim then exitfunction 1
  next z
  ` Second check verticals
  for x = 0 to xDim-1
    for z = 0 to zDim-1
      pos = z*(xDim)+x
      if Board(pos) = p then win = win + 1 else win = 0 : exit
    next z
    if win = zDim then exitfunction 1
  next x
  ` Third check diagonals
  diag = lowest(xDim,zDim)
  for x = 0 to diag-1
    pos = x*(diag)+x
    if Board(pos) = p then win = win + 1 else win = 0 : exit
  next x
  if win = diag then exitfunction 1
break
  z=0
  for x = diag-1 to 0 step -1
    pos = z*(diag)+x
    if Board(pos) = p then win = win + 1 else win = 0 : exit
    inc z
  next x
  if win = diag then exitfunction 1
endfunction win

function lowest( a as integer, b as integer )
  if a < b then exitfunction a else exitfunction b
endfunction a

function greatest( a as integer, b as integer )
  if a > b then exitfunction a else exitfunction b
endfunction a

`Monks noughts and crosses
start:
set display mode 800,600,16
set window size 800,600
set window position 250,150
show mouse
set text size 32

gosub crosses
gosub noughts
dim squares(3,3)

gosub createboard
gosub backboard
player = 1 :count = 0
do
if count = 9
repeat
Text 200,200,"Draw!"
Text 200,250,"Press space to restart"
until Spacekey() = 1
goto start:
endif
Mx = Mousex() : My = mousey() : Mc = Mouseclick()
backcolour = colval(Mx,My)
if Mc= 1 and backcolour <> 0
wait 300
gosub boardpiece
player = player +1
count= count +1
if player > 2 then player = 1
endif
sync
Ink RGB(255,255,255), RGB(0,0,0)
set text opaque
Text 100,100,"Player: "+Str$(Player)+" "
`Text 100,150,"Square: "+Str$(squarex)+" "+Str$(squarey)+" "
gosub win
sync
loop

crosses:
create bitmap 10,100,100
line 1,1,99,99
line 1,2,98,99
line 1,3,97,99
line 2,1,99,98
line 3,1,99,97
line 99,1,1,99
line 98,1,1,98
line 97,1,1,97
line 99,2,2,99
line 99,3,3,99
get image 100,1,1,99,99
set current bitmap 0
return

noughts:
create bitmap 11,100,100
circle 50,50,49
circle 50,50,48
circle 50,50,47
circle 50,50,46
get image 101,1,1,99,99
set current bitmap 0
return

createboard:
create bitmap 1,400,400
set current bitmap 1
Ink RGB(255,255,255),RGB(255,255,255)
box 0,0,300,300
Ink RGB(0,0,0),RGB(0,0,0)
box 1,1,99,99
box 101,1,199,99
box 201,1,299,99
box 1,101,99,199
box 101,101,199,199
box 201,101,299,199
box 1,201,99,299
box 101,201,199,299
box 201,201,299,299
get image 1,0,0,300,300
set current bitmap 0
paste image 1, 250,150
delete bitmap 1
return

backboard:
create bitmap 2, 800,600
set current bitmap 2
Ink RGB(255,255,255),RGB(255,255,255)`square 1
box 251,151,349,249
Ink RGB(255,0,255),RGB(255,0,255)`square 2
box 351,151,449,249
Ink RGB(255,255,0),RGB(255,255,0)`square 3
box 451,151,549,249
Ink RGB(0,255,255),RGB(0,255,255)`square 4
box 251,251,349,349
Ink RGB(255,0,0),RGB(255,0,0)`square 5
box 351,251,449,349
Ink RGB(0,255,0),RGB(0,255,0)`square 6
box 451,251,549,349
Ink RGB(0,0,255),RGB(0,0,255)`square 7
box 251,351,349,449
Ink RGB(100,100,100),RGB(100,100,100)`square 8
box 351,351,449,449
Ink RGB(200,200,200),RGB(200,200,200)`square 9
box 451,351,549,449
set current bitmap 0
return

boardpiece:
select backcolour
case 16777215
squarex = 1
squarey = 1
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,251,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 16711935
squarex = 1
squarey = 2
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,351,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 16776960
squarex = 1
squarey = 3
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,451,151
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,151
squares(squarex,squarey) = 2
endif
endif
endcase
case 65535
squarex = 2
squarey = 1
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,251,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 16711680
squarex = 2
squarey = 2
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,351,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 65280
squarex = 2
squarey = 3
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,451,251
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,251
squares(squarex,squarey) = 2
endif
endif
endcase
case 255
squarex = 3
squarey = 1
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,251,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 251,351
squares(squarex,squarey) = 2
endif
endif
endcase
case 6579300
squarex = 3
squarey = 2
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,351,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 351,351
squares(squarex,squarey) = 2
endif
endif
endcase
case 13158600
squarex = 3
squarey = 3
if squares(squarex,squarey)=1 or squares(squarex,squarey)=2 then player = player-1 : return
If player = 1
paste image 100,451,351
squares(squarex,squarey) = 1
else if player = 2
paste image 101, 451,351
squares(squarex,squarey) = 2
endif
endif
endcase
endselect
return


function colval(x,y)
set current bitmap 2
colour = point(x,y)
set current bitmap 0
endfunction colour

win:
a = 1
x=1 : y=1 : win = 0
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x+1,y+1)=a and squares(x+2,y+2)=a then win = 1
x=3 : y=1
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x-1,y+1)=a and squares(x-2,y+2)=a then win = 1
x=1 : y=3
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x+1,y-1)=a and squares(x+2,y-2)=a then win = 1
x=3 : y=3
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x-1,y-1)=a and squares(x-2,y-2)=a then win = 1
x=2 : y=1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
x=2 : y=3
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
x=3 : y=2
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
x=1 : y=2
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1

if win = 0
a = 2
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x+1,y+1)=a and squares(x+2,y+2)=a then win = 1
x=3 : y=1
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
If squares(x,y)=a and squares(x-1,y+1)=a and squares(x-2,y+2)=a then win = 1
x=1 : y=3
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x+1,y-1)=a and squares(x+2,y-2)=a then win = 1
x=3 : y=3
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
If squares(x,y)=a and squares(x-1,y-1)=a and squares(x-2,y-2)=a then win = 1
x=2 : y=1
if squares(x,y)=a and squares(x,y+1)=a and squares(x,y+2)=a then win = 1
x=2 : y=3
if squares(x,y)=a and squares(x,y-1)=a and squares(x,y-2)=a then win = 1
x=3 : y=2
if squares(x,y)=a and squares(x-1,y)=a and squares(x-2,y)=a then win = 1
x=1 : y=2
if squares(x,y)=a and squares(x+1,y)=a and squares(x+2,y)=a then win = 1
endif

if win= 1
repeat
Text 200,200,"Player: "+Str$(a)+" wins!!"
Text 200,250,"Press space to restart"
until Spacekey() = 1
win = 0
goto start:
endif
return

Monk - Noughts & Crosses (tic-tac-toe)
For having some winning logic in the game.

PS. I didn't look at your late code for this judging
    it gives me an array error