131 lines
3.0 KiB
Plaintext
131 lines
3.0 KiB
Plaintext
' 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
|