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