96 lines
3.3 KiB
Plaintext
96 lines
3.3 KiB
Plaintext
Const MazeWidth = 11
|
|
Const MazeHeight = 9
|
|
Const MazeCell = 50
|
|
|
|
Dim Shared dstx As Integer = MazeWidth - 1
|
|
Dim Shared dsty As Integer = 0
|
|
|
|
Screenres MazeWidth * MazeCell, MazeHeight * MazeCell, 32
|
|
Windowtitle "Maze solving"
|
|
|
|
Sub Cell(Maze() As Integer, Byval x As Integer, Byval y As Integer, Byval w As Integer, Byval h As Integer, Byval s As Integer)
|
|
Dim As Integer i, p, q, r
|
|
Maze(x, y) Or= &H40
|
|
r = Rnd * 4
|
|
For i = r To r + 3
|
|
Select Case i Mod 4
|
|
Case 0: p = x - 1 : q = y
|
|
Case 1: p = x + 1 : q = y
|
|
Case 2: p = x : q = y - 1
|
|
Case 3: p = x : q = y + 1
|
|
End Select
|
|
If p >= 0 And p < w And q >= 0 And q < h And Maze(p, q) < &H40 Then
|
|
If p > x Then Maze(p, q) Or= 1 : Line (p * s, y * s + 4) - (p * s, (y + 1) * s - 4), Rgb(0, 0, 0)
|
|
If q > y Then Maze(p, q) Or= 2 : Line (x * s + 4, q * s) - ((x + 1) * s - 4, q * s), Rgb(0, 0, 0)
|
|
If x > p Then Maze(x, y) Or= 1 : Line (x * s, y * s + 4) - (x * s, (y + 1) * s - 4), Rgb(0, 0, 0)
|
|
If y > q Then Maze(x, y) Or= 2 : Line (x * s + 4, y * s) - ((x + 1) * s - 4, y * s), Rgb(0, 0, 0)
|
|
Cell Maze(), p, q, w, h, s
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Sub GenerateMaze(Maze() As Integer, Byval w As Integer, Byval h As Integer, Byval s As Integer)
|
|
Dim As Integer x, y
|
|
Redim Maze(w, h)
|
|
For y = 0 To h - 1
|
|
Line (0, y * s) - (w * s, y * s), Rgb(255, 255, 255)
|
|
Next
|
|
For x = 0 To w - 1
|
|
Line (x * s, 0) - (x * s, h * s), Rgb(255, 255, 255)
|
|
Next
|
|
Cell Maze(), Rnd * w, Rnd * h, w, h, s
|
|
End Sub
|
|
|
|
Sub SolveMaze(Path() As Integer, Maze() As Integer, Byval x As Integer, Byval y As Integer, Byval dstx As Integer, Byval dsty As Integer, Byval s As Integer)
|
|
Dim As Integer h, i, n, p, q, w
|
|
w = Ubound(Maze, 1)
|
|
h = Ubound(Maze, 2)
|
|
Redim Path(w * h, 1)
|
|
Maze(x, y) Or= &H80
|
|
Do
|
|
For i = 0 To 3
|
|
Select Case i
|
|
Case 0: p = x - 1 : q = y
|
|
Case 1: p = x + 1 : q = y
|
|
Case 2: p = x : q = y - 1
|
|
Case 3: p = x : q = y + 1
|
|
End Select
|
|
If p >= 0 And p < w And q >= 0 And q < h And Maze(p, q) < &H80 Then
|
|
If p > x And Maze(p, q) And 1 Then Exit For
|
|
If q > y And Maze(p, q) And 2 Then Exit For
|
|
If x > p And Maze(x, y) And 1 Then Exit For
|
|
If y > q And Maze(x, y) And 2 Then Exit For
|
|
End If
|
|
Next
|
|
If i < 4 Then
|
|
Maze(p, q) Or= &H80
|
|
Path(n, 0) = x
|
|
Path(n, 1) = y
|
|
Line ((x + 0.5) * s, (y + 0.5) * s) - ((p + 0.5) * s, (q + 0.5) * s), Rgb(255, 0, 0), , &b0001111111111100
|
|
n += 1
|
|
Else
|
|
If n > 0 Then
|
|
n -= 1
|
|
p = Path(n, 0)
|
|
q = Path(n, 1)
|
|
Line ((x + 0.5) * s, (y + 0.5) * s) - ((p + 0.5) * s, (q + 0.5) * s), Rgb(0, 0, 0)
|
|
End If
|
|
End If
|
|
x = p
|
|
y = q
|
|
Sleep 200
|
|
Loop Until x = dstx And y = dsty Or Inkey <> ""
|
|
Path(n, 0) = x
|
|
Path(n, 1) = y
|
|
End Sub
|
|
|
|
Dim Maze() As Integer
|
|
Dim Path() As Integer
|
|
|
|
Randomize Timer
|
|
GenerateMaze(Maze(), MazeWidth, MazeHeight, MazeCell)
|
|
SolveMaze(Path(), Maze(), 0, MazeHeight - 1, MazeWidth - 1, 0, MazeCell)
|
|
Windowtitle "Maze solving ** RESOLVED **"
|
|
|
|
Sleep
|