Sorry your browser is not supported!

`########################################################
`# DBPro 2D/3D random maze generator by DeepBlue        #
`# Also includes some basic sliding collision/timing    #
`# but requires more work. Main purpose of program is   #
`# to demonstrate a fast understandable maze algorithm. #
`########################################################

`Reset random number generator
randomize timer()

`Setup screen/camera etc
if check display mode(800,600,32)=1:set display mode 800,600,32:else
if check display mode(800,600,16)=1:set display mode 800,600,16:endif:endif
sync on:sync rate 0:backdrop on:color backdrop rgb(53,171,250)
set camera range 0.01,3000
set text font "Arial":set text size 14

scrWidth=screen width()
scrHeight=screen Height()

#constant false=0
#constant true=1
#constant wall=0
#constant pathway=1
#constant player1=10

`Use following to set maze & map size
`Recommend max of 25 as 3D maze cubes very slow to generate & collision slow
global mazeWidth=20
global mazeHeight=20
global mapScale=4

`Make sure maze dimensions are odd
if mod(mazeWidth,2)=0 then inc mazeWidth
if mod(mazeHeight,2)=0 then inc mazeHeight

global mapSizeX
global mapSizeY

mapSizeX=mazeWidth*mapScale
mapSizeY=mazeHeight*mapScale

mapPosX=(scrWidth-(mapSizeX))-8
mapPosY=8

`Create main mazeArray & temp arrays
dim mazeArray(mazeWidth-1,mazeHeight-1)

type bLoc
X as integer
Y as integer
endtype

dim mVect() as bLoc
dim mPathStart() as bloc

`Set starting position for paths
currentLocX=1:currentLocY=1

mazeComplete=false

`Call the main subroutine to make the maze
gosub makeMaze

gosub drawMap
text (scrWidth/2)-(scrWidth/10),scrHeight/2,"Please Wait... Building 3D Maze"
sync

mazeComplete=true

`Create Floor
make object plain 2,mazeWidth*10,mazeHeight*10
xrotate object 2,270
position object 2,(mazeWidth*10)/2,0,(mazeHeight*10)/2
color object 2,rgb(63,128,0)

`Create Walls
mWallLimb=0
for mBlockZ=0 to mazeHeight-1
 for currentLocX=0 to mazeWidth-1
  if mazeArray(currentLocX,mBlockZ)=wall
   if mWallLimb=0
    make object box 1,10,10,10
`    color object 1,rgb(115,79,9)
    make mesh from object 1,1
    position object 1,5,5,5
    inc mWallLimb
   else
    add limb 1,mWallLimb,1
    offset limb 1,mWallLimb,currentLocX*10,0,mBlockZ*10
`    color object 1,rgb(115,79,9)
    inc mWallLimb
   endif
  endif
 next currentLocX
next mBlockZ
color object 1,rgb(115,79,9)
set object emissive 1,rgb(32,16,8)
set object collision to polygons 1

`Make fake player object to test for collisions
playerX#=15:playerY#=5:playerZ#=15
pSpeed#=0.75
pRSpeed#=10
make object sphere 10,2
position object 10,playerX#,playerY#,playerZ#
hide object 10
set object collision to spheres 10

`Set update timers
playerInterval=20
baseTimer=Timer()
playerTimer=baseTimer

`## Main Loop ##
do
 baseTimer=Timer()

 text 8,8,"Use Arrow Keys to Move, Esc to Exit"
 text 8,24,"FPS " + str$( screen fps() )

 gosub drawMap

 if playerTimer < baseTimer Then Gosub playerRoutine

 sync
loop
`## End of Main Loop ##

makeMaze:

 `Set path count to 0
 mPCount=0
 `Empty the path start array
 empty array mPathStart()
 repeat
  repeat
   `Set current block to a path
   mazeArray(currentLocX,currentLocY)=pathway
   gosub drawMap
   sync
   `Check & store possible path directions in mVect()
   mVCount=0
   empty array mVect()
   if currentLocY>2
    if mazeArray(currentLocX,currentLocY-2)=wall
     array insert at bottom mVect():mVect().X=0:mVect().Y=-1:inc mVCount
    endif
   endif
   if currentLocX<mazeWidth-2
    if mazeArray(currentLocX+2,currentLocY)=wall
     array insert at bottom mVect():mVect().X=1:mVect().Y=0:inc mVCount
    endif
   endif
   if currentLocY<mazeHeight-2
    if mazeArray(currentLocX,currentLocY+2)=wall
     array insert at bottom mVect():mVect().X=0:mVect().Y=1:inc mVCount
    endif
   endif
   if currentLocX>2
    if mazeArray(currentLocX-2,currentLocY)=wall
     array insert at bottom mVect():mVect().X=-1:mVect().Y=0:inc mVCount
    endif
   endif
   if mVCount=0
    `If no possible path directions find and remove start position from mPathStart()
    if mPCount>0
     for mPSearch=mPCount-1 to 0 step -1
      if mPathStart(mPSearch).X=currentLocX AND mPathStart(mPSearch).Y=currentLocY
       array delete element mPathStart(),mPSearch
      endif
     next mPSearch
     dec mPCount
    endif
   else
    `If possible path directions, randomly pick one & set array to path
    mVopt=rnd(mVCount-1)
    mazeArray(currentLocX+mVect(mVopt).X,currentLocY+mVect(mVopt).Y)=pathway
    gosub drawMap
    sync
    `Move to new location
    currentLocX=currentLocX+(mVect(mVopt).X*2):currentLocY=currentLocY+(mVect(mVopt).Y*2)
    `Add valid path start position to mPathStart() array
    array insert at bottom mPathStart():mPathStart().X=currentLocX:mPathStart().Y=currentLocY
    inc mPCount
   endif

   `Repeat building path until we can't move
   until mVCount=0
  `Randomly find new path start position from current paths
  if mPCount>0
  mPNew=rnd(mPCount-1)
  currentLocX=mPathStart(mPNew).X:currentLocY=mPathStart(mPNew).Y
  endif
  `Use following line instead of above for a harder maze/less paths
  `(backtracks along paths until a new start position is found)
  `currentLocX=mPathStart(mPCount-1).X:currentLocY=mPathStart(mPCount-1).Y

  `Repeat until no more possible paths
 until mPCount=0
return

playerRoutine:
  playerTimer=baseTimer+(1000/playerInterval)

   If Upkey()=true
      playerXnew# = Newxvalue(playerX#,camAngleY#,pSpeed#)
      playerZnew# = Newzvalue(playerZ#,camAngleY#,pSpeed#)
      gosub SlidingCollision
   else
      If Downkey()=true
         playerXnew# = Newxvalue(playerX#,Wrapvalue(camAngleY#-180),pSpeed#)
         playerZnew# = Newzvalue(playerZ#,Wrapvalue(camAngleY#-180),pSpeed#)
         gosub SlidingCollision
      Endif
   Endif

   If Leftkey()=true
      camAngleY# = WrapValue(camAngleY#-pRSpeed#)
   else
      If Rightkey()=true
        camAngleY# = WrapValue(camAngleY#+pRSpeed#)
      Endif
   Endif
   `Rotate & position camera
   YRotate camera camAngleY#
   Position Camera playerX#,playerY#,playerZ#

  `Update player position on map
  playerMapLocX=int(playerX#/10)
  playerMapLocY=int(playerZ#/10)

Return

SlidingCollision:
   position object 10,playerXnew#,playerY#,playerZ#
   if object collision(10,1) = 0 then playerX# = playerXnew#
   position object 10,playerX#,playerY#,playerZnew#
   if object collision(10,1) = 0 then playerZ# = playerZnew#
   position object 10,playerX#,playerY#,playerZ#
return

drawMap:
 `Draw directly to screen
 set current bitmap 0

 for mapY=0 to mazeHeight-1
  for mapX=0 to mazeWidth-1
   mapVal=mazeArray(mapX,mapY)
   `Reverse Y value so 0,0 in world is at bottom/left of map
   mapYinv=(mazeHeight-1)-mapY
   select mapVal
    case pathway
     ink rgb(0,0,0),rgb(0,0,0)
     box mapPosX+(mapX*mapScale),mapPosY+(mapYinv*mapScale),mapPosX+((mapX*mapScale)+mapScale),mapPosY+((mapYinv*mapScale)+mapScale)
    endcase
    case wall
     ink rgb(128,128,128),rgb(0,0,0)
     box mapPosX+(mapX*mapScale),mapPosY+(mapYinv*mapScale),mapPosX+((mapX*mapScale)+mapScale),mapPosY+((mapYinv*mapScale)+mapScale)
    endcase
   endselect
  next mapX
 next mapY
 `If maze complete draw player on map
 if mazeComplete=true
  mapX=playerMapLocX
  mapYinv=(mazeHeight-1)-playerMapLocY
  ink rgb(0,255,0),rgb(0,0,0)
  box mapPosX+(mapX*mapScale),mapPosY+(mapYinv*mapScale),mapPosX+((mapX*mapScale)+mapScale),mapPosY+((mapYinv*mapScale)+mapScale)
 endif
 `Reset default ink color
 ink rgb(255,255,255),rgb(0,0,0)
return

function mod(val1#,val2#)
 retVal#=(val1#/val2#)-(int(val1#/val2#))
endfunction retVal#