random maze generator + depth first exit finder.

Monkey Forums/Monkey Code/random maze generator + depth first exit finder.
Jesse
(Posted 2014) [#1]
I was looking at Gray Alien's maze generator and decide to modify my old blitzmax maze generator to work with Monkey:
'           Depth First Search Graphical Maze Generator 		
' -------------------------------------------------------------------------
' Simple program To generate And draw a maze via the DFS algorithm 

	


Strict

Import mojo

Global MAX_X:Int
Global MAX_Y:Int

' Number of pixels each maze cell will be represented by

Const CELLSIZE:Int= 32 ' An even value works best (i.e. 2,5,10,20,40)

	'solver direction
	
	Const EAST:Int=    0
	Const WEST:Int=    1
	Const NORTH:Int=   2
	Const SOUTH:Int=   3
	Const MAXDIR:Int=  4


' OFFSET is used as a graphical margin 
Global pixel:Int[MAX_X*MAX_Y]


Global OFFSET:Int
Global MAZEH:Int
Global MAZEW:Int
Global TOTALCELLS:Int


                                         

Function Main:Int()
	New Game
	Return True
End Function


Class Game Extends App
	Field MAX_X:Int
	Field MAX_Y:Int

	Field m:TMaze
	Field firstRun:Int		

	Method OnCreate:Int()
	
		MAX_X = DeviceWidth()
		MAX_Y = DeviceHeight()
		OFFSET = CELLSIZE
		MAZEH = (MAX_Y-2*OFFSET)/CELLSIZE
		MAZEW = (MAX_X-2*OFFSET)/CELLSIZE
		TOTALCELLS = MAZEW*MAZEH
		m = New TMaze
		firstRun = True
		SetUpdateRate 60
		Return True
	End Method
	
	Method OnUpdate:Int()
	If m.solved = True Or firstRun = True
		If KeyDown(KEY_SPACE) Or firstRun = True
			m.init_maze()
		
			m.generate($0000FF)
			firstRun = False
		Endif
	Else
		m.solve_maze($00ff00)
	Endif
	Return True
	End Method
	
	Method OnRender:Int()
		Cls()
		
		
		m.Render()
		m.DrawSolution()
		If m.solved= True
			SetColor 255,255,255
			DrawText "Press <SPACE BAR> To Generate Random maze",200,200
		Endif
		Return True
	End Method
	
End Class


Class SolutionStep
	Field x:Float
	Field y:Float
	Field direction:Float
	Field color:Int
	
	Method Render:void()
	
		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 Method
	
	
End Class

Class TMaze
	Field maze:Int[][]
	Field color:Int
	Field solved:Int
	Field solutionList:List<SolutionStep> = New List<SolutionStep>
	Field y:Int,x:Int,n:Int[MAXDIR],sp:Int

	Field stack:Int[]         

	
	' 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	

	Global MAX_X:Int
	Global MAX_Y:Int
	
	Global pixel:Int[MAX_X*MAX_Y]
	
	' Number of pixels each maze cell will be represented by
	
	
	' OFFSET is used as a graphical margin
	
	Global MAZEH:Int = (MAX_Y-2*OFFSET)/CELLSIZE
	Global MAZEW:Int = (MAX_X-2*OFFSET)/CELLSIZE
	Global TOTALCELLS:Int = MAZEW*MAZEH

	Method New()
		MAX_X = 640
		MAX_Y = 480
		MAZEH = (MAX_Y-2*OFFSET)/CELLSIZE
		MAZEW = (MAX_X-2*OFFSET)/CELLSIZE
		TOTALCELLS = MAZEW*MAZEH
		stack = New Int[TOTALCELLS*4]
	
	End Method


	Method init_maze:void()
		'SeedRnd MilliSecs()
		memset(stack,0)
		memset(n,0)
		sp =0
		x = 0
		y = 0
		maze = New Int[MAZEH][]
		For Local i:Int = 0 Until MAZEH
			maze[i] = New Int[MAZEW]
		Next
		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
				End Select
					
				Select(y)
					Case 0 maze[y][x]|=NBORDER
					Case MAZEH-1 maze[y][x]|=SBORDER      
				End Select
			Next
		Next
		solved = False
		solutionList.Clear()
	End Method

' Finds all of current cells neighbors that have all walls intact
' And do Not fall outside of maze dimensions

	Method 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 Method

	' 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            	   
	
	Method 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 Method

	' Pseudo code For DFS algorithm may be viewed at:
	' http/=/www.mazeworks.com/mazegen/mazetut/index.htm
	
	Method generate:Void(color:Int)
		x = 0
		y = 0
		
		Local found:Int,visited_cells:Int = 1
		
		While(visited_cells<TOTALCELLS)
		
			found=find_neighbors()
			If found           
				push()
				Select(n[Int(Rnd(0,found))])
				
					Case EAST 
						maze[y][x]~=EWALL
						x+=1
						maze[y][x]~=WWALL
					Case WEST
						maze[y][x]~=WWALL
						x-=1
						maze[y][x]~=EWALL
					Case NORTH
						maze[y][x]~=NWALL
						y-=1
						maze[y][x]~=SWALL
					Case SOUTH
						maze[y][x]~=SWALL
						y+=1
						maze[y][x]~=NWALL
				End Select
				visited_cells+=1
			Else
				pop()
			EndIf
		Wend
		y=0'Rand(0,MAZEH-1)
		x=0'Rand(0,MAZEW-1)
		Self.color = color
	End Method 

	' 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
	
	Method solve_maze:Void(color:Int)
		
		Local found:Int=0
		
		
		maze[y][x]|=SOLUTION
		If(y = MAZEH-1 And x = MAZEW-1)
			solved=1
		Else
			found=find_solve_neighbors()
			If found
			
				push()
				Select(n[Int(Rnd(0,found))])
				
					Case EAST maze[y][x+1]|=SOLUTION+SOLEAST
						SaveSolution(y,x,EAST,color)
						x+=1
					
					Case WEST maze[y][x-1]|=SOLUTION+SOLWEST
						SaveSolution(y,x,WEST,color)
						x-=1
					
					Case NORTH maze[y-1][x]|=SOLUTION+SOLNORTH
						SaveSolution(y,x,NORTH,color)
						y-=1
					
					Case SOUTH maze[y+1][x]|=SOLUTION+SOLSOUTH
						SaveSolution(y,x,SOUTH,color)
						y+=1
				
				End Select
			
			Else
			
				If (maze[y][x]&ALLSOL) solutionList.RemoveLast()
				pop()
			EndIf
		EndIf
	End Method

	Method Render:Void()
		For Local y:Int = 0 Until MAZEH
			For Local x:Int = 0 Until MAZEW
				If maze[y][x]&EWALL draw_line(x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+1,x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+CELLSIZE,color)
				If maze[y][x]&WWALL draw_line(x*CELLSIZE+OFFSET,y*CELLSIZE+OFFSET+1,x*CELLSIZE+OFFSET,y*CELLSIZE+OFFSET+CELLSIZE,color)
				If maze[y][x]&NWALL draw_line(x*CELLSIZE+OFFSET+1,y*CELLSIZE+OFFSET,x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET,color)
				If maze[y][x]&SWALL draw_line(x*CELLSIZE+OFFSET+1,y*CELLSIZE+OFFSET+CELLSIZE,x*CELLSIZE+OFFSET+CELLSIZE,y*CELLSIZE+OFFSET+CELLSIZE,color)
			Next
		Next
	End Method

	Method SaveSolution:Void(y:Int, x:Int, direction:Int,color:Int)
		Local solution:SolutionStep = New SolutionStep
		solution.x = x
		solution.y = y
		solution.direction = direction
		solution.color = color
		solutionList.AddLast(solution)
	End Method
	
	Method DrawSolution:Void()
		For Local s:SolutionStep = EachIn solutionList
			s.Render()
		Next
	End Method

	Method push:Void()
		stack[sp] = x
		sp += 1
		stack[sp] = y
		sp += 1
	End Method
	
	Method pop:Void()
		sp-=1
		y=stack[sp]
		sp -=1
		x=stack[sp]
	End Method
	
End Class

Global mase:TMaze = New TMaze

Function draw_line:Void(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 memset:Void(arr:Int[],c:Int)
	For Local i:Int = 0 Until arr.Length
		arr[i] = c
	Next
End Function
it illustrates what the "Depth First" algorithm goes trough to find the exit.