Simple Maze Generator

Community Forums/Showcase/Simple Maze Generator

Ryan Burnside

(Posted 2008) [#1]

This is a simple maze generator.

I've got it making mazes decently fast.

blitzmax language

'///////////////////////////////////////////////////////////////
' ***maze generator***
' Ryan Burnside 2008 (Pixel_Outlaw)
'///////////////////////////////////////////////////////////////

'///////////////////////////////////////////////////////////////
' algorithem overview
' seed an array with cells that have 4 walls
' (a) choose 1 cell do a random walk untill a dead end is reached (knocking down walls between this cell and the former)
' do a check for cells that border already visited cells adding them to a waiting list
' pick a new cell from the waiting list and knock down a wall to a visited cell
' go to (a)
'///////////////////////////////////////////////////////////////

Strict
Framework brl.GLMax2D
Import brl.Random
AppTitle = "Random Walk Maze by Ryan Burnside 2008 B=Binary maze, L=line maze, D=dungeon"

SeedRnd(MilliSecs()) 
Global length:Int = 30   ' maze length |<--------->|
Global height:Int = 30 ' maze height
Global cell_width:Float = 4


Type cell
Field n:Byte, e:Byte, s:Byte, w:Byte, u:Byte
EndType

Type position
	Field x:Int, y:Int
End Type

' create our array of cells
Global array:cell[length, height] 
 
'holds cells waiting to be worked with
Global waiting_list:TList = New TList

'seed the array with cells
For Local x:Int = 0 To length - 1
	For Local y:Int = 0 To height - 1
	Local c:cell = New cell
	c.n = 1
	c.s = 1
	c.e = 1
	c.w = 1
	c.u = 1
	array[x, y] = c
	Next
Next

'function to take a random walk
Function rand_walk() 
' find all possible border cells

Local list_length:Int = CountList(waiting_list) 
While list_length > 0

Local chosen:position = position(waiting_list.ValueAtIndex(Rand(0, list_length - 1))) 
 
' starting square
Local current_x:Int = chosen.x
Local current_y:Int = chosen.y
attach_former(current_x, current_y) 
While 1
	'1 find next cell from current x and y randomly if possible else exit
	'2 mark current x and y as visited
	'3 knock down wall between
	array[current_x, current_y].u = 0
	
	Local a:Int[] = select_next(current_x, current_y) 
	' end prematurly if no passage is found
	If a[0] = current_x And a[1] = current_y
		Return Null
	Else
	current_x = a[0] 
	current_y = a[1]
	End If
	
			
Wend
wend
EndFunction

'function to select the next cell to walk from
Function select_next:Int[] (current_x:Int, current_y:Int) 
' store our x and y point into a returnable array
Local return_array:Int[2] 
Local choices:String = ""

' check cell to north, is it unvisited?
If current_y - 1 >= 0
	If array[current_x, current_y - 1].u
		choices:+"n"
	EndIf
End If
' check to east
If current_x + 1 <= length - 1
	If array[current_x + 1, current_y].u
		choices:+"e"
	EndIf
End If
'check to the south
If current_y + 1 <= height - 1
	If array[current_x, current_y + 1].u
		choices:+"s"
	EndIf
End If
'check to the west
If current_x - 1 >= 0
	If array[current_x - 1, current_y].u
		choices:+"w"
	EndIf
End If


' now select a random position from the alloted choices
If choices.length > 0

Local selection:String = Chr(choices[Rand(0, choices.length - 1)] ) 
	 
	Select selection
		Case "n"
 			return_array[0] = current_x
			return_array[1] = current_y - 1
			array[current_x, current_y - 1].s = 0
			array[current_x, current_y].n = 0
			Return return_array
		Case "e"
			return_array[0] = current_x + 1
			return_array[1] = current_y
			array[current_x + 1, current_y].w = 0
			array[current_x, current_y].e = 0
			Return return_array
		Case "s"
			return_array[0] = current_x
			return_array[1] = current_y + 1
			array[current_x, current_y + 1].n = 0
			array[current_x, current_y].s = 0
			Return return_array
		Case "w"
			return_array[0] = current_x - 1
			return_array[1] = current_y
			array[current_x - 1, current_y].e = 0
			array[current_x, current_y].w = 0
			Return return_array
		
	End Select
Else
	return_array[0] = current_x
	return_array[1] = current_y
	Return return_array
EndIf

End Function

Function add_waiting_best() 
' executed before each random walk (not during) 
' scan through the entire array add all unvisited cells that have one visited neighbour to the waiting list

' clear the list
waiting_list.Clear() 

'Why is this better than add_waiting?
' 1 pick a random start position in the array
' 2 loop untill a position is found that is unvisited and has a neighbour
' 3 return one position- no list making and clearing, no extra computations 

Local x:Int = Rand(0, length - 1) 
Local y:Int = Rand(0, height - 1) 
Local max_turns:Int = length * height
Local visited:Int = 0
While 1
visited:+1
		' if this cell is unvisited (condition 1) and has a visited neighbour (condition 2)
		If array[x, y].u

			If y - 1 >= 0
				If Not array[x, y - 1].u
					Local p:position = New position
					p.x = x
					p.y = y
					ListAddLast(waiting_list, p) 
					Return Null
				EndIf
			End If

			' check to east
			If x + 1 <= length - 1
				If Not array[x + 1, y].u
					Local p:position = New position
					p.x = x
					p.y = y
					ListAddLast(waiting_list, p) 
					Return Null
				EndIf
			End If

			'check to the south
			If y + 1 <= height - 1
				If Not array[x, y + 1].u
					Local p:position = New position
					p.x = x
					p.y = y
					ListAddLast(waiting_list, p) 
					Return Null
				EndIf
			End If

			'check to the west
			If x - 1 >= 0
				If Not array[x - 1, y].u
					Local p:position = New position
					p.x = x
					p.y = y
					ListAddLast(waiting_list, p) 
					Return Null
				EndIf
			End If
		EndIf
x:+1
If x > length - 1
	x = 0
	y:+1
	If y > height - 1
		y = 0
	End If
End If

If x > length - 1
	x = 0
End If
If y > height - 1
	y = 0
End If
If visited > max_turns
Return Null
EndIf
Wend
End Function

Function attach_former(x:Int, y:Int) 
Local order:String = ""

'check to north
If y - 1 >= 0
	If Not array[x, y - 1].u
		order:+"n"
	EndIf
End If

' check to east
If x + 1 <= length - 1
	If Not array[x + 1, y].u
		order:+"e"
	EndIf
End If

'check to the south
If y + 1 <= height - 1
	If Not array[x, y + 1].u
		order:+"s"
	EndIf
End If

'check to the west
If x - 1 >= 0
	If Not array[x - 1, y].u
		order:+"w"
	EndIf
End If

' select random neighbor
If order.length > 0
order = Chr(order[Rand(0, order.length - 1)] ) 

Select order
	Case "n"
		array[x, y - 1].s = 0
		array[x, y].n = 0
		Return
	Case "e"
		array[x + 1, y].w = 0
		array[x, y].e = 0
		Return
	Case "s"
		array[x, y + 1].n = 0
		array[x, y].s = 0
		Return
	Case "w"
		array[x - 1, y].e = 0
		array[x, y].w = 0
		Return
End Select

EndIf

End Function

Function draw() 
SetClsColor(255, 255, 255) 
Cls
SetColor(0, 0, 0) 
For Local x:Int = 0 To length - 1
	For Local y:Int = 0 To height - 1
		'draw here
		Local c:cell = array[x, y] 
		Local a:Float = x * cell_width + 3
		Local b:Float = y * cell_width + 3

			If c.n
		 		DrawLine(a, b, a + cell_width, b) 
		 	End If
			If c.e
		 		DrawLine(a + cell_width, b, a + cell_width, b + cell_width) 
		 	End If
		 	If c.s
		 		DrawLine(a, b + cell_width, a + cell_width, b + cell_width) 
			End If
		 	If c.w
		 		DrawLine(a, b, a, b + cell_width) 
		 	End If
	Next
Next
EndFunction

' dungeon generating functions
Function remove_dead_ends() 

' remove percent dead ends
For Local i = 0 To Floor((length / 2.0) + (height / 2.0)) 
	Local removal_list:TList = New TList
	For Local x:Int = 0 To length - 1
		For Local y:Int = 0 To height - 1
		Local walls:Int = 0
			'start counting cells remove if 3 or more and not start or end
				'If (x <> start_x And y <> start_y) Or(x <> end_x And y <> end_y) 
					If array[x, y].n
						walls:+1
					End If
					If array[x, y].e
						walls:+1
					End If
					If array[x, y].s
						walls:+1
					End If
					If array[x, y].w
						walls:+1
					End If
					' find the side without the wall
					If walls = 3
						Local P:position = New position
						p.x = x
						p.y = y
						ListAddLast(removal_list, p) 
					End If
				'EndIf
		Next
	Next
	For Local p:position = EachIn(removal_list) 
	Local empty:String = ""
	Local x:Int = p.x
	Local y:Int = p.y
		If Not array[x, y].n
						empty = "n"
						End If
		If Not array[x, y].e
						empty = "e"
						End If
		If Not array[x, y].s
						empty = "s"
						End If
		If Not array[x, y].w
						empty = "w"
						End If
		' put a wall up making a new culdesac
						
		Select empty
							Case "n"
							array[x, y - 1].s = 1
							Case "e"
							array[x + 1, y].w = 1
							Case "s"
							array[x, y + 1].n = 1
							Case "w"
							array[x - 1, y].e = 1
						End Select
						
		array[x, y].n = 0
		array[x, y].e = 0
		array[x, y].s = 0
		array[x, y].w = 0
	Next
Next
End Function

Function convert_to_blocks:Byte[,] () 
'make a block maze from the cell maze
'cells are either open or closed (booliean)
Local new_length = (2 * length) + 1
Local new_height = (2 * height) + 1
Local return_array:Byte[new_length, new_height] 
' fill the array with walls
For Local x = 0 To new_length - 1
	For Local y = 0 To new_height - 1
		return_array[x, y] = 1
	Next
Next
'now fill the new array
For Local x = 0 To length - 1
	For Local y = 0 To height - 1
		' this is the location in the new and bigger array
		Local location_x:Int = x * 2 + 1
		Local location_y:Int = y * 2 + 1
		Local sides:Byte = 0
		'check cells in the old small array
		return_array[location_x, location_y] = 0
		If array[x, y].n
			return_array[location_x, location_y - 1] = 1
			Else
			return_array[location_x, location_y - 1] = 0
		End If
		
		If array[x, y].e
			return_array[location_x + 1, location_y] = 1
			Else
			return_array[location_x + 1, location_y] = 0
		End If
		
		If array[x, y].s
			return_array[location_x, location_y + 1] = 1
			Else
			return_array[location_x, location_y + 1] = 0
		End If
		
		If array[x, y].w
			return_array[location_x - 1, location_y] = 1
			Else
			return_array[location_x - 1, location_y] = 0
		End If
		

	Next
Next
Return return_array
End Function

Function draw_blocks(a:Byte[,] ) 
	For Local x = 0 To length * 2
		For Local y = 0 To height * 2
			If a[x, y] = 0
				SetColor(200, 200, 200) 
				DrawRect(x * cell_width, y * cell_width, cell_width, cell_width) 
				Else
				SetColor(128, 128, 128) 
				DrawRect(x * cell_width, y * cell_width, cell_width, cell_width)  
			EndIf
			
		Next
	Next
End Function

Function remove_wall_ends:Byte[,] (a:Byte[,] , n:Int) 
	'finds a wall tip and removes it x many times
	' if the position is a wall tip ( has only 1 wall neighbor)
	' create a potsition save to a list
	' remove the positions after each iteration	
	Local positions:TList = New TList
	For Local c:Int = 0 To n - 1
		For Local x:Int = 1 To a.dimensions()[0] - 2
			For Local y = 1 To a.dimensions()[1] - 2
				If a[x, y] = 1
				Local count = 0
					If a[x, y - 1] = 0
					count:+1
					EndIf
					If a[x + 1, y] = 0
					count:+1
					EndIf
					If a[x, y + 1] = 0
					count:+1
					EndIf
					If a[x - 1, y] = 0
					count:+1
					EndIf
					If count = 3
						Local p:position = New position
						p.x = x
						p.y = y
						ListAddLast(positions, p) 
					End If
				End If
			Next
		Next
		' remove all walls from positions list
		For Local p:position = EachIn(positions) 
			a[p.x, p.y] = 0
		Next
	Next
	Return a
End Function

Function remove_ends:Byte[,] (a:Byte[,] , n:Int) 
	'finds a wall tip and removes it x many times
	' if the position is a wall tip ( has only 1 wall neighbor)
	' create a potsition save to a list
	' remove the positions after each iteration	
	Local positions:TList = New TList
	For Local c:Int = 0 To n - 1
		For Local x:Int = 1 To a.dimensions()[0] - 2
			For Local y = 1 To a.dimensions()[1] - 2
				If a[x, y] = 0
				Local count = 0
					If a[x, y - 1] = 1
					count:+1
					EndIf
					If a[x + 1, y] = 1
					count:+1
					EndIf
					If a[x, y + 1] = 1
					count:+1
					EndIf
					If a[x - 1, y] = 1
					count:+1
					EndIf
					If count = 3
						Local p:position = New position
						p.x = x
						p.y = y
						ListAddLast(positions, p) 
					End If
				End If
			Next
		Next
		' remove all walls from positions list
		For Local p:position = EachIn(positions) 
			a[p.x, p.y] = 1
		Next
	Next
	Return a
End Function


array[length / 2, height / 2].u = 0
add_waiting_best() 
 
Local C:Float = MilliSecs() ' start a timer for creation 

While CountList(waiting_list) > 0
add_waiting_best() 
rand_walk() 
Wend

Notify("Genarated in: " + String((MilliSecs() - c) / 1000) + " seconds.") 

Graphics 1024, 800
SetClsColor(255, 255, 255) 
Cls() 
Flip

' make a binary tile maze vesion of the orginal
Global g:Byte[,] = convert_to_blocks() 

' make a binary tile dungeon of the initial
Global d:Byte[,] = convert_to_blocks() 
d = remove_ends(d, 4) 
d = remove_wall_ends(d, 4) 
d = remove_ends(d, 20) 
d = remove_wall_ends(d, 8) 
d = remove_ends(d, 20)  
' kill off the list and free memory
DrawText("B=Binary Version", 0, 0) 
DrawText("D=Dungeon", 0, 24) 
DrawText("L=Line Version", 0, 12) 
Flip
While Not KeyDown(KEY_ESCAPE) 
	'draw binary collision maze if b is pressed
	If KeyHit(KEY_B) 
		Cls
		SetColor(0, 0, 0) 
		DrawText("This is a binary maze version. Usefull For tile based collisions. No cell objects just a binary array of 0 and 1.", 0, cell_width * (height + 2) * 2) 
		draw_blocks(g) 
		Flip
	End If
	
	'draw binary dungeon if d is pressed
	If KeyHit(KEY_D) 
		Cls
		SetColor(0, 0, 0) 
		DrawText("This is a binary Dungeon. Usefull For tile based collisions. No cell objects just a binary array of 0 and 1.", 0, cell_width * (height + 2) * 2) 
		draw_blocks(d) 
		Flip
	End If
	
	' draw line maze if l is pressed
	If KeyHit(KEY_L) 
		Cls
		SetColor(0, 0, 0) 
		DrawText("This is a line maze version. Good for paper and pencil fun. Overly complex cell objects and large memory size.", 0, cell_width * (height + 2) * 2) 
		draw
		Flip
	End If

	
WEnd


' as of 4-13-08 a 120x120 grid takes around 16-19 seconds to construct (add_waiting method)
' as of 4-13-08 a 120x120 grid takes around .30-.50 seconds to draw (native blitz drawing commands)

' as of 4-13-08 9:00 pm a 120x120 grid takes about 1-2 seconds to construst with new(add_waiting_best method)
' as of 4-16-08 10:00 pm a 120x120 grid takes about 1-4 seconds to construct with improved and random add_waiting best method

' as of 4-22-08 1:pm a 120 x120 grid takes about .2 to .5 seconds to construct with improved random search

.exe for those without blitzmax

http://myfreefilehosting.com/f/d604cf3874_0.1MB

PGF	(Posted 2008) [#2]

Nice result.

Doggie

(Posted 2008) [#3]

That's amazing

Yahfree

(Posted 2008) [#4]

holy crap, try solving that

Retimer

(Posted 2008) [#5]

Man that is fast.

Thank you for sharing.

LineOf7s

(Posted 2008) [#6]

Okay, I'm being picky here - it's very nice and all - but shouldn't a maze have some sorta entry and exit?

Plop someone in the middle of that and just sit and watch them go criminally insane. :o)

Rob Farley

(Posted 2008) [#7]

Can I countinue the picky theme and suggest most mazes have some kind of symertry about them also.

Not sure they usually have an exit, Mazes generally have an entrance and you're supposed to get to the middle and back out again.

I appreciate this is a 'simple maze generator' so really these are suggested improvements!

Digital Anime

(Posted 2008) [#8]

Okay, I'm being picky here - it's very nice and all - but shouldn't a maze have some sorta entry and exit?

Better not, else people might try to solve the maze using a waterproof marker....
;-)

But it's a nice small generator...

Ryan Burnside

(Posted 2008) [#9]

Glad to see some interest. ;)

If you want an exit, just knock down two outside wall segments in a simple paint program. Since this maze is perfect you can start in any location and get to any other. This is why you can cut an exit and beginning at any location.

Ryan Burnside

(Posted 2008) [#10]

Now that you have a simple maze generator you could make levels for dungeon crawlers. I'll be working on a level generating engine soon.

Here is a page to do so:
http://www.aarg.net/~minam/dungeon.cgi

impixi

(Posted 2008) [#11]

I don't want to hijack your thread, but you might be able to use / get some ideas from this entry in the code archives: TDungeon

Ryan Burnside

(Posted 2008) [#12]

I had a look at that some time ago. The "dungeons" have odd walls for use in my project, but I do appreciate your code.

rebootbug

(Posted 2008) [#13]

Thank you for this Ryan, very useful indeed

Thanks
Brendan

plash

(Posted 2008) [#14]

Nice.
I would be interested in a solver.

xlsior

(Posted 2008) [#15]

This is my favorite maze generator: http://homepages.cwi.nl/~tromp/maze.html

char*M,A,Z,E=40,J[40],T[40];main(C){for(*J=A=scanf(M="%d",&C);
--            E;             J[              E]             =T
[E   ]=  E)   printf("._");  for(;(A-=Z=!Z)  ||  (printf("\n|"
)    ,   A    =              39              ,C             --
)    ;   Z    ||    printf   (M   ))M[Z]=Z[A-(E   =A[J-Z])&&!C
&    A   ==             T[                                  A]
|6<<27<rand()||!C&!Z?J[T[E]=T[A]]=E,J[T[A]=A-Z]=A,"_.":" |"];}

Obfuscated C... It generates mazes, it is a maze, it spells 'maze', and it uses m,a,z, and e for variables.

Defoc8

(Posted 2008) [#16]

now all you need to do is add rooms..then you will hvae
a neato dungeon generator - handy if you feel like making
some kinda endless dungeon crawler..very cool ;)

taumel

(Posted 2008) [#17]

Nice, now if you could add some room like structures it would be great!

I haven't found time to continue a lot on this one ( http://www.blitzbasic.com/Community/posts.php?topic=77524 ).

Just made a test with a 24x24 maze and even that is so hard to get through without a map. Try to get from the yellow to the red coloured area.

Steering:
wasd/lmb&rmb: movement
mouse: viewing direction
m: map
t: string of the minotaurus

-> http://spielwiese.marune.de/_uni/testarea/maze/maze.html

Jesse

(Posted 2008) [#18]

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:

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/

Ryan Burnside

(Posted 2008) [#19]

Updated a bit.

It now makes binary mazes and dungeons for games. You can ofcourse edit the binary dungeon genertion code. See the first post. I *DO* plan to clean up my code and commentary. Just a small update.

impixi

(Posted 2008) [#20]

Impressive dungeon.

Retimer

(Posted 2008) [#21]

Updated a bit.

Damnit, and I spent some time setting it up to generate mazes for a tilemap when it seems you just did the same.

Nice @ the dungeon generation. You are unknowingly working for me and saving me time =P

Thanks for the update.

Edit:

Could you maybe add some more constants for things such as min/max hall width, room min/max size, density, etc?

Another thought came to me about multiple level dungeons/mazes. I'm not entirely sure how it would generate, but to have up/down values for going up or down from a floor into another dungeon maze in random locations in the maze. The only difference with this would be having different start/finish values (instead of the corners)

If you're short for time or anything I could put forth some effort into making these edits and posting. But I don't want to go ahead and start updating your work if you are going to anyways hehe.

Time

Ryan Burnside

(Posted 2008) [#22]

The binary maze is really easy to work with. If you clear out whole square sections of space then take off all of the dead ends you get an even better result. This dungeon is still pretty uguly. I'm working on a better algorithm. Perhaps I'll make a module for adding random dungeon data arrays to your games.

taumel

(Posted 2008) [#23]

Cool, although it doesn't look really right yet as it's missing those real rooms. I guess the mix of a) simple corridors, b) more natural random like areas like they are now in maze3 and c) precise rooms would do it. You should also be able to define the colours easily and it would be heloful if you also could exclude certain areas from beeing used for the maze.

impixi

(Posted 2008) [#24]

I think it would be best to have multiple dungeon styles, some �realistic�, some odd / unusual, some a combination. There probably is no one-dungeon-style-fits-all-games algorithm. Anyway, good job so far...