TGC Codebase Backup



DBPro 2D / 3D random maze generator by DeepBlue

24th May 2004 1:39
Summary

Random maze generator, creates 3D maze and 2D map. Also allows first person movement through maze with basic collision. Updated to work with DBP 5.4



Description

Random maze generator, creates 3D maze and 2D map. Also allows first person movement through maze with basic collision.

Does not use recursive function calls & should be relatively simple to follow.

Actual maze data generation(2D) is twice as fast as best recursive funtion call algorithms I could find. Maze generation/running of larger mazes is slow as cubes are used to generate the maze & the collision slows things down. For larger mazes would strongly suggest rewriting to create planes as walls instead of using cubes cubes.

Also inclueds some very basic timing & collision that requires more work for an end product.

Hope somebody finds it useful.



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `########################################################
`# 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#