Maze Walker

User projects written in or related to FreeBASIC.
Post Reply
NorbyDroid
Posts: 70
Joined: May 21, 2016 22:55

Maze Walker

Post by NorbyDroid »

Here is a program that not only creates mazes, but solves them too using a 32x48 RPG Character (optional).

You can download one from here:
http://www.untamed.wild-refuge.net/rmx ... haracters

One I think fits nicely is Indiana Jones (with/without his whip)

Notes:
1) Make sure to convert the character image to a .bmp file and edit Line 362 to use it.
2) Changing Line 78 will disable the RPG Character (program won't look for it).
3) If you change Lines 78-80 you can create different size mazes.
4) you can change the look of the ball on Line 74 by changing the hex code for the character.
5) The program looks at your current desktop resolution and checks to make sure your maze fits within it.
Choosing an lower screen size will provide the maze in a window.
Using your exact desktop will create a maze in a full screen window.
Any maze larger than you desktop and program will just exit.

6) Program runs continuously until you hit the ESC key.


Final note: Just for added fun I added in bread crumbs where the character will leave a path behind showing how she went to get to the exit.

This is just a simple maze program inspired from the following videos:

https://www.youtube.com/watch?v=Y37-gB83HKE

and

https://www.youtube.com/watch?v=HyK_Q5rrcr4

The Coding Train is in 4 parts.

Code: Select all

WindowTitle "Maze Walker"

#Include "fbgfx.bi"

Declare Function NextCell As Integer
Declare Function MazeIndex(xPos As Integer,yPos As Integer) As Integer

Declare Sub CreateMaze
Declare Sub MazeWalker

Declare Sub DrawMaze(CursorFlag As Integer,CursorColor As UInteger)

Randomize Timer

Type NewMaze
	North As Integer
	East As Integer
	South As Integer
	West As Integer
	Visit As Integer

  Rows As Integer
  Cols As Integer

  CellSize As Integer
  MazeLen As Integer

  MazePos As Integer
  CellPos As Integer
  StackPos As Integer

  xDesktop As Integer
  yDesktop As Integer

  xScreen As Integer
  yScreen As Integer
End Type

Dim Shared Maze As NewMaze

Type StackTriple
	First As Integer
  Secnd As Integer
  Third As Integer
End Type

Type NewSprite
  xPos As Integer
  yPos As Integer

  xFrame As Integer
  yFrame As Integer

  xSteps As Integer
  ySteps As Integer

  Image As FB.Image Ptr
End Type

Dim Shared MyGirl As NewSprite

ScreenInfo Maze.xDesktop,Maze.yDesktop

Maze.North=1
Maze.East =2
Maze.South=4
Maze.West =8
Maze.Visit=16

Dim As String tBin
Dim Shared As String MazeCursor(8)

For tiSet As Integer=0 To 7
  tBin=Bin(Val("&H"+Mid("3C7EFFFFFFFF7E3C",2*tiSet+1,2)))
  MazeCursor(tiSet+1)=Right(String(8,48)+tBin,8)
Next

Maze.CellSize=47
Maze.xScreen=800
Maze.yScreen=600

Maze.Cols=Maze.xScreen\(Maze.CellSize+1)
Maze.Rows=Maze.yScreen\(Maze.CellSize+1)

If Maze.xScreen<Maze.xDesktop And Maze.yScreen<Maze.yDesktop Then
  If Maze.Cols*(Maze.CellSize+1)+1>Maze.xScreen Then Maze.xScreen+=1
  If Maze.Rows*(Maze.CellSize+1)+1>Maze.yScreen Then Maze.yScreen+=1
Else
  If Maze.Cols*(Maze.CellSize+1)+1>Maze.xDesktop Then Maze.Cols-=1
  If Maze.Rows*(Maze.CellSize+1)+1>Maze.yDesktop Then Maze.Rows-=1
End If

Maze.MazeLen=Maze.Cols*Maze.Rows
Dim Shared Stack(Maze.MazeLen)  As StackTriple
Dim Shared Crumbs(Maze.MazeLen) As StackTriple

Dim Shared As Integer MazeCells(Maze.MazeLen)

If Maze.xScreen<=Maze.xDesktop And Maze.yScreen<=Maze.yDesktop Then
  If Maze.xScreen<Maze.xDesktop And Maze.yScreen<Maze.yDesktop Then
    ScreenRes Maze.xScreen,Maze.yScreen,32
  End If

  If Maze.xScreen=Maze.xDesktop And Maze.yScreen=Maze.yDesktop Then
    ScreenRes Maze.xScreen,Maze.yScreen,32,,FB.Gfx_FullScreen
  End If

  Line(0,0)-(Maze.xScreen-1,Maze.yScreen-1),RGB(0,0,255),bf

  While InKey<>Chr(27)
    CreateMaze
    If Maze.CellSize=47 Then MazeWalker
  Wend

  If Maze.CellSize=47 Then ImageDestroy MyGirl.Image
End If

Function MazeIndex(xPos As Integer,yPos As Integer) As Integer
Dim As Integer tIndex=(yPos*Maze.Cols+xPos)+1

If xPos<0 or xPos>Maze.Cols-1 Then tIndex=-1
If yPos<0 or yPos>Maze.Rows-1 Then tIndex=-1

If tIndex>0 Then
  If tIndex>(Maze.MazeLen) Then	tIndex=-1
  If MazeCells(tIndex) And Maze.Visit Then tIndex=-1
Else
	tIndex=-1
End If

MazeIndex=tIndex
End Function

Function NextCell As Integer
Dim As Integer tIndex
Dim As String Direction=""

Dim As Integer xPos=(Maze.CellPos-1) Mod Maze.Cols
Dim As Integer yPos=(Maze.CellPos-1)  \  Maze.Cols

Dim As Integer NorthIndex=MazeIndex(xPos,yPos-1)
If NorthIndex>0 Then Direction="N"

Dim As Integer  EastIndex=MazeIndex(xPos+1,yPos)
If EastIndex >0 Then Direction=Direction+"E"

Dim As Integer SouthIndex=MazeIndex(xPos,yPos+1)
If SouthIndex>0 Then Direction=Direction+"S"

Dim As Integer  WestIndex=MazeIndex(xPos-1,yPos)
If WestIndex >0 Then Direction=Direction+"W"

If Direction="" Then
  tIndex=-1
Else
  Direction=Mid(Direction,Int(Len(Direction)*Rnd)+1,1)

  Select Case Direction
	  Case "N"
      tIndex=NorthIndex
      MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.North
      MazeCells(NorthIndex)=MazeCells(NorthIndex) Xor Maze.South

	  Case "E"
      tIndex=EastIndex
      MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.East
      MazeCells(EastIndex)=MazeCells(EastIndex) Xor Maze.West

	  Case "S"
      tIndex=SouthIndex
      MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.South
      MazeCells(SouthIndex)=MazeCells(SouthIndex) Xor Maze.North

	  Case "W"
      tIndex=WestIndex
      MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.West
      MazeCells(WestIndex)=MazeCells(WestIndex) Xor Maze.East
  End Select
End If

NextCell=tIndex
End Function

Function NextRoom As Integer
Dim As String Direction
Dim As Integer tIndex,xPos,yPos
Dim As Integer NorthExit,EastExit,SouthExit,WestExit

tIndex=-1
MyGirl.yFrame=0

xPos=(Maze.CellPos-1) Mod Maze.Cols
yPos=(Maze.CellPos-1)  \  Maze.Cols

' Notes:
' Changing this order changes how the girl will solve the maze
' This order makes her always try to go south and east towards the exit

NorthExit=MazeIndex(xPos,yPos-1)
If NorthExit>0 And (MazeCells(Maze.CellPos) And Maze.North)=0 Then
	Direction="N"
	tIndex=NorthExit

	MyGirl.xSteps=0
	MyGirl.ySteps=-1
	MyGirl.yFrame=Maze.North
End If

SouthExit=MazeIndex(xPos,yPos+1)
If SouthExit>0 And (MazeCells(Maze.CellPos) And Maze.South)=0 Then
	Direction=Direction+"S"
	tIndex=SouthExit

	MyGirl.xSteps=0
	MyGirl.ySteps=1
	MyGirl.yFrame=Maze.South
End If

WestExit=MazeIndex(xPos-1,yPos)
If WestExit >0 And (MazeCells(Maze.CellPos) And Maze.West)=0 Then
	Direction=Direction+"W"
	tIndex=WestExit

	MyGirl.ySteps=0
	MyGirl.xSteps=-1
	MyGirl.yFrame=Maze.West
End If

EastExit=MazeIndex(xPos+1,yPos)
If EastExit >0 And (MazeCells(Maze.CellPos) And Maze.East)=0 Then
	Direction=Direction+"E"
	tIndex=EastExit

	MyGirl.ySteps=0
	MyGirl.xSteps=1
	MyGirl.yFrame=Maze.East
End If

NextRoom=tIndex
End Function

Sub CreateMaze
Dim As UInteger CursorColor
Dim As String tBin,MazeCursor(8)

For SetMaze As Integer=1 To Maze.MazeLen
	MazeCells(SetMaze)=15

	Stack(SetMaze).First=-1
	Stack(SetMaze).Secnd=-1
Next

Maze.CellPos=1
MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.West
MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.Visit

MazeCells(Maze.MazeLen)=MazeCells(Maze.MazeLen) Xor Maze.East

Maze.StackPos=1
Stack(Maze.StackPos).First=Maze.CellPos

Maze.MazePos=0
While Maze.MazePos<>Maze.MazeLen-1
  Dim As Integer tIndex=NextCell

  If tIndex>0 Then
    CursorColor=RGB(0,255,0)

    Maze.CellPos=tIndex
    MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.Visit

    Maze.StackPos+=1
    Stack(Maze.StackPos).First=Maze.CellPos

    Maze.MazePos+=1
  Else
    CursorColor=RGB(255,0,0)

    Maze.StackPos-=1
    If Maze.StackPos<0 Then	Exit Sub

    Maze.CellPos=Stack(Maze.StackPos).First
  End If

  DrawMaze 1,CursorColor

  Sleep 10
  If InKey=Chr(27) Then End
Wend
End Sub

Sub DrawMaze(CursorFlag As Integer,CursorColor As UInteger)
ScreenLock

  Dim As Integer x1=0
  Dim As Integer y1=0

  Dim As Integer w =Maze.CellSize+1
  Dim As Integer x2=Maze.Cols*w+1
  Dim As Integer y2=Maze.Rows*w+1

  Line(0,0)-(x2,y2),RGB(0,0,255),bf

  For Show As Integer=1 To Maze.MazeLen
    x1=w*((Show-1) Mod Maze.Cols)
    y1=w*((Show-1)  \  Maze.Cols)

    If MazeCells(Show) And Maze.North Then Line (x1,y1)  -(x1+w,y1),RGB(255,215,0)
    If MazeCells(Show) And Maze.East  Then Line (x1+w,y1)-(x1+w,y1+w),RGB(255,215,0)
    If MazeCells(Show) And Maze.South Then Line (x1,y1+w)-(x1+w,y1+w),RGB(255,215,0)
    If MazeCells(Show) And Maze.West  Then Line (x1,y1)  -(x1,y1+w),RGB(255,215,0)
  Next

  If CursorFlag=1 Then
    Dim As Integer CursorSize=Maze.CellSize\8

    Dim As Integer xPos=w*((Maze.CellPos-1) Mod Maze.Cols)+1
    Dim As Integer yPos=w*((Maze.CellPos-1)  \  Maze.Cols)+1

    For y As Integer=0 To 7
      y1=CursorSize*y
      y2=y1+(CursorSize-1)

      For x As Integer=0 To 7
        x1=CursorSize*x
        x2=x1+(CursorSize-1)

        If Mid(MazeCursor(y+1),x+1,1)="1" Then
          Line(x1+xPos,y1+yPos)-(x2+xPos,y2+yPos),CursorColor,bf
        End If
      Next
    Next
  Else
    For x As Integer=1 To Maze.MazePos
    	x1=Crumbs(x).First-5
    	y1=Crumbs(x).Secnd+3

      If Crumbs(x).Third And Maze.Visit Then
        Line(x1,y1)-(x1+42,y1+42),RGB(160,82,45),bf
      Else
        Line(x1,y1)-(x1+42,y1+42),RGB(0,0,255),bf
      End If
    Next

    If MyGirl.yFrame And Maze.North Then y2=144
    If MyGirl.yFrame And Maze.East  Then y2=96
    If MyGirl.yFrame And Maze.South Then y2=0
    If MyGirl.yFrame And Maze.West  Then y2=48

    x2=32*MyGirl.xFrame
    Put(MyGirl.xPos,MyGirl.yPos),MyGirl.Image,(x2,y2)-(x2+31,y2+47),Trans
  End If

ScreenUnLock
End Sub

Sub MazeWalker
Dim As Integer tIndex
Dim As ULong TrackColor=RGB(0,0,255)

MyGirl.Image=ImageCreate(128,192)
BLoad "MazeGirl.bmp",MyGirl.Image

MyGirl.xPos=9
MyGirl.yPos=1
MyGirl.xFrame=0
MyGirl.yFrame=Maze.South
DrawMaze 0,0

For tIndex=1 To Maze.MazeLen
  MazeCells(tIndex)=MazeCells(tIndex) Xor Maze.Visit
Next

Maze.CellPos=1
MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.Visit

Maze.StackPos=0
Stack(Maze.StackPos).First=Maze.CellPos

Maze.MazePos=1
While Maze.CellPos<>Maze.MazeLen
	tIndex=NextRoom

  If tIndex>0 Then
    Maze.CellPos=tIndex
    MazeCells(Maze.CellPos)=MazeCells(Maze.CellPos) Xor Maze.Visit

    Maze.StackPos+=1
    Stack(Maze.StackPos).First=Maze.CellPos
    Stack(Maze.StackPos).Secnd=MyGirl.yFrame
    
    Maze.MazePos+=1
    Crumbs(Maze.MazePos).First=MyGirl.xPos
    Crumbs(Maze.MazePos).Secnd=MyGirl.yPos
    Crumbs(Maze.MazePos).Third=Maze.Visit
  Else
    tIndex=Stack(Maze.StackPos).Secnd

    Crumbs(Maze.MazePos).Third=0
    Maze.MazePos-=1

    If tIndex=Maze.North Then
      MyGirl.xSteps=0
    	MyGirl.ySteps=1
    	MyGirl.yFrame=Maze.South
    End If

    If tIndex=Maze.East Then
      MyGirl.ySteps=0
    	MyGirl.xSteps=-1
    	MyGirl.yFrame=Maze.West
    End If

    If tIndex=Maze.South Then
      MyGirl.xSteps=0
    	MyGirl.ySteps=-1
    	MyGirl.yFrame=Maze.North
    End If

    If tIndex=Maze.West Then
      MyGirl.ySteps=0
    	MyGirl.xSteps=1
    	MyGirl.yFrame=Maze.East
    End If

    Maze.StackPos-=1
    If Maze.StackPos<0 Then	Exit Sub

    Maze.CellPos=Stack(Maze.StackPos).First
  End If

  For tSteps As Integer=0 To 11
    MyGirl.xFrame=Val(Mid("00011122233",tSteps+1,1))

    MyGirl.xPos+=4*MyGirl.xSteps
    If MyGirl.xPos<0 or MyGirl.xPos>Maze.xScreen Then Exit Sub

    MyGirl.yPos+=4*MyGirl.ySteps
    If MyGirl.yPos<0 or MyGirl.yPos>Maze.yScreen Then Exit Sub

    DrawMaze 0,0
    Sleep 16
    
    If InKey=Chr(27) Then
    	ImageDestroy MyGirl.Image
    	End
    End If
  Next
Wend

MyGirl.xFrame=0
MyGirl.yFrame=Maze.South
DrawMaze 0,0
Sleep 1000
End Sub
Top
sero
Posts: 59
Joined: Mar 06, 2018 13:26
Location: USA

Re: Maze Walker

Post by sero »

Nice demonstration. If Indiana Jones is your thing, you should code in a rolling stone chasing after the character. Really make the code sweat!
Top
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Maze Walker

Post by badidea »

Nicely done, I did not save my 'German girl' RPG character with the right transparency, but it did work.
Last year, I also played with mazes, see: The spooky recursive backtracker.
Top
NorbyDroid
Posts: 70
Joined: May 21, 2016 22:55

Re: Maze Walker

Post by NorbyDroid »

sero wrote:Nice demonstration. If Indiana Jones is your thing, you should code in a rolling stone chasing after the character. Really make the code sweat!
I didn't think of that, but as fun as that would be he needs a direct route to the exit first. When he has to backtrack he will end up flat, unless it is a slow ball that is always a step or two behind him at all times. I may look into that as an added animation.

badidea wrote:Nicely done, I did not save my 'German girl' RPG character with the right transparency, but it did work.
Last year, I also played with mazes, see: The spooky recursive backtracker.
My original character was the Greek girl (as in Greek Maze) but then I just had to change to the Indiana Jones because he is just so cool! Yeah huge fan of Character and actor. Whnat I do is load the .png image into mspaint, change the background color to the transparency color and check all areas to make sure no little places were not made trnsparent that needs it, and then save image as a .png file. One of these days I will look into how to load a png file directly, but for now this works great.

Thank you all for your comments.
Top
Post Reply

Return to “Projects”