Maze Generator
Here is a little maze generator written in FB:
'Maze Maker
'Richard D. Clark
'Public domain
'FreeBasic .17
'*********************************
#Include "vbcompat.bi"
#define False 0
#define True Not False
const fbWhite = RGB (255, 255, 255)
const fbBlack = RGB (000, 000, 000)
const fbYellow = RGB (255, 255, 000)
const fbOrange = RGB (255, 128, 000)
'key consts
Const xk = Chr$(255)
Const key_close = xk + "k"
Const key_esc = Chr$(27)
Const key_enter = Chr$(13)
Const key_spac = Chr$(32)
enum gdir
north = 1
east
south
west
end enum
'Cell type
type cell
north as integer
south as integer
east as integer
west as integer
visit as integer
end type
dim shared maze(1 to 29, 1 to 40) as cell
dim as string key
'get a random number between low and high
Function Rand(lowerbound As Integer, upperbound As Integer) As Integer
Return Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function
sub DrawFullMaze
dim as integer i, j, x, y
cls
for i = 1 to 29
for j = 1 to 40
maze(i, j).visit = False
maze(i, j).north = False
maze(i, j).south = False
maze(i, j).east = False
maze(i, j).west = False
y = (i - 1) * 16
x = (j - 1) * 16
line(x, y)-(x + 16, y + 16), fbWhite, B
next
next
end sub
function CheckLoc(y as integer, x as integer, cdir as integer) as integer
dim as integer nx, ny, ret = False
if cdir = north then
nx = x
ny = y - 1
if ny > 0 then
if maze(ny, nx).visit = False then
ret = True
end if
end if
elseif cdir = east then
nx = x + 1
ny = y
if nx <= 40 then
if maze(ny, nx).visit = False then
ret = True
end if
end if
elseif cdir = south then
nx = x
ny = y + 1
if ny <= 29 then
if maze(ny, nx).visit = False then
ret = True
end if
end if
elseif cdir = west then
nx = x - 1
ny = y
if nx > 0 then
if maze(ny, nx).visit = False then
ret = True
end if
end if
end if
return ret
end function
function GetNewDir(y as integer, x as integer) as integer
dim as integer cdir, nx, ny
cdir = Rand(north, west)
if CheckLoc(y, x, cdir) then
return cdir
end if
cdir += 1
if cdir > west then cdir = north
if CheckLoc(y, x, cdir) then
return cdir
end if
cdir += 1
if cdir > west then cdir = north
if CheckLoc(y, x, cdir) then
return cdir
end if
cdir += 1
if cdir > west then cdir = north
if CheckLoc(y, x, cdir) then
return cdir
end if
return 0
end function
sub DrawMaze(y as integer, x as integer)
dim as integer dx, dy, nx, ny, cdir
dy = (y - 1) * 16
dx = (x - 1) * 16
maze(y, x).visit = True
cdir = GetNewDir(y, x)
if cdir = 0 then exit sub
if cdir = north then
'Try north direction
nx = x
ny = y - 1
maze(y, x).north = True
maze(ny, nx).south = True
line(dx, dy)-(dx + 16, dy), fbBlack
maze(ny, nx).visit = True
DrawMaze ny, nx
end if
if cdir = east then
'Try east direction
nx = x + 1
ny = y
maze(y, x).east = True
maze(ny, nx).west = True
line(dx + 16, dy)-(dx + 16, dy + 16), fbBlack
maze(ny, nx).visit = True
DrawMaze ny, nx
end if
if cdir = south then
'Try south direction
nx = x
ny = y + 1
maze(y, x).south = True
maze(ny, nx).north = True
line(dx, dy + 16)-(dx + 16, dy + 16), fbBlack
maze(ny, nx).visit = True
DrawMaze ny, nx
end if
if cdir = west then
'Try west direction
nx = x - 1
ny = y
maze(y, x).west = True
maze(ny, nx).east = True
line(dx, dy)-(dx, dy + 16), fbBlack
maze(ny, nx).visit = True
DrawMaze ny, nx
end if
DrawMaze y, x
end sub
sub DrawEndPoint(y as integer, x as integer, clr as integer)
dim as integer dx, dy
dy = (y - 1) * 16
dx = (x - 1) * 16
line(dx + 2, dy + 2)-(dx + 14, dy + 14), clr, BF
end sub
sub SetUpMaze
dim as integer mx, my
DrawFullMaze
my = Rand(1, 29)
mx = 40
maze(my, mx).visit = True
DrawMaze my, mx
DrawEndPoint 1, 1, fbYellow
DrawEndPoint 29, 40, fbYellow
end sub
Screen 18, 32
width 80, 60
Randomize Timer
WindowTitle "Maze Runner"
SetUpMaze
do
key = inkey
if key = key_spac then
SetUpMaze
end if
sleep 1
loop until (key = key_close) or (key = key_esc)
end
