The spooky recursive backtracker

[Quark]

.
Update Jan 10, 2016 Modified the code in three routines as suggested by Roland Chastain.

Update Jan 8, 2016 Slight re-write to allow automatic re-run after 7 seconds, for those who enjoy seeing the recursive backtracker in action repeatedly. Also small alterations in rates of change.

Update: Jan 5, 2016 I added a recursive backtracker maze-solver to the program.

I don't know if you have had the same feeling I've had about recursion -- that it's a bit weird, even un-nerving, to watch a computer process nose around like a living thing -- and one that does not make a mistake either! Of course not all recursive processes have this effect, for example, the standard example of recursion that does factorials is not very thrilling.

But one example illustrates the foray into the strange: the recursive backtracker which many have seen in solving the 8 Queens problem.

The code I'm posting shows another example of the recursive backtracker in action -- it generates mazes by moving forward carving openings (shown by a green dot), then backtracking when it has to (shown with a red dot), then forward again, and so on, until the maze is complete. Have a look.

--Quark

Code: Select all

'=======================================================================
'Maze_Generator04_1.bas by Quark - 2016.01.10
'FreeBASIC Compiler - Ver 1.04.0 (10-01-2015), built for linux-x86_64 (64bit)
'Purpose: Recursive Backtracker maze-generating algorithm
'Added recursive backtracking solver/verifier
'Added automatic re-run and other (small) changes.
'Added improved code suggested by Roland Chastain
'==============================================================================
#LANG "fb"
#INCLUDE "fbgfx.bi"
USING fb
ENUM compass
  NORTH = 1
  WEST = 2
  EAST = 4
  SOUTH = 8
  VISITED=16
END ENUM
DECLARE SUB RemoveWall(row AS INTEGER, col AS INTEGER, d AS compass)
DECLARE FUNCTION RndRange(lo AS INTEGER,hi AS INTEGER) AS INTEGER
DECLARE SUB DrawGrid(rows AS INTEGER, cols AS INTEGER, clr AS UINTEGER)
DECLARE SUB RecursiveBacktrack(row AS INTEGER, col AS INTEGER)
DECLARE SUB RBSolver(row AS INTEGER, col AS INTEGER)
DECLARE SUB LocateCell(row AS INTEGER, col AS INTEGER, BYREF x AS INTEGER, BYREF y AS INTEGER)
DECLARE SUB Blink(row AS INTEGER, col AS INTEGER, clr AS UINTEGER, switch AS INTEGER = 0)
DECLARE FUNCTION NewCells(row AS INTEGER, col AS INTEGER) AS STRING
DECLARE FUNCTION OpenCells(row AS INTEGER, col AS INTEGER) AS STRING
DECLARE FUNCTION InRowBounds(row AS INTEGER) AS INTEGER
DECLARE FUNCTION InColBounds(row AS INTEGER) AS INTEGER
'=============================================================================
'set up screen
SCREENRES 640,480,32
'==============================================================================
'DEFINES
CONST AS UINTEGER BLACK = RGB(&H00,&H00,&H00), WHITE = RGB(&HFF,&HFF,&HFF)
CONST AS UINTEGER GREEN = RGB(&H60,&HFF,&H60), RED = RGB(&HFF0,&H60,&H60)
CONST AS UINTEGER YELLOW = RGB(&HD0,&HD0,&H00), BLUE = RGB(&H70,&H70,&HF0)
CONST w = 640, h = 480, centx = w\2, centy = h\2, cellsize = 16
CONST numcols = 37, numrows = 27 '999 cells
'CONST numcols = 15, numrows = 11 '165 cells
'CONST numcols = 45, numrows = 31 '1395 cells
DIM SHARED AS INTEGER solved
DIM SHARED AS UBYTE c(1 TO numrows,1 TO numcols)
RANDOMIZE TIMER
COLOR WHITE, BLACK

DO
  CLS
  ERASE(c)
  solved = 0
  DrawGrid(numrows,numcols, WHITE)

  'RECURSIVE BACKTRACKER MAZE-GENERATING ALGORITHM
  '1) Choose a random cell as a starting point.
  '2) Choose an adjacent non-visited cell and carve a path to it. This is now
  '   the current cell.
  '3) If all adjacent cells have been visited, return back to the previous cell
  '   and check for non-visited cells.
  '4) Once you are back at your starting cell, the algorithm terminates.

  c(1,1) = 1
  RemoveWall(1,1,NORTH)
  RecursiveBacktrack(1,1) 'start at cell 1,1
  PRINT "Maze done!" :SLEEP 2000
  LOCATE 1,1 : PRINT "Solving..."
  Blink(1,1,BLUE,1)
  LOCATE 1,1
  RBSolver(1,1)  'start at cell 1,1
  SLEEP 7000
LOOP
'==============================================================================
SUB RecursiveBacktrack(row AS INTEGER ,col AS INTEGER)
  IF row = numrows AND col = numcols THEN RemoveWall(row,col,SOUTH)
  DIM AS STRING curdirect, directions
  SLEEP 5
  DO
    IF LEN(INKEY) THEN END
    directions = NewCells(row,col)
    IF directions = "" THEN Blink(row, col,RED) : RETURN
    curdirect = MID(directions,RndRange(1,LEN(directions)),1)
    IF curdirect = "N" THEN
      RemoveWall(row,col,NORTH)
      c(row,col) OR= NORTH
      c(row-1,col) OR= SOUTH
      Blink(row-1,col,GREEN)
      RecursiveBacktrack(row-1,col)
    END IF
    IF curdirect = "W" THEN
      RemoveWall(row,col,WEST)
      c(row,col) OR= WEST
      c(row,col-1) OR= EAST
      Blink(row,col-1,GREEN)
      RecursiveBacktrack(row,col-1)
    END IF
    IF curdirect = "E" THEN
      RemoveWall(row,col,EAST)
      c(row,col) OR= EAST
      c(row,col+1) OR= WEST
      Blink(row,col+1,GREEN)
      RecursiveBacktrack(row,col+1)
    END IF
    IF curdirect = "S" THEN
      RemoveWall(row,col,SOUTH)
      c(row,col) OR= SOUTH
      c(row+1,col) OR= NORTH
      Blink(row+1,col,GREEN)
      RecursiveBacktrack(row+1,col)
    END IF
  LOOP
  RETURN
END SUB
'==============================================================================
SUB RBSolver(row AS INTEGER, col AS INTEGER)
  IF row = numrows AND col = numcols THEN
    PRINT "Maze solved"
    Blink(row,col,BLUE,1)
    Blink(1,1,BLUE,1)
    solved = -1
  END IF
  IF solved THEN RETURN
  DIM AS STRING curdirect, directions
  SLEEP 15
  DO
    IF LEN(INKEY) THEN END
    directions = OpenCells(row,col)
    IF directions = "" THEN Blink(row,col,BLACK,1) : SLEEP 30 : RETURN
    curdirect = MID(directions,RndRange(1,LEN(directions)),1)
    IF curdirect = "N" THEN
      c(row-1,col) OR= VISITED
      Blink(row-1,col,BLUE,1)
      RBSolver(row-1,col)
    END IF
    IF solved THEN RETURN
    IF curdirect = "W" THEN
      c(row,col-1) OR= VISITED
      Blink(row,col-1,BLUE,1)
      RBSolver(row,col-1)
    END IF
    IF solved THEN RETURN
    IF curdirect = "E" THEN
      c(row,col+1) OR= VISITED
      Blink(row,col+1,BLUE,1)
      RBSolver(row,col+1)
    END IF
    IF solved THEN RETURN
    IF curdirect = "S" THEN
      c(row+1,col) OR= VISITED
      Blink(row+1,col,BLUE,1)
      RBSolver(row+1,col)
    END IF
    IF solved THEN RETURN
  LOOP
  RETURN
END SUB
'==============================================================================
FUNCTION NewCells(row AS INTEGER, col AS INTEGER) AS STRING
  DIM AS STRING s
  IF InRowbounds(row-1) ANDALSO c(row-1,col) = 0 THEN s &= "N"
  IF InRowbounds(row+1) ANDALSO c(row+1,col) = 0 THEN s &= "S"
  IF InColBounds(col-1) ANDALSO c(row,col-1) = 0 THEN s &= "W"
  IF InColBounds(col+1) ANDALSO c(row,col+1) = 0 THEN s &= "E"
  RETURN s
END FUNCTION
'==============================================================================
FUNCTION OpenCells(row AS INTEGER, col AS INTEGER) AS STRING
  DIM AS INTEGER m0,m1,m2
  DIM AS STRING s
  IF InRowbounds(row+1) THEN
    m0 = c(row+1,col) AND VISITED
    IF m0 <> VISITED THEN
      m1 = c(row,col) AND SOUTH : m2 = c(row+1,col) AND NORTH
      IF m1 = SOUTH AND m2 = NORTH THEN s &= "S"
    END IF
  END IF
  IF InColBounds(col-1) THEN
    m0 = c(row,col-1) AND VISITED
    IF m0 <> VISITED THEN
      m1 = c(row,col) AND WEST : m2 = c(row,col-1) AND EAST
      IF m1 = WEST AND m2 = EAST THEN s &= "W"
    END IF
  END IF
  IF InRowbounds(row-1) THEN
    m0 = c(row-1,col) AND VISITED
    IF m0 <> VISITED THEN
      m1 = c(row,col) AND NORTH : m2 = c(row-1,col) AND SOUTH
      IF m1 = NORTH AND m2 = SOUTH THEN s &= "N"
    END IF
  END IF
  IF InColBounds(col+1) THEN
    m0 = c(row,col+1) AND VISITED
    IF m0 <> VISITED THEN
      m1 = c(row,col) AND EAST : m2 = c(row,col+1) AND WEST
      IF m1 = EAST AND m2 = WEST THEN s &= "E"
    END IF
  END IF
  RETURN s
END FUNCTION
'==============================================================================
SUB LocateCell(row AS INTEGER, col AS INTEGER, BYREF x AS INTEGER, BYREF y AS INTEGER)
  DIM AS INTEGER offx = (w-(cellsize*numcols))\2, offy = (h-(cellsize*numrows))\2
  x = offx + cellsize * (col-1)
  y = offy + cellsize * (row-1)
END SUB
'==============================================================================
SUB RemoveWall(row AS INTEGER, col AS INTEGER, d AS compass)
  DIM AS INTEGER x,y
  LocateCell(row,col,x,y)
  IF d = NORTH THEN
    LINE(x,y)-(x+cellsize-1,y),BLACK
  ELSEIF d = SOUTH THEN
    LINE(x,y+cellsize)-(x+cellsize,y+cellsize),BLACK
  ELSEIF d = WEST THEN
    LINE(x,y+1)-(x,y+cellsize-1),BLACK
  ELSEIF d = EAST THEN
    LINE(x+cellsize,y+1)-(x+cellsize,y+cellsize-1),BLACK
  END IF
END SUB
'==============================================================================
SUB Blink(row AS INTEGER, col AS INTEGER, clr AS UINTEGER, switch AS INTEGER = 0)
  DIM AS INTEGER x, y
  LocateCell(row,col,x,y)
  x += cellsize\2 : y += cellsize\2
  CIRCLE(x,y),3,clr,,,,F
  IF switch = 0 THEN
    SLEEP 25
    CIRCLE(x,y),3,BLACK,,,,F
  END IF
END SUB
'==============================================================================
FUNCTION InRowBounds(row AS INTEGER) AS INTEGER
  IF row >= 1 AND row <= numrows THEN RETURN -1
  RETURN 0
END FUNCTION
'==============================================================================
FUNCTION InColBounds(col AS INTEGER) AS INTEGER
  RETURN col >= 1 AND col <= numcols
END FUNCTION
'==============================================================================
SUB DrawGrid(rows AS INTEGER, cols AS INTEGER, clr AS UINTEGER)
  DIM AS INTEGER offx = (w-(cellsize*numcols))\2, offy = (h-(cellsize*numrows))\2
  FOR row AS INTEGER = 1 TO rows + 1
    LINE(offx,offy + cellsize*(row-1))-(offx + cellsize*cols,offy + cellsize*(row-1)),GREEN
  NEXT
  FOR col AS INTEGER = 1 TO cols + 1
    LINE(offx + cellsize*(col-1),offy)-(offx + cellsize*(col-1),offy + cellsize*rows),GREEN
  NEXT
END SUB
'==============================================================================
FUNCTION RndRange(lo AS INTEGER,hi AS INTEGER) AS INTEGER
  'E.g. lo of 5, hi of 10 returns a num in range: 5, 6, 7, 8, 9, 10
  RETURN INT(RND * (hi-lo+1) +lo)
END FUNCTION
'==============================================================================


.

[BasicCoder2]

Quark,
Neat.
Is it your original algorithm?
.

[Quark]

.
BasicCoder2,

No, not my original work. Got the idea from this site:
http://www.astrolog.org/labyrnth/algrithm.htm

If you look at my code, you'll see I copied the all-too brief algorithm in text form to my program. Then thought about it and tried stuff till it worked and emphasized the backtracking.

--Quark
.

[Quark]

.
I added another example of the recursive backtracker to the program. This one solves the maze no matter how twisty the little passages.

Jan 8, 2016 Added an automatic re-run capability after a 7-second delay, plus other small changes

--Quark
.

[Roland Chastain]

Hello Quark! Nice program.

Two or three little improvements came to my mind while I was reading your code. One could write the NewCells() function like this:

Code: Select all

FUNCTION NewCells(row AS INTEGER, col AS INTEGER) AS STRING
  DIM AS STRING s
  IF InRowbounds(row-1) ANDALSO c(row-1,col) = 0 THEN s &= "N"
  IF InRowbounds(row+1) ANDALSO c(row+1,col) = 0 THEN s &= "S"
  IF InColBounds(col-1) ANDALSO c(row,col-1) = 0 THEN s &= "W"
  IF InColBounds(col+1) ANDALSO c(row,col+1) = 0 THEN s &= "E"
  RETURN s
END FUNCTION

And one could write the InColBounds() and InRowBounds() functions like this:

Code: Select all

FUNCTION InRowBounds(row AS INTEGER) AS INTEGER
  RETURN row >= 1 AND row <= numrows
END FUNCTION

FUNCTION InColBounds(col AS INTEGER) AS INTEGER
  RETURN col >= 1 AND col <= numcols
END FUNCTION

[Quark]

.
Roland,

Thanks for the suggestions. I modified the code accordingly, and posted it. The logic is the same, and your code is just as clear, but also simpler.

--Quark
.

[badidea]

Building mazes is fun. My version of the recursive back-tracker:

Code: Select all

/' https://stackoverflow.com/questions/8820993/recursive-backtracker-maze-generation-algorithm-stack-loop

1. Make the initial cell the current cell and mark it as visited
2. While there are unvisited cells
    1. If the current cell has any neighbours which have not been visited
        1. Choose randomly one of the unvisited neighbours
        2. Push the chosen cell to the stack
        3. Remove the wall between the current cell and the chosen cell
        4. Make the chosen cell the current cell and mark it as visited
    2. Else
        1. Pop a cell from the stack
        2.Make it the current cell
'/

const as ulong C_RED = rgb(250, 0, 0)
const as ulong C_PINK = rgb(250, 190, 200)
const as ulong C_BLACK = rgb(0, 0, 0)
const as ulong C_WHITE = rgb(250, 250, 250)

'-------------------------------------------------------------------------------

type maze_type
   const as byte CELL_INI = 0, CELL_VIS = 1 'initial & visited
   const as byte WALL_YES = 0, WALL_NO = 1
   const as integer LE = 0, RI = 1, DN = 2, UP = 3
   dim as integer w, h 'width & height
   dim as byte cell(any, any)
   dim as byte vWall(any, any)
   dim as byte hWall(any, any)
   declare constructor(w_ as integer, h_ as integer)
   declare destructor()
   declare sub getRndPos(byref x as integer, byref y as integer)
   declare sub generate(x as integer, y as integer)
   declare sub draw_(gridSize as integer)
end type

constructor maze_type(w_ as integer, h_ as integer)
   w = w_ : h = h_
   redim as byte cell(w - 1, h - 1)
   redim as byte vWall(w, h - 1)
   redim as byte hWall(w - 1, h)
end constructor

destructor maze_type()
   w = 0 : h = 0
   erase cell, vWall, hWall
end destructor

sub maze_type.getRndPos(byref x as integer, byref y as integer)
   x = int(rnd * w)
   y = int(rnd * h)
end sub

sub maze_type.generate(x as integer, y as integer)
   cell(x, y) = CELL_VIS
   dim as integer numNb, dirNb(0 to 3)
   do
      numNb = 0
      'check neighbours
      if x > 0 then if cell(x - 1, y) = CELL_INI then dirNb(numNb) = LE : numNb += 1
      if y > 0 then if cell(x, y - 1) = CELL_INI then dirNb(numNb) = UP : numNb += 1
      if x < w - 1 then if cell(x + 1, y) = CELL_INI then dirNb(numNb) = RI : numNb += 1
      if y < h - 1 then if cell(x, y + 1) = CELL_INI then dirNb(numNb) = DN : numNb += 1
      if numNb > 0 then
         'choose an unvisited neighbour
         dim as integer iNb = dirNb(int(rnd * numNb))
         select case iNb
         case LE: vWall(x, y) = WALL_NO : generate(x - 1, y)
         case UP: hWall(x, y) = WALL_NO : generate(x, y - 1)
         case RI: vWall(x + 1, y) = WALL_NO : generate(x + 1, y)
         case DN: hWall(x, y + 1) = WALL_NO : generate(x, y + 1)
         end select
      end if
   loop while numNb > 0
end sub

sub maze_type.draw_(gridSize as integer)
   dim as ulong c
   dim as integer xi, yi
   'draw cells
   for xi = 0 to w - 1 : for yi = 0 to h - 1
      c = iif(cell(xi, yi) = CELL_VIS, C_PINK, C_PINK)
      line(11 + xi * gridSize, 11 + yi * gridSize)-step(gridSize - 3, gridSize - 3), c, bf
   next : next
   'draw vertical walls
   for xi = 0 to w : for yi = 0 to h - 1
      c = iif(vWall(xi, yi) = WALL_YES, C_BLACK, C_PINK)
      line(9 + xi * gridSize, 11 + yi * gridSize)-step(1, gridSize - 3), c, bf
   next : next
   'draw horizontal walls
   for xi = 0 to w - 1: for yi = 0 to h
      c = iif(hWall(xi, yi) = WALL_YES, C_BLACK, C_PINK)
      line(11 + xi * gridSize, 9 + yi * gridSize)-step(gridSize - 3, 1), c, bf
   next : next
end sub

'-------------------------------------------------------------------------------

const SW = 920, SH = 620
screenres SW, SH, 32
width SW \ 8, SH \ 16
line(0, 0)-(SW - 1, SH - 1), C_WHITE, bf

const MW = 30, MH = 20
dim as maze_type maze = maze_type(MW, MH)

dim as integer x, y
randomize timer
maze.getRndPos(x, y)
maze.generate(x, y)
'make maze enrty & exit
maze.vWall(0, 0) = maze.WALL_NO
maze.vWall(MW, MH - 1) = maze.WALL_NO
maze.draw_(30)
getkey()


Preview:


And a nice presentation on maze generators: http://www.jamisbuck.org/presentations/ ... index.html (maze stuff starts at slide 15)

[badidea]

And a version without dedicated wall arrays.

Code: Select all

'version without walls

const as ulong C_BLACK = rgb(0, 0, 0)
const as ulong C_WHITE = rgb(250, 250, 250)
const as ulong C_GREEN = rgb(0, 150, 0)
const as ulong C_GREY = rgb(50, 50, 50)

'-------------------------------------------------------------------------------

type maze_type
   const as byte CELL_INI = 0, CELL_VIS = 1 'initial & visited
   const as integer LE = 0, RI = 1, DN = 2, UP = 3
   dim as integer wMaze, hMaze
   dim as integer wCell, hCell
   dim as byte cell(any, any)
   declare constructor(w_ as integer, h_ as integer)
   declare destructor()
   declare sub getRndPos(byref x as integer, byref y as integer)
   declare sub generate(x as integer, y as integer)
   declare sub draw_(gridSize as integer)
end type

constructor maze_type(w as integer, h as integer)
   wMaze = w : hMaze = h
   'add cells for walls
   wCell = wMaze * 2 + 1
   hCell = hMaze * 2 + 1
   redim as byte cell(wCell - 1, hCell - 1)
end constructor

destructor maze_type()
   wMaze = 0 : hMaze = 0
   wCell = 0 : hCell = 0
   erase cell
end destructor

sub maze_type.getRndPos(byref x as integer, byref y as integer)
   'returns cell position
   x = int(rnd * wMaze) * 2 + 1
   y = int(rnd * hMaze) * 2 + 1
end sub

sub maze_type.generate(x as integer, y as integer)
   cell(x, y) = CELL_VIS
   dim as integer numNb, dirNb(0 to 3)
   do
      numNb = 0
      'check neighbours
      if x > 2 then if cell(x - 2, y) = CELL_INI then dirNb(numNb) = LE : numNb += 1
      if y > 2 then if cell(x, y - 2) = CELL_INI then dirNb(numNb) = UP : numNb += 1
      if x < wCell - 3 then if cell(x + 2, y) = CELL_INI then dirNb(numNb) = RI : numNb += 1
      if y < hCell - 3 then if cell(x, y + 2) = CELL_INI then dirNb(numNb) = DN : numNb += 1
      if numNb > 0 then
         'choose an unvisited neighbour
         dim as integer iNb = dirNb(int(rnd * numNb))
         select case iNb
         case LE: cell(x - 1, y) = CELL_VIS : generate(x - 2, y)
         case UP: cell(x, y - 1) = CELL_VIS : generate(x, y - 2)
         case RI: cell(x + 1, y) = CELL_VIS : generate(x + 2, y)
         case DN: cell(x, y + 1) = CELL_VIS : generate(x, y + 2)
         end select
      end if
   loop while numNb > 0
end sub

sub maze_type.draw_(gridSize as integer)
   dim as ulong c
   for xi as integer = 0 to wCell - 1
      for yi as integer = 0 to hCell - 1
         c = iif(cell(xi, yi) = CELL_VIS, C_GREY, C_GREEN)
         line(11 + xi * gridSize, 11 + yi * gridSize)-step(gridSize - 3, gridSize - 3), c, bf
      next
   next
end sub

'-------------------------------------------------------------------------------

const SW = 950, SH = 650
screenres SW, SH, 32
width SW \ 8, SH \ 16
line(0, 0)-(SW - 1, SH - 1), C_BLACK, bf

const MW = 15, MH = 10
dim as maze_type maze = maze_type(MW, MH)

dim as integer x, y
randomize timer
maze.getRndPos(x, y)
maze.generate(x, y)
'make maze enrty & exit
maze.cell(0, 1) = maze.CELL_VIS
maze.cell(maze.wCell - 1, maze.hCell - 2) = maze.CELL_VIS
maze.draw_(30)
getkey()


Preview:

[badidea]

The 'pacmaze':

Code: Select all

const as ulong C_BLACK = rgb(0, 0, 0)
const as ulong C_WHITE = rgb(250, 250, 250)
const as ulong C_GREEN = rgb(0, 150, 0)
const as ulong C_GREY = rgb(50, 50, 50)
const as ulong C_YELLOW = rgb(250, 250, 0)

const as double PI = 4 * atn(1)

union neighbour_flag
   dim as integer value
   type 'clock-wise
      tl : 1 as integer
      t : 1 as integer 'top
      tr : 1 as integer
      r : 1 as integer 'right
      br : 1 as integer
      b : 1 as integer 'bottom
      bl : 1 as integer
      l : 1 as integer 'left
   end type
end union

'-------------------------------------------------------------------------------

type maze_type
   const as ulong C_WALL = &h1B1CFC 'blue
   const as ulong C_FLOOR = &h000000 'black
   const as ulong C_PATH = &h202020 'dark grey
   const as ulong C_DOT = &hFFB8AE 'salmon
   const as byte CELL_INI = 0, CELL_VIS = 1 'initial & visited
   const as integer LE = 0, RI = 1, DN = 2, UP = 3
   dim as integer size, half 'grid side
   dim as integer wMaze, hMaze
   dim as integer wCell, hCell
   dim as byte cell(any, any)
   dim as integer dy(0 to 7) = {-1, -1, -1,  0, +1, +1, +1,  0}
   dim as integer dx(0 to 7) = {-1,  0, +1, +1, +1,  0, -1, -1}
   declare constructor(w as integer, h as integer, sz as integer)
   declare destructor()
   declare sub getRndPos(byref x as integer, byref y as integer)
   declare sub generate(x as integer, y as integer)
   declare function validPos(x as integer, y as integer) as boolean
   declare function getNbFlags(x as integer, y as integer) as neighbour_flag
   declare sub draw_()
end type

constructor maze_type(w as integer, h as integer, sz as integer)
   wMaze = w : hMaze = h
   size = sz : half = sz \ 2
   'add cells for walls
   wCell = wMaze * 3
   hCell = hMaze * 3
   redim as byte cell(wCell - 1, hCell - 1)
end constructor

destructor maze_type()
   wMaze = 0 : hMaze = 0
   wCell = 0 : hCell = 0
   erase cell
end destructor

sub maze_type.getRndPos(byref x as integer, byref y as integer)
   'returns cell position
   x = int(rnd * wMaze) * 3 + 1
   y = int(rnd * hMaze) * 3 + 1
end sub

sub maze_type.generate(x as integer, y as integer)
   cell(x, y) = CELL_VIS
   dim as integer numNb, dirNb(0 to 3)
   do
      numNb = 0
      'check neighbours
      if x > 3 then if cell(x - 3, y) = CELL_INI then dirNb(numNb) = LE : numNb += 1
      if y > 3 then if cell(x, y - 3) = CELL_INI then dirNb(numNb) = UP : numNb += 1
      if x < wCell - 4 then if cell(x + 3, y) = CELL_INI then dirNb(numNb) = RI : numNb += 1
      if y < hCell - 4 then if cell(x, y + 3) = CELL_INI then dirNb(numNb) = DN : numNb += 1
      if numNb > 0 then
         'choose an unvisited neighbour
         dim as integer iNb = dirNb(int(rnd * numNb))
         select case iNb
         case LE: cell(x - 1, y) = CELL_VIS : cell(x - 2, y) = CELL_VIS : generate(x - 3, y)
         case UP: cell(x, y - 1) = CELL_VIS : cell(x, y - 2) = CELL_VIS : generate(x, y - 3)
         case RI: cell(x + 1, y) = CELL_VIS : cell(x + 2, y) = CELL_VIS : generate(x + 3, y)
         case DN: cell(x, y + 1) = CELL_VIS : cell(x, y + 2) = CELL_VIS : generate(x, y + 3)
         end select
      end if
   loop while numNb > 0
end sub

'check valid cell index
function maze_type.validPos(x as integer, y as integer) as boolean
   if x < 0 or x >= wCell then return false
   if y < 0 or y >= hCell then return false
   return true
end function

function maze_type.getNbFlags(x as integer, y as integer) as neighbour_flag
   dim as neighbour_flag nbFlag
   dim as integer activeBit = 1
   dim as integer xi, yi
   'loop all neigbours
   for i as integer = 0 to 7
      xi = x + dx(i)
      yi = y + dy(i)
      if validPos(xi, yi) andalso cell(xi, yi) = 1 then
         nbFlag.value or= activeBit
      end if
      activeBit shl= 1
   next
   return nbFlag
end function

sub maze_type.draw_()
   dim as ulong c
   dim as neighbour_flag nbFlag
   for xi as integer = 0 to wCell - 1
      for yi as integer = 0 to hCell - 1
         if cell(xi, yi) = CELL_VIS then
            line(xi * size + half - 2, yi * size + half - 2)-step(3, 3), C_DOT, bf
         end if
         if cell(xi, yi) = CELL_INI then 'is wall
            nbFlag = getNbFlags(xi, yi)
            if nbFlag.l = 0 and nbFlag.r = 0 and nbFlag.b = 1 then
               line(xi * size, yi * size + half)-step(size - 1, 0), C_WALL
            end if
            if nbFlag.l = 0 and nbFlag.r = 0 and nbFlag.t = 1 then
               line(xi * size, yi * size + half)-step(size - 1, 0), C_WALL
            end if
            if nbFlag.t = 0 and nbFlag.b = 0 and nbFlag.r = 1 then
               line(xi * size + half, yi * size)-step(0, size - 1), C_WALL
            end if
            if nbFlag.t = 0 and nbFlag.b = 0 and nbFlag.l = 1 then
               line(xi * size + half, yi * size)-step(0, size - 1), C_WALL
            end if
            'outside corners
            if nbFlag.l = 1 and nbFlag.b = 1 then
               circle(xi * size + size, yi * size), half, C_WALL, 1.0 * PI, 1.5 * PI
            end if
            if nbFlag.r = 1 and nbFlag.b = 1 then
               circle(xi * size, yi * size), half, C_WALL, 1.5 * PI, 2.0 * PI
            end if
            if nbFlag.r = 1 and nbFlag.t = 1 then
               circle(xi * size, yi * size + size), half, C_WALL, 0.0 * PI, 0.5 * PI
            end if
            if nbFlag.l = 1 and nbFlag.t = 1 then
               circle(xi * size + size, yi * size + size), half, C_WALL, 0.5 * PI, 1.0 * PI
            end if
            'inside corners
            if nbFlag.tr = 1 and nbFlag.t = 0 and nbFlag.r = 0 then
               circle(xi * size + size, yi * size), half, C_WALL, 1.0 * PI, 1.5 * PI
            end if
            if nbFlag.tl = 1 and nbFlag.t = 0 and nbFlag.l = 0 then
               circle(xi * size, yi * size), half, C_WALL, 1.5 * PI, 2.0 * PI
            end if
            if nbFlag.bl = 1 and nbFlag.b = 0 and nbFlag.l = 0 then
               circle(xi * size, yi * size + size), half, C_WALL, 0.0 * PI, 0.5 * PI
            end if
            if nbFlag.br = 1 and nbFlag.b = 0 and nbFlag.r = 0 then
               circle(xi * size + size, yi * size + size), half, C_WALL, 0.5 * PI, 1.0 * PI
            end if
         end if
      next
   next
end sub

'-------------------------------------------------------------------------------

const SW = 600, SH = 480
screenres SW, SH, 32
width SW \ 8, SH \ 16
line(0, 0)-(SW - 1, SH - 1), C_BLACK, bf

const MW = 10, MH = 8
dim as maze_type maze = maze_type(MW, MH, 20)

dim as integer x, y
randomize timer
maze.getRndPos(x, y)
maze.generate(x, y)
dim as single rPacman = 200
circle (SW \ 2, SH \ 2), rPacman, C_YELLOW, 0.20 * PI, 1.80 * PI, , f
line (SW \ 2 - 25, SH \ 2)-step(25 + cos(0.20 * PI) * rPacman, sin(0.20 * PI) * rPacman), C_YELLOW
line (SW \ 2 - 25, SH \ 2)-step(25 + cos(1.80 * PI) * rPacman, sin(1.80 * PI) * rPacman), C_YELLOW
paint (SW \ 2 - 30, SH \ 2), C_YELLOW, C_YELLOW
maze.draw_()
getkey()


Blue on black hurts the eyes. Did anyone know that Pacman has no eyes? Ms Pacman does have eyes.

[Provoni]

Did anyone know that Pacman has no eyes?

He has one, but it's on the other side.