

 This page uses content from Wikipedia. The original article was at Maze generation algorithm. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)




Task

Generate and show a maze, using the simple Depth-first search algorithm.

Start at a random cell.
Mark the current cell as visited, and get a list of its neighbors. For each neighbor, starting with a randomly selected neighbor:
If that neighbor hasn't been visited, remove the wall between this cell and that neighbor, and then recurse with that neighbor as the current cell.


 Related tasks
 Maze solving.


' version 04-12-2016
' compile with: fbc -s console
' when generating a big maze it's possible to run out of stack space
' increase stack with the -t xxxx (xxxx is the amount you want in Kbytes)
 
ReDim Shared As String d() ' directions
ReDim Shared As ULong c()  ' cell's
 
Sub cell(x As ULong, y As ULong, s As ULong)
 
    Dim As ULong x1, y1, di_n
    c(x,y) = 1 ' mark as visited
 
    Do
        Dim As String di = d(x, y)
        Dim As Long l = Len(di) -1
        If l < 0 Then Exit Sub ' no directions left then exit
        di_n = di[l] ' get direction
        If l = 0 Then
            d(x,y) = ""
        Else
            d(x,y) = Left(di,l)
        End If
 
        Select Case di_n ' 0,0 is upper left corner
            Case Asc("N")
                x1 = x    : y1 = y -1
            Case Asc("E")
                x1 = x +1 : y1 = y
            Case Asc("S")
                x1 = x    : y1 = y +1
            Case Asc("W")
                x1 = x -1 : y1 = y
        End Select
 
        If c(x1,y1) <> 0 Then Continue Do
 
        Select Case di_n ' 0,0 is upper left corner
            Case Asc("N")
                Line (x * s +1 , y * s) - ((x +1) * s -1, y * s),0
            Case Asc("E")
                Line (x1 * s, y * s +1) - (x1 * s, (y +1) * s -1),0
            Case Asc("S")
                Line (x * s +1, y1 * s) - ((x +1) * s -1, y1 * s),0
            Case Asc("W")
                Line (x * s , y * s +1) - (x * s, (y +1) * s -1),0
        End Select
 
        cell(x1, y1, s)
    Loop
 
End Sub
 
Sub gen_maze(w As ULong, h As ULong, s As ULong)
 
    ReDim d(w, h)
    ReDim c(w, h)
    Dim As ULong x, y, r, i
    Dim As String di
 
    d(0, 0) = "SE"       ' cornes
    d(0, h -1) ="NE"
    d(w -1, 0) ="SW"
    d(w -1, h -1) ="NW"
 
    For x = 1 To w -2  ' sides
        d(x,0) = "EWS"
        d(x,h -1) = "NEW"
    Next
 
    For y = 1 To h -2
        d(0, y) = "NSE"
        d(w -1, y) ="NSW"
    Next
 
    For x = 0 To w -1     ' shuffle directions
        For y = 0 To h -1
            di = d(x,y)
            If di = "" Then di = "NEWS"
            i = Len(di)
            Do
                r = Fix(Rnd * i)
                i = i - 1
                Swap di[r], di[i]
            Loop Until i = 0
            d(x,y) = di
        Next
    Next
 
    ScreenRes w * s +1, h * s +1, 8
    ' draw the grid
    For x = 0 To w
        Line (x * s, 0) - (x * s, h * s), 2 ' green color
    Next
 
    For y = 0 To h
        Line(0, y * s) - (w* s, y * s),2
    Next
    ' choice the start cell
    x = Fix(Rnd * w)
    y = Fix(Rnd * h)
 
    cell(x, y, s)
 
End Sub
 
' ------=< MAIN >=------
 
Randomize Timer
 
Dim As ULong t
 
Do
    ' gen_maxe(width, height, cell size)
    gen_maze(30, 30, 20)
    WindowTitle " S to save, N for next maze, other key to stop"
    Do
    Var key = Inkey
    key = UCase(key)
    If key = "S" Then
        t = t +1
        BSave("maze" + Str(t) + ".bmp"), 0
        key = ""
    End If
    If key = "N" Then Continue Do, Do
    If key <> "" Then Exit Do, Do 
    Loop
Loop
 
End