Sorry your browser is not supported!

`===== General Setup ========
set display mode 1024,768,32
sync on : sync rate 60


`===== Variable Setup =======

`These are the base objects, which should be instanced in the main game
#Constant PlayerObject           1
#Constant HeartObject            2
#Constant ClockObject            3
#Constant CrossObject            4
#Constant StarObject             5

#Constant BlankPyramidObject     6
#Constant GratePyramidObject     7
#Constant CrossPyramidObject     8
#Constant StarPyramidObject      9
#Constant HeartPyramidObject     10
#Constant LoopPyramidObject      11
#Constant BoostPyramidObject     12
#Constant ClockPyramidObject     13
#Constant ArrowPyramidObject     14
#Constant RadiationPyramidObject 15

`Images
#Constant CloudsImage            1
#Constant GridImage              2


`===== Load Media ===========

cd "Media"
Load Object "Heart01.x",  HeartObject
Load Object "Player02.x", PlayerObject
Load Object "Star01.x",   StarObject
Load Object "Watch01.x",  ClockObject
Load Object "RedCross.x", CrossObject

Load Object "Pyrmid0.x",  BlankPyramidObject
Load Object "Pyrmid1.x",  ArrowPyramidObject
Load Object "Pyrmid2.x",  RadiationPyramidObject
Load Object "Pyrmid3.x",  GratePyramidObject
Load Object "Pyrmid4.x",  CrossPyramidObject
Load Object "Pyrmid5.x",  StarPyramidObject
Load Object "Pyrmid6.x",  HeartPyramidObject
Load Object "Pyrmid7.x",  LoopPyramidObject
Load Object "Pyrmid8.x",  BoostPyramidObject
Load Object "Pyrmid9.x",  ClockPyramidObject

for a=1 to 15
    Exclude Object On a
next a

Load Image "Clouds1.png",     CloudsImage
Load Image "Grid_Fill01.bmp", GridImage


`===== Menu =================

MainMenu:
do



sync
loop


`============================
`===== Main Loop!!!!! =======

do



sync
loop

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

`Logic constants
#Constant BoardHeight     20 ` Note: these are the highest possible values
#Constant BoardWidth      20 ` The board can be any size bettween 1 * 1 and these values

`Schnitz note: If you ever used OOP, pretend these are private
`use functions only!
setup_logic:
    dim Blocks(BoardHeight - 1, BoardWidth - 1) as Block ` Static
    dim Items(0) as Item ` Dynamic
    Global CurrentHeight as integer : CurrentHeight = BoardHeight
    Global CurrentWidth as integer : CurrentWidth = BoardWidth
    Global SetUp as boolean : SetUp = 0
return

type Block ` Block tile thing
    direction as integer `Direction: 0-left : 1-up : 2-right : 3-down
    item as integer `The index of the item at this point or zero if none
    filled as boolean `Is this block walkable
endtype

type Item ` Item such as powerup or something
    alive as boolean `Does this thing even work?
    itemtype as integer ` What is this thing?
endtype

`Call me before using the board
function SetupBoard(Width as integer, Height as integer)
    if Width < 1 or Height < 1 or Width > BoardWidth or Height > BoardHeight
        exit prompt "Parameter error at SetupBoard" , "Error"
        end
    endif
    SetUp = 1
    CurrentWidth = Width
    CurrentHeight = Height
    empty array Items(0)
    for x = 0 to Width - 1
        for y = 0 to Height - 1
            Blocks(x, y).item = 0
            Blocks(x, y).direction = 0
            Blocks(x, y).filled = 0
        next y
    next x
endfunction

`Call me to set up the board tiles
function RandomizeBoard(UnfilledAmount as integer)
    if SetUp = 0
        exit prompt "Board not set up yet at RandomizeBoard()" , "Error"
        end
    endif
    if UnfilledAmount > CurrentWidth * CurrentHeight or UnfilledAmount < 0
        exit prompt "Parameter error at RandomizeBoard()" , "Error"
        end
    endif
    
    `Set random directions
    for x = 0 to CurrentWidth - 1
        for y = 0 to CurrentHeight - 1
            Blocks(x, y).direction = rnd(4)
            Blocks(x, y).filled = 1
        next y
    next x
    
    `Make a logic gap
    if UnfilledAmount > 0
        `Start of gap
        gapx = rnd(CurrentWidth - 1)
        gapy = rnd(CurrentHeight - 1)
        Blocks(gapx, gapy).filled = 0
        needtofill = UnfilledAmount - 1
        do ` Randomly add gaps that are near another gap to create... a big gap
            nextx = rnd(CurrentWidth - 1)
            nexty = rnd(CurrentHeight - 1)
            fillthisspace = 0
            if nextx < CurrentWidth - 1
                if Blocks(nextx + 1, nexty).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nexty < CurrentHeight - 1
                if Blocks(nextx, nexty + 1).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nextx > 0
                if Blocks(nextx - 1, nexty).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nexty > 0
                if Blocks(nextx, nexty - 1).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if Blocks(nextx, nexty).filled = 0
                fillthisspace = 0
            endif
            `fillthisspace now has a value over 0 if nextx and nexty border a unfilled space
            `do what the varible tells you to
            if fillthisspace > 0
                dec UnfilledAmount, 1
                Blocks(nextx, nexty).filled = 0
                if UnfilledAmount = 0 then exit
            endif
        loop
    endif
endfunction

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

hide mouse

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


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

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

   set current bitmap 0

endfunction

`===== General Setup ========
set display mode 1024,768,32
sync on : sync rate 60

`disable escapekey


`===== Variable Setup =======

`These are the base objects, which should be instanced in the main game
#Constant PlayerObject           1
#Constant HeartObject            2
#Constant ClockObject            3
#Constant CrossObject            4
#Constant StarObject             5

#Constant BlankPyramidObject     6
#Constant GratePyramidObject     7
#Constant CrossPyramidObject     8
#Constant StarPyramidObject      9
#Constant HeartPyramidObject     10
#Constant LoopPyramidObject      11
#Constant BoostPyramidObject     12
#Constant ClockPyramidObject     13
#Constant ArrowPyramidObject     14
#Constant RadiationPyramidObject 15

#Constant CloudObject            16

`Images
#Constant CloudsImage            1
#Constant GridImage              2

global HoverSpeed as Float
HoverSpeed=0.01
global RotateSpeed as Float
global StartAngle as Integer
StartAngle=400
global Started as Integer


`===== Load Media ===========

cd "Media"
Load Object "Heart01.x",  HeartObject
Load Object "Player02.x", PlayerObject
Load Object "Star01.x",   StarObject
Load Object "Watch01.x",  ClockObject
Load Object "RedCross.x", CrossObject

Load Object "Pyrmid0.x",  BlankPyramidObject
Load Object "Pyrmid1.x",  ArrowPyramidObject
Load Object "Pyrmid2.x",  RadiationPyramidObject
Load Object "Pyrmid3.x",  GratePyramidObject
Load Object "Pyrmid4.x",  CrossPyramidObject
Load Object "Pyrmid5.x",  StarPyramidObject
Load Object "Pyrmid6.x",  HeartPyramidObject
Load Object "Pyrmid7.x",  LoopPyramidObject
Load Object "Pyrmid8.x",  BoostPyramidObject
Load Object "Pyrmid9.x",  ClockPyramidObject

`Clouds
make object cube CloudObject,Image Width(CloudsImage)
texture object CloudObject,CloudsImage

for a=2 to 15
    Exclude Object On a
next a

Load Image "Clouds1.png",     CloudsImage
Load Image "Grid_Fill01.bmp", GridImage


`===== Menu =================
remstart
MainMenu:
do



sync
loop
remend

`============================
`===== Main Loop!!!!! =======

position camera 70,70,70
point camera 0,0,0

do


MoveClouds()
HoverPlayer(150,3)
if leftkey()=1 and Started=0
    Started=-1
endif
if rightkey()=1 and Started=0
    Started=1
endif

RotatePlayer(1000,Started)

sync
loop

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

function MoveClouds()

endfunction

function HoverPlayer(SpeedMultiplier,Distance)

if object position y(PlayerObject)<Distance/2
    inc HoverSpeed,0.00001*SpeedMultiplier
endif
if object position y(PlayerObject)>Distance/2
    dec HoverSpeed,0.00001*SpeedMultiplier
endif
position object PlayerObject,object position x(PlayerObject),object position y(PlayerObject)+HoverSpeed,object position z(PlayerObject)

endfunction

function RotatePlayer(SpeedMultiplier,Direction)

if Direction=1
    if StartAngle=400
        RotateSpeed=0.000000001
        StartAngle=object angle y(PlayerObject)
    endif
    if object angle y(PlayerObject)<wrapvalue(StartAngle+45)
        inc RotateSpeed,0.00001*SpeedMultiplier
    endif
    if object angle y(PlayerObject)>wrapvalue(StartAngle+45)
        dec RotateSpeed,0.00001*SpeedMultiplier
    endif
    yrotate object PlayerObject,wrapvalue(RotateSpeed+object angle Y(PlayerObject))
    if object angle y(PlayerObject)>=wrapvalue(StartAngle+90)-RotateSpeed and object angle y(PlayerObject)<=wrapvalue(StartAngle+90)+RotateSpeed
        yrotate object PlayerObject,wrapvalue(StartAngle+90)
        StartAngle=400
        RotateSpeed=0
        Started=0
    endif
endif
if Direction=-1
    if StartAngle=400
        RotateSpeed=-0.000000001
        StartAngle=object angle y(PlayerObject)
    endif
    if object angle y(PlayerObject)>wrapvalue(StartAngle-45)
        dec RotateSpeed,0.00001*SpeedMultiplier
    endif
    if object angle y(PlayerObject)<wrapvalue(StartAngle-45)
        inc RotateSpeed,0.00001*SpeedMultiplier
    endif
    yrotate object PlayerObject,wrapvalue(RotateSpeed+object angle Y(PlayerObject))
    if object angle y(PlayerObject)>=wrapvalue(StartAngle-90)-RotateSpeed and object angle y(PlayerObject)<=wrapvalue(StartAngle-90)+RotateSpeed
        yrotate object PlayerObject,wrapvalue(StartAngle-90)
        StartAngle=400
        RotateSpeed=0
        Started=0
    endif
endif

print object angle y(PlayerObject)

endfunction

Sync On
Sync Rate 60
Set Display Mode 1280,1024,32
Hide Mouse

Make Object Cube 1,10

For i = 1 to 10
   Make Object Cube i+1,10
   Position Object i+1,Rnd(100),0,Rnd(100)
   Color Object i+1,Rgb(Rnd(255),Rnd(255),Rnd(255))
Next i

Do
   Text 0,0,Str$(Screen FPS())

   Get Image 1,MouseX(),MouseY(),MouseX()+200,MouseY()+200
   MakeImageGreyScale(1)
   Paste Image 1,MouseX(),MouseY()

   aY# = Object Angle Y(1)
   Color Object 1,Rgb(Sin(aY#)*127+127,Sin(aY#*2)*127+127,Sin(aY#*3)*127+127)
   YRotate Object 1,WrapValue(aY#+1)

   Control Camera Using Arrowkeys 0,1,1
   Sync
Loop


Function MakeImageGreyScale(Image)
   Memblock = Find Free Memblock()
   Make Memblock From Image Memblock,Image
   Pixels = (Get Memblock Size(Memblock)-12)/4
   For i = 1 to Pixels
      Position = (i-1)*4+12
      Blue = Memblock Byte(Memblock,Position)
      Green = Memblock Byte(Memblock,Position+1)
      Red = Memblock Byte(Memblock,Position+2)
      Greyscale = Int((Red+Blue+Green)/3.0)
      Write Memblock Byte Memblock,Position,Greyscale
      Write Memblock Byte Memblock,Position+1,Greyscale
      Write Memblock Byte Memblock,Position+2,Greyscale
   Next i
   Make Image From Memblock Image,Memblock
   Delete Memblock Memblock
Endfunction

set display mode 1024,768,32
sync on : sync rate 0

gosub setup_logic
SetupBoard(20, 20)
RandomizeBoard(0)
press = 0
moves = 0
changea = -1
changeb = -1
ax = 0
ay = 0
movecounter = 0
do
    Rem drawing
    for x = 0 to 19
        for y = 0 to 19
            if Blocks(x,y).filled = 1
                l = x * 20
                t = y * 20
                r = (x + 1) * 20
                b = (y + 1) * 20
                gray = rgb(128,128,128)
                white = rgb(255,255,255)
                select Blocks(x,y).direction 
                    case 0:
                        ink white,0
                        box l + 1,t + 5,l + 10 ,b - 5
                        ink gray,0
                        box l + 10,t + 5,r - 1 ,b - 5
                    endcase
                    case 1:
                        ink white,0
                        box l + 5,t + 1,r - 5 ,t + 10
                        ink gray,0
                        box l + 5,t + 10,r - 5 ,b - 1
                    endcase
                    case 2:
                        ink gray,0
                        box l + 1,t + 5,l + 10 ,b - 5
                        ink white,0
                        box l + 10,t + 5,r - 1 ,b - 5
                    endcase
                    case 3:
                        ink gray,0
                        box l + 5,t + 1,r - 5 ,t + 10
                        ink white,0
                        box l + 5,t + 10,r - 5 ,b - 1
                    endcase
                endselect
                if changea > -1 and ax = x and ay = y
                    ink rgb(255,0,0),0
                    circle l + 10, t + 10, 10
                endif
                if PlayerX = x and PlayerY = y
                    ink rgb(0,255,255),0
                    circle l + 10, t + 10, 8
                    circle l + 10, t + 10, 7
                endif
            endif
        next y
    next x
    Rem input
    if press = 0 and moves = 0
        if mouseclick() = 1 and moves = 0
            if mousex() < 400 and mousey() < 400
                x = mousex() / 20
                y = mousey() / 20
                dire = Blocks(x,y).direction
                if Blocks(x,y).filled = 1
                    if changea = -1
                        changea = dire
                        ax = x
                        ay = y
                    else
                        if changeb = -1
                            if changea <> dire
                                changeb = dire
                                Swap(changea, changeb)
                                changea = -1
                                changeb = -1
                            endif
                        endif
                    endif
                endif
            endif
            press = 1
        endif
        if spacekey() = 1
            press = 1
            if moves = 0
                moves = 3
            endif
        endif
    endif
    if mouseclick() = 0 and spacekey() = 0
        press = 0
    endif
    Rem moving
    if moves > 0
        if movecounter > 100
            movecounter = 0
            Move()
            moves = moves - 1
            if Lost = 1
                exit prompt "You Lost","Ha Ha!"
                end
            endif
        else
            inc movecounter
        endif
    endif
    REM text
    ink rgb(255,255,255),0
    set cursor 0,400
    print "Press space to move"
    set cursor 0,420
    print "FPS: " + str$(screen fps())
    if moves > 0
        set cursor 0,440
        print "Moves left: " + str$(moves)
    endif
    sync
    cls
loop

`Logic constants
#Constant BoardHeight     20 ` Note: these are the highest possible values
#Constant BoardWidth      20 ` The board can be any size bettween 1 * 1 and these values

`Schnitz note: If you ever used OOP, pretend these are private or read only
`use functions only!
setup_logic:
    dim Blocks(BoardHeight - 1, BoardWidth - 1) as Block ` Static
    dim Items(0) as Item ` Dynamic
    Global CurrentHeight as integer : CurrentHeight = BoardHeight
    Global CurrentWidth as integer : CurrentWidth = BoardWidth
    Global PlayerX as integer
    Global PlayerY as integer
    Global SetUp as boolean : SetUp = 0
    Global Lost as boolean
return

type Block ` Block tile thing
    direction as integer `Direction: 0-left : 1-up : 2-right : 3-down
    item as integer `The index of the item at this point or zero if none
    filled as boolean `Is this block walkable
endtype

type Item ` Item such as powerup or something
    alive as boolean `Does this thing even work?
    itemtype as integer ` What is this thing?
endtype

`Call me before using the board
function SetupBoard(Width as integer, Height as integer)
    ` ****************** TEST CODE ONLY, REMOVE ON RELEASE ****
    if Width < 1 or Height < 1 or Width > BoardWidth or Height > BoardHeight
        exit prompt "Parameter error at SetupBoard" , "Error"
        end
    endif
    ` *********************************************************
    SetUp = 1
    CurrentWidth = Width
    CurrentHeight = Height
    PlayerX = 0
    PlayerY = 0
    Lost = 0
    empty array Items(0)
    for x = 0 to Width - 1
        for y = 0 to Height - 1
            Blocks(x, y).item = 0
            Blocks(x, y).direction = 0
            Blocks(x, y).filled = 0
        next y
    next x
endfunction

`Call me to set up the board tiles
function RandomizeBoard(UnfilledAmount as integer)
    ` ****************** TEST CODE ONLY, REMOVE ON RELEASE ****
    if SetUp = 0
        exit prompt "Board not set up yet at RandomizeBoard()" , "Error"
        end
    endif
    if UnfilledAmount > CurrentWidth * CurrentHeight or UnfilledAmount < 0
        exit prompt "Parameter error at RandomizeBoard()" , "Error"
        end
    endif
    ` *********************************************************
    
    `Set random directions
    for x = 0 to CurrentWidth - 1
        for y = 0 to CurrentHeight - 1
            Blocks(x, y).direction = rnd(3)
            Blocks(x, y).filled = 1
        next y
    next x
    
    `Make a logic gap
    if UnfilledAmount > 0
        `Start of gap
        gapx = rnd(CurrentWidth - 1)
        gapy = rnd(CurrentHeight - 1)
        Blocks(gapx, gapy).filled = 0
        needtofill = UnfilledAmount - 1
        do ` Randomly add gaps that are near another gap to create... a big gap
            nextx = rnd(CurrentWidth - 1)
            nexty = rnd(CurrentHeight - 1)
            fillthisspace = 0
            if nextx < CurrentWidth - 1
                if Blocks(nextx + 1, nexty).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nexty < CurrentHeight - 1
                if Blocks(nextx, nexty + 1).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nextx > 0
                if Blocks(nextx - 1, nexty).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if nexty > 0
                if Blocks(nextx, nexty - 1).filled = 0
                    inc fillthisspace, 1
                endif
            endif
            if Blocks(nextx, nexty).filled = 0
                fillthisspace = 0
            endif
            `fillthisspace now has a value over 0 if nextx and nexty border a unfilled space
            `do what the varible tells you to
            if fillthisspace > 0
                dec UnfilledAmount, 1
                Blocks(nextx, nexty).filled = 0
                if UnfilledAmount = 0 then exit
            endif
        loop
    endif
endfunction

`Swap two directions
function Swap(DirectionA, DirectionB)
    ` ****************** TEST CODE ONLY, REMOVE ON RELEASE ****
    if SetUp = 0
        exit prompt "Board not set up yet at Swap()" , "Error"
        end
    endif
    if DirectionA < 0 or DirectionA > 3 or DirectionB < 0 or DirectionB > 3
        exit prompt "Parameter error at Swap()" , "Error"
        end
    endif
    ` *********************************************************
    for x = 0 to CurrentWidth - 1
        for y = 0 to CurrentHeight - 1
            `Swap
            if Blocks(x, y).filled = 1
                if Blocks(x, y).direction = DirectionA
                    Blocks(x, y).direction = DirectionB
                else
                    if Blocks(x, y).direction = DirectionB
                        Blocks(x, y).direction = DirectionA
                    endif
                endif
            endif
        next y
    next x
endfunction

`Move player once
function Move()
    ` ****************** TEST CODE ONLY, REMOVE ON RELEASE ****
    if SetUp = 0
        exit prompt "Board not set up yet at Move()" , "Error"
        end
    endif
    if Lost = 1
        exit prompt "Already lost at Move()" , "Error"
        end
    endif
    ` *********************************************************
    directionunder = Blocks(PlayerX, PlayerY).direction
    Blocks(PlayerX, PlayerY).filled = 0
    select directionunder
        case 0:
            dec PlayerX, 1
        endcase
        case 1:
            dec PlayerY, 1
        endcase
        case 2:
            inc PlayerX, 1
        endcase
        case 3:
            inc PlayerY, 1
        endcase
    endselect
    `Lost?
    if PlayerX < 0 or PlayerY < 0 or PlayerX >= CurrentWidth or PlayerY >= CurrentHeight
        Lost = 1
    endif
    if Blocks(PlayerX, PlayerY).filled = 0
        Lost = 1
    endif
endfunction

`=====================================
`== DarkBASIC Pro Community Project ==
`==      "Changing Pathways"        ==
`=====================================
`Started: 3/19/08 by David Gervais

`When you want to add a new effect to the project, please put it in a function.
`Add the function to the end of the code with a short description of what it does,
`and call it at the appropriate location in the main loop.  This keeps most of your
`stuff from interfering with stuff that is already in the program.

`To compile, you'll need to save David's media into a folder named "Media" that is
`in the same folder as this file.  Find it on the forum thread.

`============================
`==     Variable Setup     ==

remstart  -- not enough info (original)
type Block ` Block tile thing
    direction as integer `Direction: 0-left : 1-up : 2-right : 3-down
    item as integer `The index of the item at this point or zero if none
    filled as boolean `Is this block walkable
endtype
remend

rem this is mine wlb
type Block
    object as integer
    direction as integer `Direction: 0-left : 1-up : 2-right : 3-down
    item as integer `The index of the item at this point or zero if none
    filled as boolean `Is this block walkable
endtype

type Item ` Item such as powerup or something
    alive as boolean `Does this thing even work?
    itemtype as integer ` What is this thing?
endtype

`These are the base objects, which should be instanced in the main game
#Constant PlayerObject           1
#Constant HeartObject            2
#Constant ClockObject            3
#Constant CrossObject            4
#Constant StarObject             5

#Constant BlankPyramidObject     6
#Constant GratePyramidObject     7
#Constant CrossPyramidObject     8
#Constant StarPyramidObject      9
#Constant HeartPyramidObject     10
#Constant LoopPyramidObject      11
#Constant BoostPyramidObject     12
#Constant ClockPyramidObject     13
#Constant ArrowPyramidObject     14
#Constant RadiationPyramidObject 15

#Constant CloudObject            16
`gonna need something to hold the grid image
#Constant GridObject             17

`Images
#Constant CloudsImage            1
#Constant GridImage              2

`Logic constants
#Constant BoardHeight     20 ` Note: these are the highest possible values
#Constant BoardWidth      20 ` The board can be any size between 1*1 and these values

`global variables
`these variables control board creation and placement
global boardObjectStart = 100
global boardSize = 9
global boardEven = 0
global startPoint as Block
global startPosition = 1
global endPoint as Block
global endPosition = 1

`variables for player control
global playerRow = 0
global playerColumn = 0
global playerRowOld=0
global playerColumnOld=-2
global playerSwaps=2
global playerMoves=0

`gui variables
global GuiButtonStart=100
global GuiButtonWidth=50
global GuiButtonHeight=18
global GuiTextSize=36
global GuiButtonX=25
global GuiButtonY=50
global moveButton=1
global swapButton=2
global leftButton=3
global upButton=4
global rightButton=5
global downButton=6
global okButton=7
global redoButton=8

`swap variables
global swapSource=4
global swapTarget=4
global swapSourceSave
global swapTargetSave

`main loop run state
`
` 0=fresh start
` 1=need to choose move or swap
` 2=move player
` 3=select arrows to swap
` 4=swap arrows
` 5=round over
global runState=0
`
`player movement state
` 0=not moving
` 1=change direction
` 2=player in motion
` 3=player move complete
global playerMoveState=0

`message Box variables
global messageBoxMap=0
global messageBoxSprite=0
global messageBoxImage=0
global messageBoxDisplay=0

`this is for test purposes and will be removed later
global test$

`===============================================
`========           Main Code           ========
`===============================================

Initialize()

BuildGui()

RunMenu()

`setup the ground
`this might have to be moved to before menu?
SetupGround()

SetupField()

Build_Message_Box()

`=======================================
`=======     Main Loop!!!!!     ========

do

   RunGui()
   `SwapArrows()
   MovePlayer()
   PlayerTest()
   ResetField()
   MoveClouds()
   HoverPlayer(150,3)
   Hide_Message_Box()

   `showpick()

`set cursor 0,0
`print runState
`print test$
messageBoxText$(7)=test$

sync
loop

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



`=============================================
`====            Functions                ====
`=============================================

`=====================================
`==      Initializing the Game      ==

`This gets the game ready to play by loading objects and setting up variables and stuff
function Initialize()

GeneralSetup()
InitializePlayerEffects() `This sets up certain variables for rotating and hovering the player
LoadGameMedia()

endfunction


`Basic setup stuff
function GeneralSetup()
set display mode 1024,768,32
sync on : sync rate 60
randomize timer()
endfunction


`This sets up some variables that are used to hover the player and rotate it
function InitializePlayerEffects()
global HoverSpeed as Float
HoverSpeed=0.01
global RotateSpeed as Float
global StartAngle as Integer
StartAngle=400
global turnDirection as Integer
endfunction


`This will contain the code and function calls to setup a board for the player
`to play on
function SetupField()

   boardEven=((boardSize mod 2)=0)
   dim playField(boardSize-1,boardSize-1) as Block

   `play field squares
   for i=0 to boardSize-1
      for j=0 to boardSize-1
         playField(i,j).object=boardObjectStart+i*boardSize+j
         playField(i,j).item=ArrowPyramidObject
         playField(i,j).direction=rnd(3)
         playField(i,j).filled=1
         instance object playField(i,j).object,playField(i,j).item
         position object playField(i,j).object,25*((boardSize/2-i)-boardEven),-25,25*((boardSize/2-j)-boardEven)
         yrotate object playField(i,j).object,90*(playField(i,j).direction+1)
      next j
   next i

   `players start square
   startPoint.object=boardObjectStart+boardSize*boardSize
   startPoint.item=BoostPyramidObject
   startPoint.direction=3
   instance object startPoint.object,startPoint.item
   startPosition=rnd(boardSize-1)
   position object startPoint.object,25*((boardSize/2)+1-boardEven),-25,25*((boardSize/2-startPosition)-boardEven)
   yrotate object startPoint.object,90

   `players end square
   endPoint.object=boardObjectStart+boardSize*boardSize+1
   endPoint.item=GratePyramidObject
   instance object endPoint.object,endPoint.item
   endPosition=rnd(boardSize-1)
   position object endPoint.object,25*((boardSize/2-boardSize)-boardEven),-25,25*((boardSize/2-endPosition)-boardEven)
   yrotate object endPoint.object,90

   `position the player
   position object PlayerObject,25*((boardSize/2)+1-boardEven),0,25*((boardSize/2-startPosition)-boardEven)
   playerColumn=-1
   playerRow=startPosition

   position camera 0,250,0
   point camera 0,0,0
   move camera 0,(11-boardSize)*20

endfunction

`destroy play field to be rebuilt next round
function destroyField()

endfunction

`reset the playing field
function ResetField()

if runState=5

   boardEven=((boardSize mod 2)=0)

   `play field squares
   for i=0 to boardSize-1
      for j=0 to boardSize-1
         `playField(i,j).object=boardObjectStart+i*boardSize+j
         playField(i,j).item=ArrowPyramidObject
         playField(i,j).direction=rnd(3)
         playField(i,j).filled=1
         `instance object playField(i,j).object,playField(i,j).item
         position object playField(i,j).object,25*((boardSize/2-i)-boardEven),-25,25*((boardSize/2-j)-boardEven)
         yrotate object playField(i,j).object,90*(playField(i,j).direction+1)
         show object playField(i,j).object
      next j
   next i

   `players start square
   startPoint.object=boardObjectStart+boardSize*boardSize
   startPoint.item=BoostPyramidObject
   startPoint.direction=3
   `instance object startPoint.object,startPoint.item
   startPosition=rnd(boardSize-1)
   position object startPoint.object,25*((boardSize/2)+1-boardEven),-25,25*((boardSize/2-startPosition)-boardEven)
   yrotate object startPoint.object,90

   `players end square
   endPoint.object=boardObjectStart+boardSize*boardSize+1
   endPoint.item=GratePyramidObject
   `instance object endPoint.object,endPoint.item
   endPosition=rnd(boardSize-1)
   position object endPoint.object,25*((boardSize/2-boardSize)-boardEven),-25,25*((boardSize/2-endPosition)-boardEven)
   yrotate object endPoint.object,90

   `position the player
   position object PlayerObject,25*((boardSize/2)+1-boardEven),0,25*((boardSize/2-startPosition)-boardEven)
   playerColumn=-1
   playerRow=startPosition
   playerColumnOld=-2
   playerRowOld=0

   runState=0
   playerSwaps=2
endif

endfunction


`This loads the game's media (duh)
function LoadGameMedia()
cd "Media"
Load Object "Heart01.x",  HeartObject
Load Object "Player02.x", PlayerObject
Load Object "Star01.x",   StarObject
Load Object "Watch01.x",  ClockObject
Load Object "RedCross.x", CrossObject

Load Object "Pyrmid0.x",  BlankPyramidObject
Load Object "Pyrmid1.x",  ArrowPyramidObject
Load Object "Pyrmid2.x",  RadiationPyramidObject
Load Object "Pyrmid3.x",  GratePyramidObject
Load Object "Pyrmid4.x",  CrossPyramidObject
Load Object "Pyrmid5.x",  StarPyramidObject
Load Object "Pyrmid6.x",  HeartPyramidObject
Load Object "Pyrmid7.x",  LoopPyramidObject
Load Object "Pyrmid8.x",  BoostPyramidObject
Load Object "Pyrmid9.x",  ClockPyramidObject

`I don't think this code belongs here
`Clouds (Will scroll along below the playing field)
`make object cube CloudObject,Image Width(CloudsImage)
`texture object CloudObject,CloudsImage

for a=2 to 15
    Exclude Object On a
    `Hide the objects we loaded, because all of them except the player object
    `will be instanced when we use them in the game.
next a

Load Image "Clouds1.png",     CloudsImage
Load Image "Grid_Fill01.bmp", GridImage

endfunction


`=====================================
`==          Run the Menu           ==

`Duh
function RunMenu()

endfunction

function BuildGui()
   `code here
   ts=text size()
   set text size GuiTextSize
   t$="+Right+"
   GuiButtonWidth=10+text width(t$)
   GuiButtonHeight=4+text height(t$)
   set text size ts

   moveButton= BuildButton("Move", GuiButtonY)
   swapButton= BuildButton("Swap", GuiButtonY+  GuiButtonHeight+2)
   leftButton= BuildButton("Left", GuiButtonY+2*GuiButtonHeight+2)
   upButton=   BuildButton("Up",   GuiButtonY+3*GuiButtonHeight+2)
   RightButton=BuildButton("Right",GuiButtonY+4*GuiButtonHeight+2)
   downButton= BuildButton("Down", GuiButtonY+5*GuiButtonHeight+2)
   okButton=   BuildButton("OK",   GuiButtonY+6*GuiButtonHeight+2)
   redoButton= BuildButton("Re-Do",GuiButtonY+7*GuiButtonHeight+2)

endfunction

function RunGui()
   `code here
   select runState
      case 0
         runState=1
      endcase
      case 1
         `also do choice stuff
         MoveOrSwap()
         messageBoxText$(2)="Swaps left: "+str$(playerSwaps)
         messageBoxText$(14)="mousex: "+str$(mousex())
         messageBoxText$(15)="mousey: "+str$(mousey())
         messageBoxText$(16)="screen fps: "+str$(screen fps())
         Show_Message_Box(800,50,100,255)
      endcase
      case 2
         `do move stuff (wich should be nothing for now)
         hide sprite messageBoxSprite
      endcase
      case 3
         `do select arrows stuff
         chooseArrows()
         messageBoxText$(14)="mousex: "+str$(mousex())
         messageBoxText$(15)="mousey: "+str$(mousey())
         messageBoxText$(16)="screen fps: "+str$(screen fps())
         Show_Message_Box(800,50,100,255)
      endcase
      case default
         `do nothing for now
         Show_Message_Box(800,50,100,255)
      endcase
   endselect

endfunction

function MoveOrSwap()
   if playerSwaps=0
      `no choice left - force a move
      runState=2
      playerMoves=3
   else
      hideButtons()
      show sprite moveButton
      show sprite swapButton

      if mouseclick()=1
         mxp=(mousex()>=GuiButtonX)*(mousex()<=(GuiButtonX+GuiButtonWidth))
         myp=(mousey()>=GuiButtonY)*(mousey()<=(GuiButtonY+GuiButtonHeight))
         myp=myp+2*(mousey()>=(GuiButtonY+GuiButtonHeight+2))*(mousey()<=(GuiButtonY+2+2*GuiButtonHeight))
      endif

      runState=runState+mxp*myp

      if runState=2
         hideButtons()
         playerMoves=3
      endif
   endif

endfunction

`<--- select arrows --->
function chooseArrows()
   hideButtons()

   show sprite moveButton
   show sprite leftButton
   show sprite upButton
   show sprite rightButton
   show sprite downButton


   if swapSource<>4
      if swapTarget=4
         hide sprite moveButton
         `select target
         select swapSource
            case 0
               hide sprite leftButton
            endcase
            case 1
               hide sprite upButton
            endcase
            case 2
               hide sprite rightButton
            endcase
            case 3
               hide sprite downButton
            endcase
            case default
               `still looking for source
            endcase
         endselect
         swapTarget=pickArrow()
         if swapTarget=swapSource
            swapTarget=4
         else
            if swapTarget<>4
               runState=4
               swapSourceSave=swapSource
               swapTargetSave=swapTarget
               swapArrows()
            endif
         endif
      else
         `verify choice
         `runState=4
         `swapArrows()
         hideButtons()
         showArrow(swapSource)
         showArrow(swapTarget)
         show sprite okButton
         show sprite redoButton
         if mouseclick()=1
            mxp=(mousex()>=GuiButtonX)*(mousex()<=(GuiButtonX+GuiButtonWidth))
            spy=GuiButtonY+6*GuiButtonHeight+2
            myp=(mousey()>=spy)*(mousey()<=(spy+GuiButtonHeight))
            myp=myp+2*(mousey()>=(spy+GuiButtonHeight+2))*(mousey()<=(spy+2+2*GuiButtonHeight))
            vt=mxp*myp
            if vt=1
               `ok to swap
               `runState=4
               dec playerSwaps
               swapSource=4
               swapTarget=4
               runState=1
               hideButtons()
            endif
            if vt=2
               `re-select arrows
               swapSource=swapTargetSave
               swapTarget=swapSourceSave
               runState=4
               swapArrows()
               swapSource=4
               swapTarget=4
               `runState=3
            endif
         endif
      endif
   else
      `select source
      if mouseclick()=1
         mxp=(mousex()>=GuiButtonX)*(mousex()<=(GuiButtonX+GuiButtonWidth))
         myp=(mousey()>=GuiButtonY)*(mousey()<=(GuiButtonY+GuiButtonHeight))
         if (mxp*myp)=1
            `switch to move state
            runState=2
            hideButtons()
            playerMoves=3
         else
            `get the source arrow
            swapSource=pickArrow()
         endif
      endif
   endif

endfunction

function pickArrow()
   ap=4
   if mouseclick()=1
      mxp=(mousex()>=GuiButtonX)*(mousex()<=(GuiButtonX+GuiButtonWidth))
      aspy=GuiButtonY+2*GuiButtonHeight+2
      myp=(mousey()>=aspy)*(mousey()<=(aspy+GuiButtonHeight))
      myp=myp+2*(mousey()>=(aspy+GuiButtonHeight+2))*(mousey()<=(aspy+2+2*GuiButtonHeight))
      myp=myp+3*(mousey()>=(aspy+2*GuiButtonHeight+2))*(mousey()<=(aspy+2+3*GuiButtonHeight))
      myp=myp+4*(mousey()>=(aspy+3*GuiButtonHeight+2))*(mousey()<=(aspy+2+4*GuiButtonHeight))
      ap=mxp*myp-1
      if ap<0 then ap=4
   endif

endfunction ap

function showArrow(a)
   select a
         case 0
            show sprite leftButton
         endcase
         case 1
            show sprite upButton
         endcase
         case 2
            show sprite rightButton
         endcase
         case 3
            show sprite downButton
         endcase
         case default
            `still looking for source
         endcase
   endselect

endfunction

function hideButtons()
   hide sprite moveButton
   hide sprite swapButton
   hide sprite rightButton
   hide sprite leftButton
   hide sprite upButton
   hide sprite downButton
   hide sprite okButton
   hide sprite redoButton

endfunction

`Build buttons for the GUI
function BuildButton(t$,by)

   ts=text size()
   set text size GuiTextSize
   bmw=GuiButtonWidth
   bmh=GuiButtonHeight

   bm=1
   while bitmap exist(bm)
      inc bm
   endwhile

   create bitmap bm,bmw,bmh

   blazeColor=rgb(255,255,0)
   backColor=rgb(255,0,0)
   outlineColor=rgb(22,22,22)
   textColor=rgb(250,250,250)

   ink outlineColor,0
   box 0,0,bw,bh
   box 2,2,bmw/2,bmh/2,backColor,backColor,blazeColor,backColor
   box bmw/2,bmh/2,bmw-1,bmh-1,backColor,blazeColor,backColor,backColor
   box 2,bmh-1,bmw/2,bmh/2,backColor,backColor,blazeColor,backColor
   box bmw/2,bmh/2,bmw-1,2,backColor,blazeColor,backColor,backColor

   dot 1,1,0:dot bmw,1,0:dot 1,bmh,0:dot bmw,bmh,0
   dot 2,2,outlineColor:dot bmw-1,2,outlineColor
   dot 2,bmh-1,outlineColor:dot bmw-1,bmh-1,outlineColor

   center text bmw/2+1,3,t$
   ink textColor,0
   center text bmw/2,2,t$

   bi=1
   while image exist(bi)
      inc bi
   endwhile

   get image bi,1,1,bmw,bmh
   delete bitmap bm

   bs=GuiButtonStart
   while sprite exist(bs)
      inc bs
   endwhile

   sprite bs,GuiButtonX,by,bi
   set sprite alpha bs,175

   set text size ts

endfunction bs

`swap the arrows <------>
function SwapArrows()
   if runState=4
      for i=0 to boardSize-1
         for j=0 to boardSize-1
            if playField(i,j).direction=swapSource
               playField(i,j).direction=swapTarget
            else
               if playField(i,j).direction=swapTarget
                  playField(i,j).direction=swapSource
               endif
            endif
            yrotate object playField(i,j).object,90*(playField(i,j).direction+1)
         next j
      next i
      `dec playerSwaps
      runState=3
      `swapSource=4
      `swapTarget=4
   endif

endfunction

`move the player   /\/\/\/\/\/\/\/\
function MovePlayer()
   `code here
   RotatePlayer(1000)

   if playerMoves>0
      playerColumnOld=playerColumn
      playerRowOld=playerRow
      if playerColumn=-1
         pd=0
      else
         pd=playField(playerColumn,playerRow).direction
      endif
      select pd
         case 0
            inc playerColumn
         endcase
         case 1
            dec playerRow
         endcase
         case 2
            dec playerColumn
         endcase
         case 3
            inc playerRow
         endcase
         case default
         endcase
      endselect

      `position object PlayerObject,25*((boardSize/2-playerColumn)+1-boardEven),0,25*((boardSize/2-playerRow)-boardEven)
      position object playerObject,25*((boardSize/2-playerColumn)-boardEven),0,25*((boardSize/2-playerRow)-boardEven)
      if playerColumnOld<>-1
         playField(playerColumnOld,playerRowOld).filled=0
         hide object playField(playerColumnOld,playerRowOld).object
      endif
      playerMoveState=3
      sleep 250
      `playerColumn=-1
      `playerRow=startPosition
      dec playerMoves
      if playerMoves=0
         inc playerSwaps
         runState=1
      endif
   endif
endfunction

`test player condition   ????????????
function playerTest()

   `test$=""
   if playerMoveState=3
      if playerColumnOld<>-2
         if playerColumn>=0 and playerColumn<=boardSize-1 and playerRow>=0 and playerRow<=boardSize-1
            if playField(playerColumn,playerRow).filled=1
               `still in the game
            else
               `oops
               messageBoxText$(9)="In the last round you"
               messageBoxText$(10)="fell down a hole"
               messageBoxText$(11)="of your own making!"
               playerMoves=0
               playerMoveState=0
               runState=5
               playerSwaps=2
            endif
         else
            if playerColumn=boardSize and playerRow=endPosition
               `whew - you finaly made it!
               messageBoxText$(9)="In the last round you"
               messageBoxText$(10)="completed the round"
               messageBoxText$(11)="Congratulations!"
               `test$="playercolumn: "+str$(playerColumn)+" playerrow: "+str$(playerRow)
               playerMoves=0
               playerMoveState=0
               runState=5
               playerSwaps=2
            else
               `biffed
               messageBoxText$(9)="In the last round you"
               messageBoxText$(10)="did a man overboard"
               messageBoxText$(11)=""
               `test$="playercolumn: "+str$(playerColumn)+" playerrow: "+str$(playerRow)
               playerMoves=0
               playerMoveState=0
               runState=5
               playerSwaps=2
            endif
         endif

      endif
   endif

`test$=test$+" playercolumn: "+str$(playerColumn)+" playerrow: "+str$(playerRow)

endfunction

`This will eventually scroll the clouds below the playing field
function MoveClouds()

endfunction


`This will make the player object bob up and down for a neat effect
function HoverPlayer(SpeedMultiplier,Distance)
HoverSpeed=HoverSpeed+(0.00001*SpeedMultiplier)*((object position y(PlayerObject)<Distance/2)-(object position y(PlayerObject)>Distance/2))
position object PlayerObject,object position x(PlayerObject),object position y(PlayerObject)+HoverSpeed,object position z(PlayerObject)
endfunction


`This will cause the player to rotate 90 degrees in a direction
`Based on left and right arrowkeys
function RotatePlayer(SpeedMultiplier)
`Direction=Direction+((Direction=0)*(rightkey()))-((Direction=0)*(leftkey()))

if turnDirection<>0
    if StartAngle=400
        RotateSpeed=0.000000001
        StartAngle=object angle y(PlayerObject)
    endif
    ta=abs(object angle y(PlayerObject)-(StartAngle))
    RotateSpeed=RotateSpeed+((0.00001*SpeedMultiplier)*((ta<45)-(ta>45)))

    yrotate object PlayerObject,wrapvalue((RotateSpeed*Direction)+object angle Y(PlayerObject))
    if abs(object angle y(PlayerObject)-wrapvalue(StartAngle))>=90
        yrotate object PlayerObject,wrapvalue(StartAngle+(90*turnDirection))
        StartAngle=400
        RotateSpeed=0
        turnDirection=0
    endif
endif
endfunction

function SetupGround()
`code here
   make object box GridObject,900,0.01,900
   texture object GridObject,GridImage
   ghost object on GridObject,1
   position object GridObject,0,-29,0

   make object box CloudObject,1024,0.01,1024
   texture object CloudObject,CloudsImage
   position object CloudObject,0,-30,0
endfunction

`this is a little message box setup I came up with
`using a David Gervais graphic
`these global variables are now required by the message box functions
`global messageBoxMap=0
`global messageBoxSprite=0
`global messageBoxImage=0
`global messageBoxDisplay=0
`
` and these are their calls
`   Build_Message_Box()
`   Show_Message_Box(200,50,100,255)
`   Clear_Message_Box()
`
`put your messages in messageBoxText$(n) n=0 through 10

function Build_Message_Box()
   messageBoxImage=1
   while image exist(messageBoxImage)
      inc messageBoxImage
   endwhile
   load image "dialog01.png",messageBoxImage
   messageBoxSprite=1
   while image exist(messageBoxSprite)
      inc messageBoxSprite
   endwhile
   sprite messageBoxSprite,0,0,messageBoxImage
   stretch sprite messageBoxSprite,60,60
   messageBoxMap=1
   while bitmap exist(messageBoxMap)
      inc messageBoxMap
   endwhile
   create bitmap messageBoxMap,sprite width(messageBoxSprite),sprite height(messageBoxSprite)
   paste sprite messageBoxSprite,0,0
   delete image messageBoxImage
   get image messageBoxImage,0,0,bitmap width(messageBoxMap),bitmap height(messageBoxMap),1
   set sprite alpha messageBoxSprite,224
   messageBoxDisplay=1
   while image exist(messageBoxDisplay)
      inc messageBoxDisplay
   endwhile
   get image messageBoxDisplay,0,0,bitmap width(messageBoxMap),bitmap height(messageBoxMap),1
   set current bitmap 0
   dim messageBoxText$(18)
   messageBoxText$(0)="Pathways"
   messageBoxText$(18)="<<<LAST LINE>>>"
endfunction

function Show_Message_Box(mbx,mby,bs,sa)

   bmw=bitmap width(messageBoxMap)
   bmh=bitmap height(messageBoxMap)
   gm=Grayscale_area(mbx+2,mby+15,mbx+bmw-2,mby+bmh-2)
   set current bitmap messageBoxMap
   paste image messageBoxImage,0,0
   copy bitmap gm,1,1,bmw-20,bmh-25,messageBoxMap,2,15,bmw-2,bmh-2
   delete bitmap gm
   set current bitmap messageBoxMap
   ink rgb(255,255,255),0
   for i=0 to 18
      center text bmw/2,i*15,messageBoxText$(i)
   next i
   if image exist(messageBoxDisplay) then delete image messageBoxDisplay
   get image messageBoxDisplay,0,0,bitmap width(messageBoxMap),bitmap height(messageBoxMap),1
   sprite messageBoxSprite,mbx,mby,messageBoxDisplay
   stretch sprite messageBoxSprite,bs,bs
   set sprite alpha messageBoxSprite,sa
   show sprite messageBoxSprite
   set current bitmap 0
endfunction

function Clear_Message_Box()
   for i=0 to 18
      messageBoxText$(i)=""
   next i
endfunction

function Hide_Message_Box()
   if mouseclick()=2
      hide sprite messageBoxSprite
   endif
endfunction

function Grayscale_area(xs,ys,xe,ye)
   bm=1
   while bitmap exist(bm)
      inc bm
   endwhile
   xsize=xe-xs
   ysize=ye-ys
   create bitmap bm,xsize,ysize
   copy bitmap 0,xs,ys,xe,ye,bm,0,0,xsize,ysize
   lock pixels
   for x=1 to xsize
      for y=1 to ysize
         color=point(x,y)
         blue=color mod 256
         green=(color/256) mod 256
         red=((color/256)/256) mod 256
         gray=(red+green+blue)/3
         `gray=gray-64*(gray>80)
         dot x,y,rgb(gray,gray,gray)
      next y
   next x
   unlock pixels

   `copy bitmap bm,1,1,xsize,ysize,0,xs,ys,xe,ye
   `delete bitmap bm

endfunction bm

function showpick()
   if mouseclick()=1
      messageBoxText$(8)="object: "+str$(pick object(mousex(),mousey(),boardObjectStart,2+boardObjectStart+boardSize*boardSize))
   endif
endfunction