Imports System.Math
Public Class Form1
Const nsize = 40
Const Maxpixelsl = 1000 ' Large
Const Maxpixelsc = 12 ' maze cell
Const Maxpixelss = 100 ' Small
Public maze(nsize, nsize), maze1(nsize, nsize), maze2(nsize, nsize)
Public test(nsize)
Public free, bussy As Integer
Public bmpl As New Bitmap(Maxpixelsl, Maxpixelsl)
Public bmp3 As New Bitmap(Maxpixelss, Maxpixelss)
Public rgbx(2), argblblue, argbwhite, argbred, argbblue, argbblack, argbyellow ' GETcoulour1
Public ixxsave, iyysave As Integer
Public error1, error2, error3 As Integer
Public maxpixels4, diyy, dixx As Integer
Public mazenew, mazeold As Integer
Public iyycur, ixxcur, iyycurx, ixxcurx, isize As Integer
Const trace = 0
Public timer1, timer2 As Double
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
LFinished.Visible = False
LTimer.Visible = False
LError.Visible = False
TBTimer.Visible = False
TBError.Visible = False
TBTimer.Text = 0
isize = Val(TBSize.Text)
isize = Int(isize / 2) * 2
If isize > nsize Then isize = nsize
If isize < 6 Then isize = 6
TBSize.Text = Str(isize)
Application.DoEvents()
Form2.PictureBox1.Width = (isize + 1) * Maxpixelsc
Form2.PictureBox1.Height = (isize + 1) * Maxpixelsc
Form2.Width = (isize + 1) * Maxpixelsc + 16
Form2.Height = (isize + 1) * Maxpixelsc + 38
Application.DoEvents()
Main()
End Sub
Sub Main()
Dim Randomizer As New Random
Dim rnumber, cnt As Integer
Initial()
' Debug.Print("1")
TestMaze(2) ' stage 1
TestMazeMin()
PrintMaze()
bussy = (isize - 1) ^ 2 - free
Debug.Print(Str(free) + " " + Str(rnumber))
CopyMaze(maze, maze1)
maze(isize - 1, isize) = 3
TestMaze(3)
If trace = 1 Then PrintMaze()
TestMazeMin()
rnumber = Randomizer.Next(free)
SetMaze(rnumber)
Do
CopyMaze(maze1, maze)
maze(ixxsave, iyysave) = 1
TestMaze(2) ' stage 1
TestMazeMin()
If trace = 1 Then PrintMaze()
CopyMaze(maze, maze1) ' save new maze
' maze(isize - 1, isize) = 3
' TestMaze(3)
TBFree.Text = Str(free)
Application.DoEvents()
Do
If trace = 1 Then PrintMaze()
TestMazeMin()
rnumber = Randomizer.Next(free)
SetMaze(rnumber)
CopyMaze(maze, maze2) ' save new maze
Watertest() ' Water test maze2
' If error1 > 0 Then DisplayMaze()
If error1 > 0 Then CopyMaze(maze1, maze)
Loop Until error1 = 0
If trace = 1 Then Debug.Print("Free " + Str(free) + " " + Str(rnumber) + " " + Str(cnt))
If free = 0 Then
maze(isize - 1, isize) = 3
TestMaze(3)
PrintMaze() ' Print solution
' DisplayMaze() ' Display solution
If maze(1, 1) = 3 Then
Debug.Print("Main Finished " + Str(cnt) + Str(timer1))
Else
Debug.Print("Main Error " + Str(cnt))
End If
CopyMaze(maze1, maze)
maze(1, 0) = 5 ' Black cursor
ixxcur = 1 : iyycur = 0
timer1 = DateAndTime.Timer
maze(isize - 1, isize) = 3 ' Yellow Finish
argbred = argbwhite ' Don't Dispaly Dead End Street
DisplayMaze()
TBTimer.Visible = True
LTimer.Visible = True
LError.Visible = True
TBError.Visible = True
PictureBox1.Visible = True
Exit Sub
End If
cnt = cnt + 1
Loop Until cnt = 1000
End Sub
Sub TestMaze(target)
Dim ixx, iyy, count, match As Integer
Do
match = 1 : free = 0
For ixx = 1 To isize - 1
For iyy = 1 To isize - 1
If maze(ixx, iyy) <= 0 Then
count = 0
If maze(ixx - 1, iyy) > 0 Then count = count + 1
If maze(ixx + 1, iyy) > 0 Then count = count + 1
If maze(ixx, iyy + 1) > 0 Then count = count + 1
If maze(ixx, iyy - 1) > 0 Then count = count + 1
If count = 3 Then
maze(ixx, iyy) = target : match = 0
If maze(ixx - 1, iyy) = 0 Then maze(ixx - 1, iyy) = -1
If maze(ixx + 1, iyy) = 0 Then maze(ixx + 1, iyy) = -1
If maze(ixx, iyy + 1) = 0 Then maze(ixx, iyy + 1) = -1
If maze(ixx, iyy - 1) = 0 Then maze(ixx, iyy - 1) = -1
Else
free = free + 1
End If
End If
Next iyy
Next ixx
Loop Until match = 1
free = free - 1
End Sub
Sub TestMazeMin()
Dim ixx, iyy, count, match As Integer
Do
match = 1 : free = 0
For ixx = 1 To isize - 1
For iyy = 1 To isize - 1
If maze(ixx, iyy) = -1 Then
count = 0
If maze(ixx - 1, iyy) = 0 Then count = count + 1
If maze(ixx + 1, iyy) = 0 Then count = count + 1
If maze(ixx, iyy + 1) = 0 Then count = count + 1
If maze(ixx, iyy - 1) = 0 Then count = count + 1
If count = 1 Then
If maze(ixx - 1, iyy) = 0 Then maze(ixx - 1, iyy) = -1 : match = 0
If maze(ixx + 1, iyy) = 0 Then maze(ixx + 1, iyy) = -1 : match = 0
If maze(ixx, iyy + 1) = 0 Then maze(ixx, iyy + 1) = -1 : match = 0
If maze(ixx, iyy - 1) = 0 Then maze(ixx, iyy - 1) = -1 : match = 0
End If
End If
If maze(ixx, iyy) = 0 Then
If maze(ixx, iyy + 1) = 1 And maze(ixx + 1, iyy) = 1 Then
If maze(ixx + 1, iyy + 1) = 1 Then maze(ixx, iyy) = -1 : match = 0
End If
If maze(ixx, iyy + 1) = 1 And maze(ixx - 1, iyy) = 1 Then
If maze(ixx - 1, iyy + 1) = 1 Then maze(ixx, iyy) = -1 : match = 0
End If
If maze(ixx, iyy - 1) = 1 And maze(ixx + 1, iyy) = 1 Then
If maze(ixx + 1, iyy - 1) = 1 Then maze(ixx, iyy) = -1 : match = 0
End If
If maze(ixx, iyy - 1) = 1 And maze(ixx - 1, iyy) = 1 Then
If maze(ixx - 1, iyy - 1) = 1 Then maze(ixx, iyy) = -1 : match = 0
End If
End If
If maze(ixx, iyy) = 0 Then free = free + 1
Next iyy
Next ixx
Loop Until match = 1
End Sub
Sub PrintMaze()
Dim ixx, iyy As Integer
Dim text, text1 As String
For ixx = 0 To isize
text = ""
For iyy = 0 To isize
text1 = " "
If maze(ixx, iyy) = -1 Then text1 = " -" ' Don't use
If maze(ixx, iyy) = 1 Then text1 = " X" ' Wall
If maze(ixx, iyy) = 2 Then text1 = " ." ' Dead End Path
If maze(ixx, iyy) = 3 Then text1 = " o" ' Solution
If maze(ixx, iyy) = 4 Then text1 = " w" ' Water
If maze(ixx, iyy) = 5 Then text1 = " B"
text = text + text1
Next iyy
Debug.Print(text)
Next ixx
End Sub
Sub DisplayMaze()
Dim XStr, Ystr As Integer
Dim ixx, iyy As Integer
For ixx = 0 To (nsize + 1) * Maxpixelsc
For iyy = 0 To (nsize + 1) * Maxpixelsc
bmpl.SetPixel(iyy, ixx, argblblue)
Next iyy
Next ixx
For ixx = 0 To (isize + 1) * Maxpixelsc
For iyy = 0 To (isize + 1) * Maxpixelsc
bmpl.SetPixel(iyy, ixx, argbwhite)
Next iyy
Next ixx
For ixx = 0 To isize
For iyy = 0 To isize
If maze(ixx, iyy) > 0 Then
' If maze(ixx, iyy) = 5 Then Debug.Print("DisplayMaze 5" + Str(ixx) + " " + Str(iyy))
XStr = iyy * Maxpixelsc
Ystr = ixx * Maxpixelsc
For X% = 0 To Maxpixelsc - 1
For Y% = 0 To Maxpixelsc - 1
If maze(ixx, iyy) = 1 Then bmpl.SetPixel(XStr + X%, Ystr + Y%, argbblue) ' wall
If maze(ixx, iyy) = 2 Then bmpl.SetPixel(XStr + X%, Ystr + Y%, argbred)
If maze(ixx, iyy) = 3 Then bmpl.SetPixel(XStr + X%, Ystr + Y%, argbyellow) ' solution
If maze(ixx, iyy) = 4 Then bmpl.SetPixel(XStr + X%, Ystr + Y%, argblblue) ' water
If maze(ixx, iyy) = 5 Then bmpl.SetPixel(XStr + X%, Ystr + Y%, argbblack)
Next
Next
End If
Next iyy
Next ixx
Form2.PictureBox1.Image = bmpl
End Sub
Sub DisplayMazeShort()
Dim XStr, Ystr As Integer
Dim ixx, iyy As Integer
iyy = iyycurx
ixx = ixxcurx
XStr = iyy * Maxpixelsc
Ystr = ixx * Maxpixelsc
For X% = 0 To Maxpixelsc - 1
For Y% = 0 To Maxpixelsc - 1
bmpl.SetPixel(XStr + X%, Ystr + Y%, argbwhite)
Next
Next
' new position
iyy = iyycur
ixx = ixxcur
XStr = iyy * Maxpixelsc
Ystr = ixx * Maxpixelsc
For X% = 0 To Maxpixelsc - 1
For Y% = 0 To Maxpixelsc - 1
bmpl.SetPixel(XStr + X%, Ystr + Y%, argbblack)
Next
Next
Form2.PictureBox1.Image = bmpl
End Sub
Sub SetMaze(rnumber)
Dim ixx, iyy, count As Integer
count = 0
For ixx = 1 To isize - 1
For iyy = 1 To isize - 1
If maze(ixx, iyy) = 0 Then
If count = rnumber Then
maze(ixx, iyy) = 1
ixxsave = ixx
iyysave = iyy
End If
count = count + 1
End If
Next iyy
Next ixx
End Sub
Sub Watertest() 'maze2
Dim ixx, iyy, match, count As Integer
maze2(1, 1) = 4 : error1 = 0
Do
match = 0
For ixx = 1 To isize - 1
For iyy = 1 To isize - 1
Next iyy
Next ixx
Loop Until match = 0
count = 0
For ixx = 1 To isize - 1
For iyy = 1 To isize - 1
Next iyy
Next ixx
If count > 0 Then error1 = 1
If error1 = 1 Then Debug.Print("WaterTest Error" + Str(count))
If trace = 1 Then If error1 = 0 Then Debug.Print("WaterTest " + Str(count))
End Sub
Sub CopyMaze(mazesrc, mazedst)
Dim ixx, iyy, count As Integer
count = 0
For ixx = 0 To isize
For iyy = 0 To isize
mazedst(ixx, iyy) = mazesrc(ixx, iyy)
Next iyy
Next ixx
End Sub
Sub Initial()
Dim alpha, red, green, blue As Single
Dim ixx, iyy As Integer
error1 = 0 : error2 = 0 : error3 = 0
mazenew = -1
TBError.Text = 0
For ixx = 0 To isize
For iyy = 0 To isize
maze(ixx, iyy) = 0
Next iyy
Next ixx
For iyy = 0 To isize : maze(0, iyy) = 1 : Next iyy
For iyy = 0 To isize : maze(isize, iyy) = 1 : Next iyy
For ixx = 0 To isize : maze(ixx, 0) = 1 : Next ixx
For ixx = 0 To isize : maze(ixx, isize) = 1 : Next ixx
maze(isize - 1, isize) = -1 ' End
maze(isize - 1, isize - 1) = -1 ' End
maze(1, 0) = -1 ' Should be free
maze(1, 1) = -1 ' Should be free
For ixx = 2 To isize - 2 Step 2
For iyy = 2 To isize - 2 Step 2
maze(ixx, iyy) = 1 ' used
Next iyy
Next ixx
For ixx = 1 To isize - 1 Step 2
For iyy = 1 To isize - 1 Step 2
maze(ixx, iyy) = -1 ' free
Next iyy
Next ixx
' maze(isize - 1, isize - 4) = 1
' maze(isize - 3, isize - 4) = 1
' maze(isize - 4, isize - 3) = 1
red = rgbx(0) : green = rgbx(1) : blue = rgbx(2) : alpha = 255
red = 0 : green = 0 : blue = 255
argbblue = Color.FromArgb(alpha, red, green, blue)
red = 255 : green = 0 : blue = 0
argbred = Color.FromArgb(alpha, red, green, blue)
red = 255 : green = 255 : blue = 255
argbwhite = Color.FromArgb(alpha, red, green, blue)
red = 0 : green = 0 : blue = 0
argbblack = Color.FromArgb(alpha, red, green, blue)
red = 220 : green = 220 : blue = 220 'Gainsboro
argblblue = Color.FromArgb(alpha, red, green, blue)
red = 255 : green = 255 : blue = 0
argbyellow = Color.FromArgb(alpha, red, green, blue)
Picture()
End Sub
Sub Picture()
Dim xstr, ystr As Single
xstr = 0 : ystr = 0
maxpixels4 = Int(Maxpixelss / 6) * 6
DrawArrow(maxpixels4 / 2, maxpixels4 / 6, 90) ' 12 hour x= 0 y=1
DrawArrow(maxpixels4 / 6, maxpixels4 / 2, 180) ' 9 hour x=-1 y=0
DrawArrow(5 * maxpixels4 / 6, maxpixels4 / 2, 0) ' 3 hour x= 1 y=0
DrawArrow(maxpixels4 / 2, 5 * maxpixels4 / 6, 270) ' 6 hour x= 0 y=-1
Me.PictureBox1.Image = bmp3
Debug.Print("Picture " + Str(maxpixels4))
End Sub
Sub DrawArrow(xx, yy, hoek)
Dim xpos, ypos As Integer
Dim pi, r As Double
Dim x3, y3, x6, y6, x9, y9, x12, y12 As Integer '3 = 3 hour
pi = 4 * Atan(1)
For X% = -maxpixels4 / 6 To maxpixels4 / 6
For Y% = -maxpixels4 / 6 To maxpixels4 / 6
xpos = xx + X% : ypos = yy + Y%
If xpos >= maxpixels4 Then xpos = maxpixels4 - 1
If ypos >= maxpixels4 Then ypos = maxpixels4 - 1
If xpos < 0 Then xpos = 0
If ypos < 0 Then ypos = 0
bmp3.SetPixel(xpos, ypos, argbwhite)
Next
Next
r = maxpixels4 / 6
r = r * 0.7
x3 = xx + r * Cos(hoek * pi / 180)
y3 = yy - r * Sin(hoek * pi / 180) ' reverse direction
x6 = xx + r * Cos((hoek - 90) * pi / 180)
y6 = yy - r * Sin((hoek - 90) * pi / 180) ' reverse direction
x9 = xx + r * Cos((hoek + 180) * pi / 180)
y9 = yy - r * Sin((hoek + 180) * pi / 180) ' reverse direction
x12 = xx + r * Cos((hoek + 90) * pi / 180)
y12 = yy - r * Sin((hoek + 90) * pi / 180) ' reverse direction
If trace = 1 Then Debug.Print(Str(pi) + Str(hoek) + " 3 " + Str(xx) + Str(yy))
If trace = 1 Then Debug.Print(Str(pi) + Str(hoek) + " 3 " + Str(x3) + Str(y3))
Drawline(x9, y9, x3, y3)
Drawline(x6, y6, x3, y3)
Drawline(x12, y12, x3, y3)
End Sub
Private Sub Drawline(x1, y1, x2, y2)
Dim dx, dy, r As Double
Dim i, xpos, ypos As Integer
dx = x2 - x1 : dy = y2 - y1
r = Sqrt(dx * dx + dy * dy)
For i = 0 To r
xpos = x1 + dx * i / r
ypos = y1 + dy * i / r
bmp3.SetPixel(xpos, ypos + 1, argbblue)
bmp3.SetPixel(xpos, ypos, argbblue)
bmp3.SetPixel(xpos + 1, ypos, argbblue)
Next
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
End
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Form2.Visible = True
TBTimer.Visible = False
TBError.Visible = False
LTimer.Visible = False
LFinished.Visible = False
LError.Visible = False
PictureBox1.Visible = False
End Sub
Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
If trace = 1 Then Debug.Print("Form1 PictureBox1.Click")
End Sub
Private Sub Picture_mousedoubleclick() Handles PictureBox1.MouseDoubleClick
If trace = 1 Then Debug.Print("Form1 PictureBox1.MouseDoubleClick")
End Sub
Private Sub Form1_mousedoubleclick() Handles PictureBox1.DoubleClick
If trace = 1 Then Debug.Print("Form1 PictureBox1.DoubleClick")
End Sub
Private Sub Form1_mousedown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim ixxcur1, iyycur1 As Integer
' Debug.Print("Form1 PictureBox1.MouseDown")
Dim mouseX As Integer = e.X
Dim mouseY As Integer = e.Y
' Debug.Print(" X " + Str(mouseX) + " Y" + Str(mouseY))
diyy = 0 : dixx = 0
If mouseX > 4 * maxpixels4 / 6 Then dixx = 0 : diyy = 1 ' 3 hour
If mouseX < 2 * maxpixels4 / 6 Then dixx = 0 : diyy = -1 ' 9 hour
If mouseY > 4 * maxpixels4 / 6 Then dixx = 1 : diyy = 0 ' 6 hour
If mouseY < 2 * maxpixels4 / 6 Then dixx = -1 : diyy = 0 : dixx = -1 ' 12 hour
Debug.Print("Form1 PictureBox1.MouseDown" + " iyy" + Str(diyy) + " ixx" + Str(dixx))
ixxcurx = ixxcur 'old
iyycurx = iyycur 'old
ixxcur1 = ixxcur + dixx
iyycur1 = iyycur + diyy
If iyycur1 > isize Then iyycur1 = isize
If maze(ixxcur1, iyycur1) <> 1 Then
maze(ixxcur, iyycur) = mazenew
ixxcur = ixxcur + dixx 'new
iyycur = iyycur + diyy 'new
If iyycur > isize Then iyycur = isize
If maze(ixxcur, iyycur) > 0 Then
error3 = error3 + 1 : Debug.Print("Error" + Str(error2) + " " + Str(error3))
End If
' mazeold = mazenew
mazenew = maze(ixxcur, iyycur)
maze(ixxcur, iyycur) = 5
DisplayMazeShort()
timer2 = DateAndTime.Timer
TBTimer.Text = Str(Int(timer2 - timer1))
If iyycur = isize Then
LFinished.Visible = True
PictureBox1.Visible = False
TBError.Text = Str(error2 + error3 - 1)
Application.DoEvents()
maze(isize - 1, isize) = 3
TestMaze(3)
DisplayMaze()
PrintMaze()
End If
Else
error2 = error2 + 1 ' against wall
TBError.Text = Str(error2)
End If
End Sub
End Class