DBPro 2D / 3D random maze generator by DeepBlue24th 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. 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# |