Maze Solver

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Maze Solver

Post by KristopherWindsor »

I saw this maze on reddit and wrote a solver:

Image

Image

Blue is path traveled with the following strategy: go right whenever possible, otherwise go straight, go left, or go backwards.
Red is the solution. Starting at the end of the maze, the program backtracks to the neighbor cell who is closest to the maze start.

The program is animated, so have fun. :)
Save maze.bmp then run:

Code: Select all

' Maze Solver
' By Kristopher Windsor

#include once "fbgfx.bi"

Const true = -1, false = 0
Const white = &HFFFFFFFF, black = &HFF000000

Const sx = 901, sy = 901
Const mazex = 300, mazey = 300
Const tilesize = 3

Type place_type
  Declare Function dx(plus As Integer = 0) As Integer
  Declare Function dy(plus As Integer = 0) As Integer
  
  As Integer x, y
  As Integer d
End Type

Type square_type
  As Integer px, py, cost
End Type

Dim Shared As place_type place
Dim Shared As fb.image Ptr maze
Dim Shared As square_type square(0 To mazex - 1, 0 To mazey - 1)

Function place_type.dx(plus As Integer = 0) As Integer
  If (d + plus) Mod 4 = 1 Then Return 1
  If (d + plus) Mod 4 = 3 Then Return -1
  Return 0
End Function

Function place_type.dy(plus As Integer = 0) As Integer
  If (d + plus) Mod 4 = 0 Then Return -1
  If (d + plus) Mod 4 = 2 Then Return 1
  Return 0
End Function

Function cango(px As Integer, py As Integer, dx As Integer, dy As Integer) As Integer
  Dim As Integer x = (px * 2 * tilesize + (1 + dx) * tilesize) \ 2
  Dim As Integer y = (py * 2 * tilesize + (1 + dy) * tilesize) \ 2
  If x > 0 And y > 0 And px + dx < mazex And py + dy < mazey Then Return Point(x, y, maze) <> black
  Return false
End Function

Sub setsquarecost(x As Integer, y As Integer)
  If square(x, y).cost > 0 Then Return
  For dx As Integer = -1 To 1
    For dy As Integer = -1 To 1
      If (dx = 0) Xor (dy = 0) Then
        If x + dx >= 0 And y + dy >= 0 And x + dx < mazex And y + dy < mazey Then
          If cango(x, y, dx, dy) And square(x + dx, y + dy).cost > 0 Then
            If square(x, y).cost = 0 Or square(x, y).cost > square(x + dx, y + dy).cost Then
              With square(x, y)
                .px = x + dx
                .py = y + dy
                .cost = square(x + dx, y + dy).cost + 1
              End With
            End If
          End If
        End If
      End If
    Next dy
  Next dx
End Sub

Screenres sx, sy, 32

maze = imagecreate(mazex * tilesize + 1, mazey * tilesize + 1)
Bload("maze.bmp", maze)
Put (0, 0), maze, Pset
square(0, 0).cost = 1

Dim As Integer sp

Do
  For i As Integer = 0 To sp
    If cango(place.x, place.y, place.dx(1), place.dy(1)) Then
      place.d = (place.d + 1) Mod 4 'greedy right
    Elseif cango(place.x, place.y, place.dx(), place.dy()) Then
      'or straight
    Elseif cango(place.x, place.y, place.dx(3), place.dy(3)) Then
      place.d = (place.d + 3) Mod 4 'lazy left
    Else
      place.d = (place.d + 2) Mod 4 'dead ends
    End If
    place.x += place.dx()
    place.y += place.dy()
    setsquarecost(place.x, place.y)
    Line (place.x * tilesize + 1, place.y * tilesize + 1) - Step(1, 1), Rgb(0, 0, 255), BF
    If place.x = mazex - 1 And place.y = mazey - 1 Then Exit Do
  Next i
  
  Sleep(30, 1)
  If Multikey(fb.sc_up) Then sp += 1
  If Inkey() = Chr(27) Then System()
Loop

Dim As Integer x = place.x, y = place.y

sp = 0
While x <> 0 Or y <> 0
  For i As Integer = 0 To sp
    var s = @square(x, y)
    x = s->px
    y = s->py
    Circle (x * tilesize + 1, y * tilesize + 1), 4, Rgb(255, 0, 0),,, 1, F
  Next i
  
  Sleep(30, 1)
  If Multikey(fb.sc_up) Then sp += 1
  If Inkey() = Chr(27) Then System()
Wend

Print "Path length: ", square(mazex - 1, mazey - 1).cost
Bsave("solved.bmp", 0)
Sleep()
Hold the "up" arrow key to speed it up.
roook_ph
Posts: 402
Joined: Apr 01, 2006 20:50
Location: philippines
Contact:

Post by roook_ph »

Nice but what program do they use to make that maze in the first place ? That would be of more importance
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Post by anonymous1337 »

My first attempt would be a tree-like pattern generator. I would start off with the solution path, then pick points from that path to splice into false paths.

By the way, these mazes are also easily solved by photoshop :)
redcrab
Posts: 623
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Post by redcrab »

Hi there...

about maze generation ...
This remind me some old stuff that I've made .. (getting old pfeww ;) )

Code: Select all

'************************************
'* CSGP fun code                    *
'* Maze Generator By Redcrab        *
'* 05 May 2008                      *
'* FreeBASIC code                   *
'************************************
'* Generator ensuring there is only *
'* one path from a place to another *
'************************************

#Define MAXMaze 100

Type _Maze As Maze

Enum MazeRoomStatus
   GEN = &h1000
   NORMAL =&h2000
   VISITED =&h4000
   SENTINEL =&h8000
End Enum

Enum MazeDirection
   NORTH = &h1
   WEST = &h2
   SOUTH = &h4
   EAST = &h8
End Enum
#Define FIRSTDIR NORTH
#Define LASTDIR EAST


Type    MazeXY
   As Integer x,y
End Type

Enum MazeWall
   NOWALL =1
   WALL = 2
End Enum

Type MazeRoomData
   As Integer status,x,y
End Type

Type MazeRoom
   roomData As MazeRoomData
   walls(FIRSTDIR To LASTDIR) As MazeWall
   theMaze As _Maze ptr
   Declare Sub init(ByVal aMaze As _Maze ptr, ByVal x As Integer, ByVal y As Integer, ByVal status As MazeRoomStatus)
   Declare Function isWall(ByVal mdir As MazeDirection) As MazeWall
   Declare Function RoomStatus(ByVal mdir As MazeDirection) As MazeRoomStatus
   Declare Sub set(ByVal mdir As MazeDirection,ByVal wall As MazeWall)
   Declare Function getStatus() As MazeRoomStatus
   Declare Sub setStatus(st As MazeRoomStatus)
End Type

Type Maze
   Dim rooms(-1 To MAXMaze, -1 To MAXMaze) As MazeRoom
   Dim MazeMove(FIRSTDIR To LASTDIR) As MazeXY
   Dim MazeReverseDirection(FIRSTDIR to LASTDIR) As MazeDirection
   MazeSize As Integer
   _genTick As integer
   Declare Sub init(ByVal msize As Integer)
   Declare Sub generate(ByVal x As Integer, y As Integer,ByVal style As Integer)
   Declare Function _choose(ByVal possibilities As Integer, ByVal style As Integer) As Integer
   Declare Sub show(ByVal wallsize As Integer)
End Type

Sub Maze.init(ByVal msize As Integer)
   Dim As Integer i,j
   For i = FIRSTDIR to LASTDIR
      MazeMove(i).x = 0
      MazeMove(i).y = 0
      MazeReverseDirection(i) = 0
      If i And NORTH Then
         MazeMove(i).y-=1
         MazeReverseDirection(i) Or= SOUTH
      endif
      If i And WEST Then
         MazeMove(i).x-=1
         MazeReverseDirection(i) Or= EAST
      EndIf
      If i And SOUTH Then
         MazeMove(i).y+=1
         MazeReverseDirection(i) Or= NORTH
      EndIf
      If i And EAST Then
         MazeMove(i).x+=1
         MazeReverseDirection(i) Or= WEST
      EndIf
   Next
   MazeSize = msize
   For i = -1 To msize
      For j = -1 To msize
         If i=-1 Or i=msize Or j = -1 Or j=msize Then
            rooms(i,j).init(@this,i,j,SENTINEL)
         Else
            rooms(i,j).init(@this,i,j,NORMAL)
         EndIf
      Next     
   Next
   _genTick = 0
   generate(0,0,0)
End Sub

Sub Maze.generate(ByVal x As Integer, y As Integer,ByVal style As Integer)
   ' "Open" walls only on non already visited room
   If rooms(x,y).getStatus() AND NORMAL  = 0 Then Return
   Dim As Integer i, possibilities, choosen
   do ' enumerate posibilities and choose one to drill (recursive)
      rooms(x,y).setStatus(GEN)
      show(8)
      possibilities = 0
      For i = FIRSTDIR to LASTDIR
         If (rooms(x,y).roomStatus(i) And NORMAL)<>0 And (rooms(x,y).isWall(i) And WALL)<>0 Then
            possibilities += i ' cumulate possible direction binary mask
         EndIf
         i = i*2-1 ' we want power of 2 increment , to have a compliant binary mask
      Next i
      If possibilities <> 0 Then
         choosen = _choose(possibilities,style)
         rooms(x,y).set(choosen,NOWALL)
         rooms(x,y).setStatus(VISITED)
         generate(x+MazeMove(choosen).x, y+MazeMove(choosen).y, style)
      EndIf
   Loop Until possibilities = 0 'loop until no possibilities
   rooms(x,y).setStatus(VISITED)
End Sub

Function Maze._choose(ByVal possibilities As Integer, ByVal style As Integer) As Integer
   Dim aTry As integer
   If possibilities = 0 Then Return 0
   _genTick += 1
   Do
      aTry  = Int(2 ^ (Int (Rnd *4))) And possibilities
   Loop While aTry  = 0
   Return aTry
End Function

Sub Maze.show(ByVal wallsize As Integer)
   Dim As Integer x,y,xx,yy, ws
   ws = wallsize /2
   Cls
   For x = 0 To MazeSize -1
      For y = 0 To MazeSize -1
         xx = x*wallsize + wallsize
         yy = y*wallsize + wallsize     
         If rooms(x,y).getStatus() And (GEN Or VISITED) Then
            Line(xx-ws,yy-ws)-(xx+ws,yy+ws),RGB(0,32,0),bf
            If rooms(x,y).getStatus() And GEN Then circle(xx,yy),ws/2,RGB(0,128,0),,,,F
            If rooms(x,y).isWall(NORTH) And WALL Then Line (xx-ws, yy-ws)-(xx+ws,yy-ws),RGB(0,255,0)
            If rooms(x,y).isWall(WEST)  And WALL Then Line (xx-ws, yy-ws)-(xx-ws,yy+ws),RGB(0,255,0)
            If rooms(x,y).isWall(SOUTH) And WALL Then Line (xx-ws, yy+ws)-(xx+ws,yy+ws),RGB(0,255,0)
            If rooms(x,y).isWall(EAST)  And WALL Then Line (xx+ws, yy-ws)-(xx+ws,yy+ws),RGB(0,255,0)
         EndIf
      Next
   Next
   For x = 0 To MazeSize -1
      For y = 0 To MazeSize -1
         xx = x*wallsize + wallsize
         yy = y*wallsize + wallsize
          If rooms(x,y).getStatus() And (GEN Or VISITED) Then
        Else
            Line(xx-ws,yy-ws)-(xx+ws,yy+ws),RGB(0,64,0),bf
         EndIf
      Next
   Next
   Sleep 1,1
   ScreenSync
   flip
End Sub

Sub MazeRoom.init(ByVal aMaze As _Maze ptr, ByVal x As Integer, ByVal y As Integer, ByVal status As MazeRoomStatus)
   dim As Integer i
   roomData.x = x
   roomData.y = y
   roomData.status = status
   theMaze = aMaze
   For i = FIRSTDIR To LASTDIR
      walls(i) = WALL
   Next
End Sub

Function MazeRoom.getStatus() As MazeRoomStatus
   Return roomData.status
End Function

Sub MazeRoom.setStatus(st As MazeRoomStatus)
   roomData.status = st
End Sub

Function MazeRoom.isWall(ByVal mdir As MazeDirection) As MazeWall
   Return walls(mdir)
End Function

Function MazeRoom.RoomStatus(ByVal mdir As MazeDirection) As MazeRoomStatus
   Return theMaze->rooms(roomData.x + theMaze->MazeMove(mdir).x , roomData.y + theMaze->MazeMove(mdir).y).getStatus()
End Function

Sub MazeRoom.set(ByVal mdir As MazeDirection,ByVal wall As MazeWall)
   walls(mdir) = wall
   theMaze->rooms(roomData.x + theMaze->MazeMove(mdir).x , roomData.y + theMaze->MazeMove(mdir).y).walls(theMaze->MazeReverseDirection(mdir))=wall
End Sub

Dim Shared aMaze As Maze

Sub Main
   Screenres 640,480,24,2
   ScreenSet 0,1
   aMaze.init(50)
   aMaze.show(8)
End Sub

Randomize Timer
Main
Sleep
 
FB code and screenshot:
http://csgp.suret.net/blabla/viewtopic. ... &sk=t&sd=a

FB forum ref :
http://www.freebasic.net/forum/viewtopic.php?t=11397

USe the code as you wish

Have fun !
Avata
Posts: 106
Joined: Jan 17, 2021 7:27

Re: Maze Solver

Post by Avata »

I imported this code into VisualFBEditor ( https://github.com/XusinboyBekchanov/VisualFBEditor.)
The file is saved at "VisualFBEditorP\Examples\Game\Maze\"

Maze.frm

Code: Select all

'################################################################################
'#  Maze.frm                                                              #
'#  This file is an examples of MyFBFramework.                                  #
'#  Authors: Xusinboy Bekchanov, Liu XiaLin                                     #
'################################################################################

'#Region "Form"
	#if defined(__FB_MAIN__) AndAlso Not defined(__MAIN_FILE__)
		#define __MAIN_FILE__
		#ifdef __FB_WIN32__
			#cmdline "Form1.rc"
		#endif
		Const _MAIN_FILE_ = __FILE__
	#endif
	
	#include once "mff/Form.bi"
	#include once "mff/Panel.bi"
	#include once "mff/Picture.bi"
	#include once "mff/Label.bi"
	
	#include once "mff/ScrollControl.bi"
	#include once "mff/CommandButton.bi"
	#include once "mff/TrackBar.bi"
	#include once "mff/TimerComponent.bi"
	#include once "mff/NumericUpDown.bi"
	#include once "mff/UpDown.bi"
	#include once "maze.bi"
	Using My.Sys.Forms

	Dim Shared As Maze aMaze
	Dim Shared As Integer MazeX, MazeY
	Dim Shared As Boolean Ending, Playing = True
	' Adjust speed here
	Dim Shared As Long speed = 160 ' Frames Per Second
	' Adjust speed here
	Dim Shared As Long fps
	
	Type Form1Type Extends Form
		Declare Sub Form_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
		Declare Sub Form_Create(ByRef Sender As Control)
		Declare Sub Form_Close(ByRef Sender As Form, ByRef Action As Integer)
		Declare Sub PanelRender_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
		Declare Sub cmdPlay_Click(ByRef Sender As Control)
		Declare Sub cmdRefresh_Click(ByRef Sender As Control)
		Declare Sub TrackBarFPS_Change(ByRef Sender As TrackBar, Position As Integer)
		Declare Sub Form_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
		Declare Sub PanelRender_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
		Declare Sub TimerFPS_Timer(ByRef Sender As TimerComponent)
		Declare Sub Form_Show(ByRef Sender As Form)
		Declare Sub NumUpDnWallSize_KeyPress(ByRef Sender As Control, Key As Integer)
		Declare Sub NumUpDnMazeSize_KeyPress(ByRef Sender As Control, Key As Integer)
		Declare Sub ScrollMaze_Scroll(ByRef Sender As ScrollControl)
		Declare Constructor
		
		Dim As Picture PanelRender
		Dim As ScrollControl ScrollMaze
		Dim As Label lblFPS, lblLanguage, lblMazeSize, lblWallSize ', lblPosition
		Dim As CommandButton cmdRefresh, cmdPlay
		Dim As TrackBar TrackBarFPS
		Dim As TimerComponent TimerFPS
		Dim As NumericUpDown NumUpDnMazeSize, NumUpDnWallSize
		
	End Type
	
	Constructor Form1Type
		#if _MAIN_FILE_ = __FILE__
			With App
				.CurLanguagePath = ExePath & "/"
				.CurLanguage = .Language  '"Chinese (Simplified)"
			End With
		#endif
		' Form1
		With This
			.Name = "Form1"
			.Text = "VisualFBEditor-Maze"
			.Designer = @This
			.StartPosition = FormStartPosition.CenterScreen
			.OnResize = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer), @Form_Resize)
			.OnCreate = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @Form_Create)
			.OnClose = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Form, ByRef Action As Integer), @Form_Close)
			.OnPaint = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas), @Form_Paint)
			.OnShow = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Form), @Form_Show)
			.SetBounds 0, 0, 620, 450
		End With
		
		' PanelRender
		With PanelRender
			.Name = "PanelRender"
			.Text = "PanelRender"
			.TabIndex = 2
			.BackColor = 8421376
			.DoubleBuffered = True
			'.Anchor.Top = AnchorStyle.asAnchor
			'.Anchor.Right = AnchorStyle.asAnchor
			'.Anchor.Left = AnchorStyle.asAnchor
			'.Anchor.Bottom = AnchorStyle.asAnchor
			.SetBounds 0, 10, 310, 240
			.Designer = @This
			.OnResize = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer), @PanelRender_Resize)
			.OnPaint = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas), @PanelRender_Paint)
			.Parent = @ScrollMaze
		End With
		' lblFPS
		With lblFPS
			.Name = "lblFPS"
			.Text = "FPS:"
			.TabIndex = 1
			.SetBounds 10, 40, 70, 20
			.Designer = @This
			.Parent = @This
		End With
		' cmdRefresh
		With cmdRefresh
			.Name = "cmdRefresh"
			.Text = ML("Refresh")
			.TabIndex = 2
			.SetBounds 20, 70, 60, 20
			.Designer = @This
			.OnClick = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @cmdRefresh_Click)
			.Parent = @This
		End With
		' cmdPlay
		With cmdPlay
			.Name = "cmdPlay"
			.Text = ML("Play")
			.TabIndex = 3
			.ControlIndex = 2
			.Visible = False
			.SetBounds 20, 100, 60, 20
			.Enabled = False
			.Designer = @This
			.OnClick = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control), @cmdPlay_Click)
			.Parent = @This
		End With
		' TrackBarFPS
		With TrackBarFPS
			.Name = "TrackBarFPS"
			.Text = "TrackBarFPS"
			.TabIndex = 4
			.ControlIndex = 4
			.Hint = ML("change the FPS")
			.MaxValue = 255
			.MinValue = 10
			.Position = speed
			.SetBounds 8, 55, 77, 10
			.Designer = @This
			.OnChange = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As TrackBar, Position As Integer), @TrackBarFPS_Change)
			.Parent = @This
		End With
		' lblLanguage
		With lblLanguage
			.Name = "lblLanguage"
			.Text = ML("Language:") & App.CurLanguage
			.TabIndex = 5
			.ControlIndex = 1
			.SetBounds 10, 0, 100, 40
			.Designer = @This
			.Parent = @This
		End With
		
		' TimerFPS
		With TimerFPS
			.Name = "TimerFPS"
			.Interval = 50
			.Enabled = True
			.SetBounds 20, 200, 16, 16
			.Designer = @This
			.OnTimer = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As TimerComponent), @TimerFPS_Timer)
			.Parent = @This
		End With
		' lblMazeSize
		With lblMazeSize
			.Name = "lblMazeSize"
			.Text = ML("Maze Size:")
			.TabIndex = 6
			.SetBounds 10, 130, 60, 20
			.Designer = @This
			.Parent = @This
		End With
		' NumUpDnMazeSize
		With NumUpDnMazeSize
			.Name = "NumUpDnMazeSize"
			.Text = "20"
			.TabIndex = 8
			.MaxValue = 10
			.MinValue = 100
			.SetBounds 70, 130, 40, 20
			.Designer = @This
			.OnKeyPress = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, Key As Integer), @NumUpDnMazeSize_KeyPress)
			.Parent = @This
		End With
		' lblWallSize
		With lblWallSize
			.Name = "lblWallSize"
			.Text = ML("Wall Size:")
			.TabIndex = 9
			.ControlIndex = 6
			.SetBounds 10, 160, 60, 20
			.Designer = @This
			.Parent = @This
		End With
		' NumUpDnWallSize
		With NumUpDnWallSize
			.Name = "NumUpDnWallSize"
			.Text = "0"
			.TabIndex = 11
			.ControlIndex = 8
			.MaxValue = 10
			.MinValue = 100
			.SetBounds 70, 160, 40, 20
			.Designer = @This
			.OnKeyPress = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As Control, Key As Integer), @NumUpDnWallSize_KeyPress)
			.Parent = @This
		End With
		
			' ScrollMaze
		With ScrollMaze
			.Name = "ScrollMaze"
			.Text = "ScrollMaze"
			.TabIndex = 14
			.Anchor.Top = AnchorStyle.asAnchor
			.Anchor.Right = AnchorStyle.asAnchor
			.Anchor.Left = AnchorStyle.asAnchor
			.Anchor.Bottom = AnchorStyle.asAnchor
			.SetBounds 120, 10, 479, 390
			.Designer = @This
			.OnScroll = Cast(Sub(ByRef Designer As My.Sys.Object, ByRef Sender As ScrollControl), @ScrollMaze_Scroll)
			.Parent = @This
		End With
	'
	'	' lblPosition
	'	With lblPosition
	'		.Name = "lblPosition"
	'		.Text = "VisualFBEditor"
	'		.TabIndex = 13
	'		.SetBounds 360, 380, 260, 120
	'		.Designer = @This
	'		.Parent = @ScrollMaze
	'	End With
	End Constructor
	
	Dim Shared Form1 As Form1Type
	
	#if _MAIN_FILE_ = __FILE__
		App.DarkMode = True
		Form1.MainForm = True
		Form1.Show
		App.Run
	#endif
'#End Region

Function regulate(ByVal myfps As Long, ByRef fps As Long) As Long
	Static As Double timervalue, _lastsleeptime, t3, frames
	frames += 1
	If (Timer - t3) >= 1 Then t3 = Timer : fps = frames : frames = 0
	Var sleeptime = _lastsleeptime + ((1 / myfps) - Timer + timervalue) * 1000
	If sleeptime < 1 Then sleeptime = 1
	_lastsleeptime = sleeptime
	timervalue = Timer
	Return sleeptime
End Function

'the main rendering code.  渲染代码主过程。
Sub RenderProj(Param As Any Ptr)
	
End Sub

Private Sub Form1Type.Form_Create(ByRef Sender As Control)
	
End Sub

Private Sub Form1Type.Form_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
	
End Sub


Private Sub Form1Type.Form_Close(ByRef Sender As Form, ByRef Action As Integer)
	Ending = True
End Sub

Private Sub Form1Type.PanelRender_Resize(ByRef Sender As Control, NewWidth As Integer, NewHeight As Integer)
	
End Sub

Private Sub Form1Type.cmdPlay_Click(ByRef Sender As Control)
	Playing = True
	cmdPlay.Enabled = Not Playing
	cmdRefresh.Enabled = Playing
	If Playing Then RenderProj(0)
	TimerFPS.Enabled = Playing
	'aMaze.Show(Val(NumUpDnWallSize.Text))
	
End Sub

Private Sub Form1Type.cmdRefresh_Click(ByRef Sender As Control)
	'Playing = False
	'cmdPlay.Enabled = Not Playing
	'cmdRefresh.Enabled = Playing
	'If Playing Then RenderProj(0)
	cmdRefresh.Enabled = False
	PanelRender.Width = (Val(NumUpDnMazeSize.Text) + 1) * Val(NumUpDnWallSize.Text): PanelRender.Height = PanelRender.Width
	'lblPosition.Left = PanelRender.Width + 20 : lblPosition.Top = PanelRender.Height + 20
	TimerFPS.Enabled = Playing
	MazeX = 0 : MazeY = 0
	aMaze.Init(Val(NumUpDnMazeSize.Text), Val(NumUpDnWallSize.Text))
	ScrollMaze.RecalculateScrollBars
	PanelRender.Repaint
	cmdRefresh.Enabled = True
End Sub

Private Sub Form1Type.TrackBarFPS_Change(ByRef Sender As TrackBar, Position As Integer)
	If Sender.Position < 10 Then Sender.Position = 10
	speed = Sender.Position
	lblFPS.Text = "FPS:" & speed
End Sub

Private Sub Form1Type.Form_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
	
End Sub

Private Sub Form1Type.PanelRender_Paint(ByRef Sender As Control, ByRef Canvas As My.Sys.Drawing.Canvas)
	Dim As Integer x, y, xx, yy, ws
	ws = aMaze.WallSize / 2
	Debug.Print "aMaze.WallSize=" & aMaze.WallSize
	Debug.Print "aMaze.MazeSize=" & aMaze.MazeSize
	'Canvas.Scale(0, 0, (aMaze.MazeSize+ 1) * aMaze.WallSize / 2, (aMaze.MazeSize+ 1) * aMaze.WallSize/ 2)
	Canvas.Cls
	For x = 0 To aMaze.MazeSize -1
		For y = 0 To aMaze.MazeSize -1
			xx = x*aMaze.WallSize + aMaze.WallSize
			yy = y*aMaze.WallSize + aMaze.WallSize
			If aMaze.rooms(x, y).getStatus() And (Gen Or Visited) Then
				'Canvas.Line(xx - ws, yy - ws, xx + ws, yy + ws, RGB(0, 32, 0), "bf")
				If aMaze.rooms(x, y).getStatus() And Gen Then Canvas.Circle(xx, yy, ws / 2, RGB(255, 128, 0))
				If aMaze.rooms(x, y).isWall(North) And WALL Then Canvas.Line (xx - ws, yy - ws, xx + ws, yy - ws, RGB(0, 255, 0))
				If aMaze.rooms(x, y).isWall(West)  And WALL Then Canvas.Line (xx - ws, yy - ws, xx - ws, yy + ws, RGB(0, 255, 0))
				If aMaze.rooms(x, y).isWall(South) And WALL Then Canvas.Line (xx - ws, yy + ws, xx + ws, yy + ws, RGB(0, 255, 0))
				If aMaze.rooms(x, y).isWall(East)  And WALL Then Canvas.Line (xx + ws, yy - ws, xx + ws, yy + ws, RGB(0, 255, 0))
			End If
		Next
	Next
	'Draw entry
	x = 0: y = 0
    xx = x*aMaze.WallSize + aMaze.WallSize
	yy = y*aMaze.WallSize + aMaze.WallSize
	'Canvas.Line(xx - ws * 1.1, yy - ws * 0.7, xx - ws *.9, yy + ws *.8, PanelRender.BackColor) ', "bf")
	Canvas.Line (xx - ws, yy - ws, xx - ws, yy + ws, PanelRender.BackColor)
	Canvas.TextOut(xx - ws *.8, yy - ws *.8, "->")
	
	'Draw Exit
	x = aMaze.MazeSize -1: y = aMaze.MazeSize -1
    xx = x*aMaze.WallSize + aMaze.WallSize
	yy = y*aMaze.WallSize + aMaze.WallSize
	'Canvas.Line(xx + ws *.9, yy - ws * 0.7, xx + ws * 1.1, yy + ws *.8, PanelRender.BackColor) ', "bf")
	Canvas.Line (xx + ws, yy - ws, xx + ws, yy + ws, PanelRender.BackColor)
	Canvas.TextOut(xx - ws * 0.2, yy - ws *.8, "->")
	'
	'Exit Sub
	'For x = 0 To aMaze.MazeSize -1
	'	For y = 0 To aMaze.MazeSize -1
	'		xx = x * aMaze.WallSize + aMaze.WallSize
	'		yy = y * aMaze.WallSize + aMaze.WallSize
	'		If aMaze.rooms(x,y).getStatus() And (Gen Or Visited) Then
	'		Else
	'			Canvas.Line(xx - ws, yy - ws, xx + ws, yy + ws, RGB(0, 64, 0), "bf")
	'		End If
	'	Next
	'Next
End Sub

Private Sub Form1Type.TimerFPS_Timer(ByRef Sender As TimerComponent)
	
	'App.DoEvents
	If MazeY > aMaze.MazeSize- 1 Then
		MazeX += 1
		MazeY = 0
	End If
	'PanelRender.Repaint
	MazeY += 1
	Sleep regulate(speed, fps), 1
	
End Sub

Private Sub Form1Type.Form_Show(ByRef Sender As Form)
	cmdRefresh_Click(Sender)
End Sub

Private Sub Form1Type.NumUpDnWallSize_KeyPress(ByRef Sender As Control, Key As Integer)
	If Key = 13 Then cmdRefresh_Click(Sender)
End Sub

Private Sub Form1Type.NumUpDnMazeSize_KeyPress(ByRef Sender As Control, Key As Integer)
	If Key = 13 Then cmdRefresh_Click(Sender)
End Sub

Private Sub Form1Type.ScrollMaze_Scroll(ByRef Sender As ScrollControl)
	Print "PanelRender.ClientWidth=" & PanelRender.ClientWidth & ", PanelRender.ClientHeight=" & PanelRender.ClientHeight
	Print " ScrollMaze.ClientWidth=" & Sender.ClientWidth & ",       ScrollMaze.ClientHeight=" & Sender.ClientHeight
End Sub
badidea
Posts: 2594
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Maze Solver

Post by badidea »

My maze building attempt in 2020: Re: The spooky recursive backtracker
Post Reply