Here's an old one of mine fully commented that I got from a SmallBASIC program years ago:
Code: (Select All)
Option _Explicit
_Title "Maze Generator" 'B+
' 2019-09-02 isolated and updated generator code for OPTION _EXPLICIT
' from trans 2018-06-15 for Amazing Rat.bas (QB64)
' From SmallBASIC code written by Chris WS developer
' Backtracking maze generator by chrisws 2016-06-30 now found at
' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
'
' Chris notes:
' https://en.wikipedia.org/wiki/Maze_generation_algorithm
' - Starting from a random cell,
' - Selects a random neighbouring cell that has not been visited.
' - Remove the wall between the two cells and marks the new cell as visited,
' and adds it to the stack to facilitate backtracking.
' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
' When at a dead-end it backtracks through the path until it reaches a cell with an
' unvisited neighbour, continuing the path generation by visiting this new,
' unvisited cell (creating a new junction).
' This process continues until every cell has been visited, backtracking all the
' way back to the beginning cell. We can be sure every cell is visited.
'
'B+ notes for using:
' The most important item is that the maze uses 2 arrays one for vertical walls the other for horizontal
' CONST xmax, ymax is pixel size used in maze coder, using SW, SH for screen dimensions
' Maze should mount in top left corner of screen with min border space around it at left and top at least.
' CONST W, H - number of cells Wide and High you can specify.
' CONST wallThk - adjusts thickness of walls
' CONST mazeClr - colors walls made with BF in LINE statement
' CONST border - will create a space around the maze
' SHARED cellW, cellH - are pixels sizes for cell, see calcs before SCREEN command
' SHARED h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER - these are your Maze, 0 no wall, 1 = wall
' When player occupies cell x, y that cell may v_wall that blocks player going left;
' a cell v_wall(x+1, y) = 1 will block a player going right;
' cell (x, y) may have an h_wall that stops player from going up;
' cell (x, y+1) may have h_wall that stops player at x, y from going down.
' Cells at (W, y) should not be occupied with W cells wide and array base 0 only W-1 can be occupied
' unless game needs something special.
' Likewise cells at (x, H) should only provide wall to stop player from going out of box.
Const xmax = 800, ymax = 600, SW = 1200, SH = 700 'maze pixels from 0,0 and screen SH, SW
Const W = 40, H = 30, border = 25, wallThk = 5 'maze cells wide and high
Const mazeClr = &HFFFF8800
Type cell
x As Integer
y As Integer
End Type
Dim Shared cellW As Single, cellH As Single, h_walls(W, H) As Integer, v_walls(W, H) As Integer
cellW = (xmax - 2 * border - wallThk) / W
cellH = (ymax - 2 * border - wallThk) / H
Randomize Timer
Screen _NewImage(SW, SH, 32)
_ScreenMove 100, 20
Line (0, 0)-(xmax, ymax), &HFFFFFF00, B
init_walls
generate_maze
show_maze
Sleep
Sub init_walls ()
Dim x As Integer, y As Integer
For x = 0 To W
For y = 0 To H
v_walls(x, y) = 1
h_walls(x, y) = 1
Next
Next
End Sub
Sub show_maze ()
Dim py As Single, px As Single, y As Integer, x As Integer
py = border
For y = 0 To H
px = border
For x = 0 To W
If x < W And h_walls(x, y) = 1 Then
Line (px, py)-Step(cellW + wallThk, wallThk), mazeClr, BF
End If
If y < H And v_walls(x, y) = 1 Then
Line (px, py)-Step(wallThk, cellH + wallThk), mazeClr, BF
End If
px = px + cellW
Next
py = py + cellH
Next
End Sub
Sub rand_cell (rWx, rHy)
rWx = Int(Rnd * 1000) Mod W
rHy = Int(Rnd * 1000) Mod H
End Sub
Sub get_unvisited (visited() As Integer, current As cell, unvisited() As cell, uvi As Integer)
ReDim unvisited(0) As cell
Dim x As Integer, y As Integer
x = current.x
y = current.y
uvi = 0
If x > 0 Then
If visited(x - 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x - 1
unvisited(uvi).y = y
End If
End If
If x < W - 1 Then
If visited(x + 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x + 1
unvisited(uvi).y = y
End If
End If
If y > 0 Then
If visited(x, y - 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y - 1
End If
End If
If y < H - 1 Then
If visited(x, y + 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y + 1
End If
End If
End Sub
Sub generate_maze ()
Dim visited(W, H) As Integer
Dim num_visited As Integer, num_cells As Integer, si As Integer
Dim cnt As Integer, rc As Integer, x As Integer, y As Integer
ReDim stack(0) As cell
Dim curr_cell As cell, next_cell As cell, cur_cell As cell
rand_cell cur_cell.x, cur_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = 1
num_cells = W * H
si = 0
While num_visited < num_cells
ReDim cells(0) As cell
cnt = 0
get_unvisited visited(), curr_cell, cells(), cnt
If cnt > 0 Then
' choose randomly one of the current cell's unvisited neighbours
rc = Int(Rnd * 100) Mod cnt + 1
next_cell.x = cells(rc).x
next_cell.y = cells(rc).y
' push the current cell to the stack
si = si + 1
ReDim _Preserve stack(si) As cell
stack(si).x = curr_cell.x
stack(si).y = curr_cell.y
' remove the wall between the current cell and the chosen cell
If next_cell.x = curr_cell.x Then
x = next_cell.x
y = max(next_cell.y, curr_cell.y)
h_walls(x, y) = 0
Else
x = max(next_cell.x, curr_cell.x)
y = next_cell.y
v_walls(x, y) = 0
End If
' make the chosen cell the current cell and mark it as visited
curr_cell.x = next_cell.x
curr_cell.y = next_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = num_visited + 1
ElseIf si > 0 Then
' pop a cell from the stack and make it the current cell
curr_cell.x = stack(si).x
curr_cell.y = stack(si).y
si = si - 1
ReDim _Preserve stack(si) As cell
Else
Exit While
End If
Wend
End Sub
Function max (a, b)
If a > b Then max = a Else max = b
End Function
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever