'===========================================================================
' Subject: GENERATE AND SOLVE MAZES           Date: 04-22-98 (18:39)       
'  Author: D. J. Tuttle                       Code: QB, QBasic, PDS        
'  Origin: Dtuttle25@aol.com                Packet: ALGOR.ABC
'===========================================================================
'MAZE25.BAS for QBasic by D. J. Tuttle

'generate and solve random traditional mazes

'This program generates and solves random traditional mazes.  A traditional
'maze has the property that a unique path exists between any two rooms.
'Therefore the entrance and exit to the maze may be placed anywhere.  There
'are no loops, islands or closed rooms in a traditional maze.

'maze generation algorithm
'from BYTE Magazine, Dec. 1981, pp. 190 - 196

'maze solution algorithm
'from STRUCTURED BASIC AND BEYOND by Wayne Amsbury, (Computer Science Press,
'Inc., 1980), pp. 214 - 217

'suggestions for programmers:
'
' 1. Adjust the size of the mazes produced.  The constant MAXSIZE sets the
'    upper limit for the number of rows and columns.  For each maze a value,
'    ranging between 1 and MAXSIZE, is selected at random for the number of
'    rows; then another value, with the same range, is selected at random
'    for the number of columns.
'    The smallest acceptable maze is 1 row by 1 column (1 room).
'    The effective maximum size for this maze program, as written, is a maze
'    of 100 rows by 100 columns (10,000 rooms).  A maze larger than this may
'    cause an out-of-memory error or exceed the ability of the graphics to
'    distinguish between individual rooms.
'    To produce 10,000 room mazes set MAXSIZE equal to 100 and change the
'    following two statements in the Process subprogram:
'    from: RowSize = INT(RND * MAXSIZE) + 1         to: RowSize = MAXSIZE
'    from: ColSize = INT(RND * MAXSIZE) + 1         to: ColSize = MAXSIZE
'
' 2. Take a closer look at how the program solves the mazes by adding a
'    delay at an appropriate place.  Use a call to the ZSUBDelay subprogram.
'    for example: CALL ZSUBDelay(.2)
'
' 3. REM out (temporarily inactivate) the lines which create the exit to
'    the maze.  These are the last two statements in the ZSUBGenerateMaze
'    subprogram.  The program will then search the entire maze, display a
'    message that "no solution exists" and end.
'
' 4. Test other maze solution methods.  Substitute another algorithm for the
'    one used in the ZSUBSolveMaze subprogram.

'Send comments and questions to this email address: dtuttle25@aol.com

DECLARE SUB Initialization ()
DECLARE SUB Process ()
DECLARE SUB Summary ()
DECLARE FUNCTION ZFUNCTestBoundary% (Row AS INTEGER, Col AS INTEGER)
DECLARE FUNCTION ZFUNCTestWall% (Value AS INTEGER, Dir AS INTEGER)
DECLARE SUB ZSUBAddFrontier (Row AS INTEGER, Col AS INTEGER, Array1() AS INTEGER, Count AS INTEGER, Array2() AS INTEGER)
DECLARE SUB ZSUBAddSpanning (Row AS INTEGER, Col AS INTEGER, Array1() AS INTEGER, Count AS INTEGER, Array2() AS INTEGER)
DECLARE SUB ZSUBCheckEsc ()
DECLARE SUB ZSUBDelay (Value AS SINGLE)
DECLARE SUB ZSUBDrawGrid ()
DECLARE SUB ZSUBDrawMouse (Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER, Hue AS INTEGER)
DECLARE SUB ZSUBEraseWall (Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER)
DECLARE SUB ZSUBGenerateMaze (Array() AS INTEGER)
DECLARE SUB ZSUBSolveMaze (Array() AS INTEGER)
DECLARE SUB ZSUBViewPort ()

CONST FALSE = 0, TRUE = NOT FALSE
CONST VIEWPORTBG = 1, VIEWPORTBORDER = 15
CONST WALLON = 7, MOUSEON = 4, PATHON = 9
CONST MAXSIZE = 48
CONST H$ = "#####, \     \"
CONST STARTDIR = 1

DIM SHARED RowSize AS INTEGER, ColSize AS INTEGER
DIM SHARED StartRow AS INTEGER, StartCol AS INTEGER
DIM SHARED FinishRow AS INTEGER, FinishCol AS INTEGER
DIM SHARED ExitFlag AS INTEGER
DIM SHARED Esc AS STRING * 1

DIM SHARED Index(1 TO 4, 1 TO 4) AS INTEGER

CALL Initialization
CALL Process
CALL Summary

SYSTEM

'END OF MAIN PROGRAM

SUB Initialization STATIC

   RANDOMIZE TIMER
  
   ExitFlag = FALSE
   Esc$ = CHR$(27)

   '1 = north (up), 2 = east (right), 3 = west (left), 4 = south (down)
  
   'binary weight associated with each direction
   Index(1, 1) = 1
   Index(1, 2) = 2
   Index(1, 3) = 4
   Index(1, 4) = 8
  
   'row offset associated with moving forward from each direction
   Index(2, 1) = -1
   Index(2, 2) = 0
   Index(2, 3) = 0
   Index(2, 4) = 1
  
   'col offset associated with moving forward from each direction
   Index(3, 1) = 0
   Index(3, 2) = 1
   Index(3, 3) = -1
   Index(3, 4) = 0
 
   'opposite direction associated with each direction
   Index(4, 1) = 4
   Index(4, 2) = 3
   Index(4, 3) = 2
   Index(4, 4) = 1
  
   SCREEN 12
  
   COLOR 7
   PRINT "MAZE25.BAS"

   LOCATE 3, 1
   PRINT "generate and solve"
   PRINT "random traditional"
   PRINT "mazes"

   LOCATE 8, 1
   PRINT "  x"
   PRINT "  --------"
  
   LOCATE 30, 1
   PRINT "Press <Esc> to exit";

END SUB

SUB Process STATIC
 
   DIM RoomSize AS INTEGER
  
   DO
     
      RowSize = INT(RND * MAXSIZE) + 1
      LOCATE 7, 5
      IF RowSize = 1 THEN PRINT USING H$; RowSize; "row" ELSE PRINT USING H$; RowSize; "rows"
     
      ColSize = INT(RND * MAXSIZE) + 1
      LOCATE 8, 5
      IF ColSize = 1 THEN PRINT USING H$; ColSize; "column" ELSE PRINT USING H$; ColSize; "columns"
     
      RoomSize = RowSize * ColSize
      LOCATE 10, 5
      IF RoomSize = 1 THEN PRINT USING H$; RoomSize; "room" ELSE PRINT USING H$; RoomSize; "rooms"
     
      CALL ZSUBViewPort
      CALL ZSUBDrawGrid
      CALL ZSUBCheckEsc
      IF ExitFlag THEN EXIT DO
     
      REDIM maze(1 TO RowSize + 1, 1 TO ColSize) AS INTEGER
     
      CALL ZSUBGenerateMaze(maze())
      IF ExitFlag THEN EXIT DO
     
      CALL ZSUBSolveMaze(maze())
      IF ExitFlag THEN EXIT DO
     
      CALL ZSUBDelay(1)
      IF ExitFlag THEN EXIT DO
  
   LOOP

END SUB

SUB Summary STATIC

   VIEW

END SUB

FUNCTION ZFUNCTestBoundary% (Row AS INTEGER, Col AS INTEGER) STATIC

   ZFUNCTestBoundary = TRUE

   IF (Row < 1) OR (Row > RowSize) OR (Col < 1) OR (Col > ColSize) THEN ZFUNCTestBoundary = FALSE

END FUNCTION

FUNCTION ZFUNCTestWall% (Value AS INTEGER, Dir AS INTEGER) STATIC
  
   ZFUNCTestWall = FALSE

   IF (Value AND Index(1, Dir)) = 0 THEN ZFUNCTestWall = TRUE

END FUNCTION

SUB ZSUBAddFrontier (Row AS INTEGER, Col AS INTEGER, Array1() AS INTEGER, Count AS INTEGER, Array2() AS INTEGER) STATIC

   DIM I AS INTEGER
   DIM OffsetRow AS INTEGER, OffsetCol AS INTEGER
  
   FOR I = 1 TO 4
      OffsetRow = Row + Index(2, I)
      OffsetCol = Col + Index(3, I)
      IF ZFUNCTestBoundary(OffsetRow, OffsetCol) THEN
         IF Array1(OffsetRow, OffsetCol) = 0 THEN
            Count = Count + 1
            Array2(Count, 1) = OffsetRow
            Array2(Count, 2) = OffsetCol
            Array1(OffsetRow, OffsetCol) = -1
         END IF
      END IF
   NEXT I

END SUB

SUB ZSUBAddSpanning (Row AS INTEGER, Col AS INTEGER, Array1() AS INTEGER, Count AS INTEGER, Array2() AS INTEGER) STATIC

   DIM I AS INTEGER
   DIM OffsetRow AS INTEGER, OffsetCol AS INTEGER
  
   Count = 0
  
   FOR I = 1 TO 4
      OffsetRow = Row + Index(2, I)
      OffsetCol = Col + Index(3, I)
      IF ZFUNCTestBoundary(OffsetRow, OffsetCol) THEN
         IF Array1(OffsetRow, OffsetCol) > 0 THEN
            Count = Count + 1
            Array2(Count) = I
         END IF
      END IF
   NEXT I

END SUB

SUB ZSUBCheckEsc STATIC

   SELECT CASE INKEY$
      CASE Esc$
         ExitFlag = TRUE
      CASE ELSE
         '
   END SELECT

END SUB

SUB ZSUBDelay (Value AS SINGLE) STATIC

   'seconds per day
   CONST SPD = 86400
 
   DIM DelayValue AS SINGLE
   DIM TimeCheck1 AS SINGLE, TimeCheck2 AS SINGLE
 
   DelayValue = Value
 
   TimeCheck1 = TIMER
 
   WHILE DelayValue > 0
     
      DO
         TimeCheck2 = TIMER
      LOOP WHILE TimeCheck1 = TimeCheck2
     
      IF TimeCheck2 > TimeCheck1 THEN
         DelayValue = DelayValue - (TimeCheck2 - TimeCheck1)
      ELSE
         'midnight
         DelayValue = DelayValue - (SPD - TimeCheck1) - TimeCheck2
      END IF
     
      TimeCheck1 = TimeCheck2
     
      CALL ZSUBCheckEsc
      IF ExitFlag THEN EXIT SUB

   WEND

END SUB

SUB ZSUBDrawGrid STATIC
  
   DIM I AS INTEGER

   LINE (1, 1)-(ColSize + 1, RowSize + 1), WALLON, B

   FOR I = 2 TO ColSize
      LINE (I, 1)-(I, RowSize + 1), WALLON
   NEXT I

   FOR I = 2 TO RowSize
      LINE (1, I)-(ColSize + 1, I), WALLON
   NEXT I
   
END SUB

SUB ZSUBDrawMouse (Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER, Hue AS INTEGER) STATIC
 
   DIM Row1 AS INTEGER, Col1 AS INTEGER
   DIM Row2 AS INTEGER, Col2 AS INTEGER

   Row1 = PMAP(Row, 1) + 2
   Col1 = PMAP(Col, 0) + 2
   Row2 = PMAP(Row + 1, 1) - 2
   Col2 = PMAP(Col + 1, 0) - 2
 
   SELECT CASE Dir
      CASE 0
         '
      CASE 1
         Row2 = Row2 + 3
      CASE 2
         Col1 = Col1 - 3
      CASE 3
         Col2 = Col2 + 3
      CASE 4
         Row1 = Row1 - 3
   END SELECT

   LINE (PMAP(Col1, 2), PMAP(Row1, 3))-(PMAP(Col2, 2), PMAP(Row2, 3)), Hue, BF

END SUB

SUB ZSUBEraseWall (Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER) STATIC

   DIM Row1 AS INTEGER, Col1 AS INTEGER
   DIM Row2 AS INTEGER, Col2 AS INTEGER

   SELECT CASE Dir
      CASE 1
         Row1 = PMAP(Row, 1)
         Col1 = PMAP(Col, 0) + 1
         Row2 = PMAP(Row, 1)
         Col2 = PMAP(Col + 1, 0) - 1
      CASE 2
         Row1 = PMAP(Row, 1) + 1
         Col1 = PMAP(Col + 1, 0)
         Row2 = PMAP(Row + 1, 1) - 1
         Col2 = PMAP(Col + 1, 0)
      CASE 3
         Row1 = PMAP(Row, 1) + 1
         Col1 = PMAP(Col, 0)
         Row2 = PMAP(Row + 1, 1) - 1
         Col2 = PMAP(Col, 0)
      CASE 4
         Row1 = PMAP(Row + 1, 1)
         Col1 = PMAP(Col, 0) + 1
         Row2 = PMAP(Row + 1, 1)
         Col2 = PMAP(Col + 1, 0) - 1
   END SELECT

   LINE (PMAP(Col1, 2), PMAP(Row1, 3))-(PMAP(Col2, 2), PMAP(Row2, 3)), VIEWPORTBG

END SUB

SUB ZSUBGenerateMaze (Array() AS INTEGER) STATIC

   DIM FirstRow AS INTEGER, FirstCol AS INTEGER
   DIM Row AS INTEGER, Col AS INTEGER
   DIM FrontierCount AS INTEGER
   DIM SpanningCount AS INTEGER
   DIM RndChoice AS INTEGER
  
   REDIM Frontier(1 TO RowSize * ColSize * 2 / 3, 1 TO 2) AS INTEGER

   FirstRow = INT(RND * RowSize) + 1
   FirstCol = INT(RND * ColSize) + 1
   Array(FirstRow, FirstCol) = 16
   FrontierCount = 0

   CALL ZSUBAddFrontier(FirstRow, FirstCol, Array(), FrontierCount, Frontier())
  
   WHILE FrontierCount > 0

      RndChoice = INT(RND * FrontierCount) + 1
      Row = Frontier(RndChoice, 1)
      Col = Frontier(RndChoice, 2)
      Frontier(RndChoice, 1) = Frontier(FrontierCount, 1)
      Frontier(RndChoice, 2) = Frontier(FrontierCount, 2)
      FrontierCount = FrontierCount - 1
     
      REDIM Spanning(1 TO 4) AS INTEGER
      CALL ZSUBAddSpanning(Row, Col, Array(), SpanningCount, Spanning())
      RndChoice = Spanning(INT(RND * SpanningCount) + 1)
      CALL ZSUBEraseWall(Row, Col, RndChoice)
      Array(Row, Col) = Index(1, RndChoice)
      Array(Row + Index(2, RndChoice), Col + Index(3, RndChoice)) = Array(Row + Index(2, RndChoice), Col + Index(3, RndChoice)) + Index(1, Index(4, RndChoice))

      CALL ZSUBAddFrontier(Row, Col, Array(), FrontierCount, Frontier())
  
      CALL ZSUBCheckEsc
      IF ExitFlag THEN EXIT SUB
  
   WEND

   Array(FirstRow, FirstCol) = Array(FirstRow, FirstCol) - 16
   
   StartRow = RowSize + 1
   StartCol = INT(RND * ColSize) + 1
   CALL ZSUBEraseWall(StartRow, StartCol, STARTDIR)
   Array(StartRow, StartCol) = Index(1, STARTDIR)
   Array(StartRow - 1, StartCol) = Array(StartRow - 1, StartCol) + Index(1, Index(4, STARTDIR))
   
   FinishRow = 0
   FinishCol = INT(RND * ColSize) + 1
   CALL ZSUBEraseWall(FinishRow, FinishCol, Index(4, STARTDIR))
   Array(1, FinishCol) = Array(1, FinishCol) + Index(1, STARTDIR)

END SUB

SUB ZSUBSolveMaze (Array() AS INTEGER) STATIC
  
   DIM I AS INTEGER
   DIM PathCount AS INTEGER
   DIM Flag AS INTEGER
  
   REDIM path(1 TO RowSize * ColSize + 2, 1 TO 2) AS INTEGER

   CALL ZSUBDrawMouse(StartRow, StartCol, 0, MOUSEON)
  
   path(1, 1) = StartRow
   path(1, 2) = StartCol
  
   PathCount = 1

   WHILE NOT ((path(PathCount, 1) = FinishRow) AND (path(PathCount, 2) = FinishCol))
  
      'Flag holds two pieces of information:
      '   sign: negative = backtrack, zero = no move, positive = forward
      '   value: 1 to 4 = direction
      Flag = 0
  
      FOR I = 1 TO 4
         IF NOT ZFUNCTestWall(Array(path(PathCount, 1), path(PathCount, 2)), I) THEN
            Flag = I
            IF PathCount > 1 THEN
               IF (path(PathCount, 1) + Index(2, I) = path(PathCount - 1, 1)) AND (path(PathCount, 2) + Index(3, I) = path(PathCount - 1, 2)) THEN Flag = -Flag
            END IF
            IF Flag > 0 THEN EXIT FOR
         END IF
      NEXT I
  
      SELECT CASE SGN(Flag)
         CASE -1
            CALL ZSUBDrawMouse(path(PathCount, 1), path(PathCount, 2), Index(4, -Flag), VIEWPORTBG)
            Array(path(PathCount, 1), path(PathCount, 2)) = Array(path(PathCount, 1), path(PathCount, 2)) - Index(1, -Flag)
            PathCount = PathCount - 1
            Array(path(PathCount, 1), path(PathCount, 2)) = Array(path(PathCount, 1), path(PathCount, 2)) - Index(1, Index(4, -Flag))
         CASE 0
            BEEP
            LOCATE 12, 1
            PRINT "no solution exists"
            ExitFlag = TRUE
            EXIT SUB
         CASE 1
            PathCount = PathCount + 1
            path(PathCount, 1) = path(PathCount - 1, 1) + Index(2, Flag)
            path(PathCount, 2) = path(PathCount - 1, 2) + Index(3, Flag)
            CALL ZSUBDrawMouse(path(PathCount, 1), path(PathCount, 2), Flag, MOUSEON)
      END SELECT
  
      CALL ZSUBCheckEsc
      IF ExitFlag THEN EXIT SUB
  
   WEND

   'highlight solution
   PAINT (StartCol + .5, StartRow + .5), PATHON, VIEWPORTBG

END SUB

SUB ZSUBViewPort STATIC

   VIEW (161, 1)-(638, 478), VIEWPORTBG, VIEWPORTBORDER

   SELECT CASE RowSize
      CASE IS < ColSize
         WINDOW SCREEN (0, 0 - (ColSize - RowSize) / 2)-(ColSize + 2, ColSize + 2 - (ColSize - RowSize) / 2)
      CASE IS = ColSize
         WINDOW SCREEN (0, 0)-(ColSize + 2, RowSize + 2)
      CASE IS > ColSize
         WINDOW SCREEN (0 - (RowSize - ColSize) / 2, 0)-(RowSize + 2 - (RowSize - ColSize) / 2, RowSize + 2)
   END SELECT

END SUB