I downloaded this code a while back when I was trying to figure out how to solve mazes it uses the Depth-First Search(DFS) algorithm, I got it from here:
http://mazes.50megs.com/
and converted it to Bmax:
you can get executable from here:
http://hosted.filefront.com/ChuyP/
http://mazes.50megs.com/
and converted it to Bmax:
SuperStrict ' Depth First Search Graphical Maze Generator */ ' ------------------------------------------------------------------------- */ ' Simple program To generate And draw a maze via the DFS algorithm */ ' Questions Or comments? Please send them To randall.patrick@... */ Const EAST:Int= 0 Const WEST:Int= 1 Const NORTH:Int= 2 Const SOUTH:Int= 3 Const MAXDIR:Int= 4 ' Maze cells are represented by the 2d Int array maze[y,x] */ ' Each cell is bitmapped as follows: */ Const EWALL:Int= 1 Const WWALL:Int= 2 Const NWALL:Int= 4 Const SWALL:Int= 8 ' ALLWALLS is Not a bitmapped Field, just the And value To */ ' determine If a cell has all walls intact */ Const ALLWALLS:Int= 1+2+4+8 Const EBORDER:Int= 16 Const WBORDER:Int= 32 Const NBORDER:Int= 64 Const SBORDER:Int= 128 Const SOLUTION:Int= 256 Const SOLEAST:Int = 1024 Const SOLWEST:Int = 2048 Const SOLNORTH:Int = 4096 Const SOLSOUTH:Int = 8192 Const ALLSOL:Int = 8192+4096+2048+1024 ' End of bitmapping defines */ Const MAX_X:Int = 640 Const MAX_Y:Int = 480 Global pixel:Int[MAX_X*MAX_Y]; ' Number of pixels each maze cell will be represented by */ Const CELLSIZE:Int= 20 ' An even value works best (i.e. 2,5,10,20,40) */ ' OFFSET is used as a graphical margin */ Const OFFSET:Int = CELLSIZE Const MAZEH:Int = (MAX_Y-2*OFFSET)/CELLSIZE Const MAZEW:Int = (MAX_X-2*OFFSET)/CELLSIZE Const TOTALCELLS:Int = MAZEW*MAZEH Global y:Int,x:Int,n:Int[MAXDIR],maze:Int[MAZEH,MAZEW],sp:Int; ' Array stack contains the y,x values stored as low/high order bytes */ ' of an unsigned Long. This limits maximum maze dimensions To 65535x65535 */ Global stack:Long[TOTALCELLS]; Function push() stack[sp] = x*65536+y; sp:+1 End Function Function pop() If(sp>0) sp:-1; y=stack[sp]&65535; x=stack[sp]/65536; End Function ' This line drawing routine is a modified version of the */ ' EFLA Variant B which can be found at */ ' <a href="http://www.edepot.com/lineb.html" target="_blank">http://www.edepot.com/lineb.html</a> */ Function draw_line(x:Int, y:Int, x2:Int, y2:Int,color:Int) SetColor (color Shr 16) & $FF, (color Shr 8) & $FF, color & $FF DrawLine x,y,x2,y2 End Function Function draw_grids(color:Int) Local y:Int,x:Int For y = OFFSET Until MAX_Y Step CELLSIZE draw_line(OFFSET,y,MAX_X-OFFSET,y,color); Next For x = OFFSET Until MAX_X Step CELLSIZE draw_line(x,OFFSET,x,MAX_Y-OFFSET,color); Next End Function Function knock_wall(direction:Int, color:Int) Select(direction) Case EAST draw_line(x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+1,.. x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+CELLSIZE,color); Case WEST draw_line(x*CELLSIZE+OFFSET,y*CELLSIZE+OFFSET+1,.. x*CELLSIZE+OFFSET,y*CELLSIZE+OFFSET+CELLSIZE,color); Case NORTH draw_line(x*CELLSIZE+OFFSET+1,y*CELLSIZE+OFFSET,.. x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET,color); Case SOUTH draw_line(x*CELLSIZE+OFFSET+1,y*CELLSIZE+OFFSET+CELLSIZE,.. x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+CELLSIZE,color); End Select End Function Function draw_solution(y:Int, x:Int, direction:Int,color:Int) Select(direction) Case EAST draw_line(x*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,.. (x+1)*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,color); Case SOUTH draw_line(x*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,.. x*CELLSIZE+OFFSET+CELLSIZE/2,(y+1)*CELLSIZE+OFFSET+CELLSIZE/2,color); Case WEST draw_line(x*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,.. (x-1)*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,color); Case NORTH draw_line(x*CELLSIZE+OFFSET+CELLSIZE/2,y*CELLSIZE+OFFSET+CELLSIZE/2,.. x*CELLSIZE+OFFSET+CELLSIZE/2,(y-1)*CELLSIZE+OFFSET+CELLSIZE/2,color); End Select End Function ' Finds all of current cells neighbors that have all walls intact */ ' And do Not fall outside of maze dimensions */ Function find_neighbors:Int() Local b:Int=0,c:Int; For c = EBORDER To SBORDER If((maze[y,x]&c)<>c) Select(c) Case EBORDER If((maze[y,x+1]&ALLWALLS) = ALLWALLS) n[b]=EAST b:+1 EndIf Case WBORDER If((maze[y,x-1]&ALLWALLS) = ALLWALLS) n[b]=WEST b:+1 EndIf Case NBORDER If((maze[y-1,x]&ALLWALLS) = ALLWALLS) n[b]=NORTH b:+1 EndIf Case SBORDER If((maze[y+1,x]&ALLWALLS) = ALLWALLS) n[b]=SOUTH b:+1 EndIf End Select EndIf c:*2 c:-1 Next Return b; End Function ' Finds all of current cells neighbors that have Not been visited */ ' by the solving loop (SOLUTION bit Not set), have an opening in the */ ' specified direction, And do Not fall outside of maze dimensions */ Function find_solve_neighbors:Int() Local b:Int=0,c:Int; For c = EBORDER To SBORDER If((maze[y,x]&c)<>c) Select(c) Case EBORDER If((maze[y,x+1]&SOLUTION)<>SOLUTION And (maze[y,x]&EWALL)<>EWALL) n[b]=EAST; b:+1 EndIf Case WBORDER If((maze[y,x-1]&SOLUTION)<>SOLUTION And (maze[y,x]&WWALL)<>WWALL) n[b]=WEST; b:+1 EndIf Case NBORDER If((maze[y-1,x]&SOLUTION)<>SOLUTION And (maze[y,x]&NWALL)<>NWALL) n[b]=NORTH; b:+1 EndIf Case SBORDER If((maze[y+1,x]&SOLUTION)<>SOLUTION And (maze[y,x]&SWALL)<>SWALL) n[b]=SOUTH; b:+1 EndIf End Select EndIf c:*2 c:-1 Next Return b; End Function Function memset(array:Int[],c:Int) For Local i:Int = 0 Until array.length array[i] = c Next End Function Function memsetl(array:Long[],c:Int) For Local i:Int = 0 Until array.length array[i] = c Next End Function Function init_maze() memsetl(stack,0) memset(n,0) sp=0; For y = 0 Until MAZEH For x = 0 Until MAZEW maze[y,x]=ALLWALLS; Select(x) Case 0 maze[y,x]:|WBORDER; Case MAZEW-1 maze[y,x]:|EBORDER; EndSelect Select(y) Case 0 maze[y,x]:|NBORDER; Case MAZEH-1 maze[y,x]:|SBORDER; End Select Next Next End Function ' Pseudo code For DFS algorithm may be viewed at: */ ' <a href="http://www.mazeworks.com/mazegen/mazetut/index.htm" target="_blank">http://www.mazeworks.com/mazegen/mazetut/index.htm</a> */ Function generate_maze(color:Int) Local found:Int,visited_cells:Int=1; Cls draw_grids(color); SeedRnd MilliSecs() y=Rand(0,MAZEH-1); x=Rand(0,MAZEW-1); While(visited_cells<TOTALCELLS) ' Sleep(value in milliseconds); - Use If drawing too fast */ found=find_neighbors() If found push(); Select(n[Rand(0,found-1)]) Case EAST knock_wall(EAST,0); maze[y,x]:~EWALL; x:+1 maze[y,x]:~WWALL; Case WEST knock_wall(WEST,0); maze[y,x]:~WWALL; x:-1 maze[y,x]:~EWALL; Case NORTH knock_wall(NORTH,0); maze[y,x]:~NWALL; y:-1 maze[y,x]:~SWALL; Case SOUTH knock_wall(SOUTH,0); maze[y,x]:~SWALL; y:+1 maze[y,x]:~NWALL; End Select visited_cells:+1 Else pop(); EndIf Wend Flip(0) End Function ' The start of the maze is 0,0 And the End is MAZEH-1,MAZEW-1 */ ' This basically re-runs the DFS algorithm from the maze starting point */ ' completing when the End of the maze is reached. All visited cells have */ ' their solution bit set To mark them as visited by the solving loop. */ ' Since the solution is being drawn during the solving loop, backtracking */ ' information doesn't need to be tracked */ Function solve_maze(color:Int) Local found:Int=0,solved:Int=0; y=x=sp=0; memsetl(stack,0); While(Not solved) ' Sleep(value in milliseconds); - Use If drawing too fast */ maze[y,x]:|SOLUTION; If(y = MAZEH-1 And x = MAZEW-1) solved=1; Else found=find_solve_neighbors() If found push(); Select(n[Rand(0,found-1)]) Case EAST maze[y,x+1]:|SOLUTION+SOLEAST; draw_solution(y,x,EAST,color); x:+1 Case WEST maze[y,x-1]:|SOLUTION+SOLWEST; draw_solution(y,x,WEST,color); x:-1 Case NORTH maze[y-1,x]:|SOLUTION+SOLNORTH; draw_solution(y,x,NORTH,color); y:-1 Case SOUTH maze[y+1,x]:|SOLUTION+SOLSOUTH; draw_solution(y,x,SOUTH,color); y:+1 End Select Else Select(maze[y,x]&ALLSOL) Case SOLEAST draw_solution(y,x,WEST,0) Case SOLWEST draw_solution(y,x,EAST,0) Case SOLNORTH draw_solution(y,x,SOUTH,0) Case SOLSOUTH draw_solution(y,x,NORTH,0) End Select pop(); EndIf EndIf If KeyDown(key_escape) End Flip() Wend End Function Graphics MAX_X,MAX_Y Repeat init_maze(); generate_maze($0000FF); solve_maze($FF8000); Delay(1000); Until KeyDown(key_escape)
you can get executable from here:
http://hosted.filefront.com/ChuyP/