'===========================================================================
' Subject: MECHANICAL MOUSE PROBLEM           Date: 02-11-00 (18:16)       
'  Author: D. J. Tuttle                       Code: QB, QBasic, PDS        
'  Origin: Dtuttle25@aol.com                Packet: AI.ABC
'===========================================================================
'MMOUSE25.BAS for QBasic by D. J. Tuttle

'The Mechanical Mouse Problem

'This program demonstrates one solution to the Mechanical Mouse problem
'which is to devise an algorithm to guide a robotic Mouse through a
'set of four mazes.  A single algorithm must work for all four mazes.
'
'The Mechanical Mouse has the following instruction set:
'     Move Forward
'     Turn Right
'     Turn Left
'     Turn Around
'     Wall Ahead?
'     Maze Entrance?
'     Maze Exit?
'     Halt

'Mechanical Mouse problem
'from BASIC FUNDAMENTALS AND STYLE by James Quasney and John Maniotes,
'(Boyd & Fraser Publishing Co., 1984), Appendix A p. A-11, question 17

'The following algorithm -- method of solution -- is demonstrated.
'
'description: "Turn Right, Spin Left" (or "Follow the Right-hand wall.")
'
'flowchart:
'                           /--------------\
'                           |    Start     |
'                           \--------------/
'                                   |
'                                   |
'                           ----------------
'                           | Move Forward |
'                           ----------------
'                                   |
'                ------------------>|
'                |                  -
'                |                /   \
'                |               /     \  Y           /--------------\
'                |              < Exit? > ----------> |     Halt     |
'                |               \     /              \--------------/
'                |                \   /
'                |                  -
'                |                  | N
'                |                  |
'                |          ----------------
'                |          |  Turn Right  |
'                |          ----------------
'                |                  |
'                |                  |<-----------------------
'                |                  -                       |
'                |                /   \                     |
'                |               /     \  Y           ----------------
'                |              < Wall? > ----------> |  Turn Left   |
'                |               \     /              ----------------
'                |                \   /
'                |                  -
'                |                  | N
'                |                  |
'                |          ----------------
'                |          | Move Forward |
'                |          ----------------
'                |                  |
'                --------------------

'suggestions for programmers:
'
' 1. Use the Single Step option to slow the program down in order to see
'    the series of instructions performed by the Mechanical Mouse in detail.
'    When this option is selected each instruction, as it is performed by
'    the Mouse, is highlighted in the list of instructions displayed on the
'    screen and the program is paused until the <Enter> key is pressed.
'    Change the value of the Constant SINGLESTEP from FALSE to TRUE to
'    select this option.
'
' 2. Use the Sound On option to turn on an audible beep when the "Wall
'    Ahead?" instruction detects a wall.  Change the value of the Constant
'    SOUNDON from FALSE to TRUE to select this option.
'
' 3. Modify the algorithm, in the ZSUBSolveMaze subprogram, from "Turn Right,
'    Spin Left" to "Turn Left, Spin Right" so that the Mechanical Mouse
'    follows the Left-hand wall.
'
' 4. Devise your own algorithm, using the Mechanical Mouse instruction set,
'    for solving the set of mazes.  Test the algorithm by replacing the
'    "Turn Right, Spin Left" solution in the ZSUBSolveMaze subprogram
'    with your method of solution.
'
'    The starting position of the Mouse is outside the maze entrance and
'    pointing toward the maze.  Then the instruction Move Forward places
'    the Mouse inside the maze.  The objective is to continue the advance
'    of the Mouse through the maze to the finish (outside the maze exit).

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

DECLARE SUB AInitialization ()
DECLARE SUB AProcess ()
DECLARE SUB ASummary ()

DECLARE SUB Halt ()
DECLARE FUNCTION MazeEntrance% ()
DECLARE FUNCTION MazeExit% ()
DECLARE SUB MoveForward ()
DECLARE SUB TurnAround ()
DECLARE SUB TurnLeft ()
DECLARE SUB TurnRight ()
DECLARE FUNCTION WallAhead% ()

DECLARE SUB ZSUBCreateMouse ()
DECLARE SUB ZSUBDelay (Value AS SINGLE)
DECLARE SUB ZSUBDrawMouse ()
DECLARE SUB ZSUBDrawWall (Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER)
DECLARE SUB ZSUBEraseMouse ()
DECLARE SUB ZSUBReadData ()
DECLARE SUB ZSUBSolveMaze ()
DECLARE SUB ZSUBSSOption (Number AS INTEGER, S AS STRING)
DECLARE SUB ZSUBTransform (X AS SINGLE, Y AS SINGLE)
DECLARE SUB ZSUBUpdateScreen ()

CONST FALSE = 0, TRUE = NOT FALSE
CONST VIEWPORTBG = 1, VIEWPORTBORDER = 7
CONST WALLON = 7, MOUSEON = 2, EYEON = 15
CONST GRAPHICSIZE = 562   'based on formula from QBasic Help file
CONST STARTDIR = 0
CONST DELAY = .25
CONST NOTEFREQ = 440, NOTEDUR = 1
CONST B$ = " ", F$ = "F", T$ = "T"

'Options: TRUE/FALSE
CONST SINGLESTEP = FALSE
CONST SOUNDON = FALSE

DIM SHARED MouseRow AS INTEGER, MouseCol AS INTEGER
DIM SHARED MouseDir AS INTEGER, MousePtr AS INTEGER
DIM SHARED MRowOffset AS INTEGER, MColOffset AS INTEGER
DIM SHARED GRowOffset AS SINGLE, GColOffset AS SINGLE
DIM SHARED EntranceRow AS INTEGER, EntranceCol AS INTEGER
DIM SHARED ExitRow AS INTEGER, ExitCol AS INTEGER
DIM SHARED EscKey AS STRING * 1, EnterKey AS STRING * 1
DIM SHARED Arrow AS STRING * 1

DIM SHARED BinaryWeight(0 TO 3) AS INTEGER
DIM SHARED MoveRowOffset(0 TO 3) AS INTEGER, MoveColOffset(0 TO 3) AS INTEGER
DIM SHARED Maze(1 TO 2, 1 TO 2) AS INTEGER
DIM SHARED BlankGraphic(0 TO GRAPHICSIZE - 1) AS INTEGER
DIM SHARED DirGraphic(0 TO 24 * GRAPHICSIZE - 1) AS INTEGER

TYPE DataSet
   XHead AS SINGLE
   YHead AS SINGLE
   XBody AS SINGLE
   YBody AS SINGLE
   XTail AS SINGLE
   YTail AS SINGLE
   XLtWhisker1 AS SINGLE
   YLtWhisker1 AS SINGLE
   XRtWhisker1 AS SINGLE
   YRtWhisker1 AS SINGLE
   XLtWhisker2 AS SINGLE
   YLtWhisker2 AS SINGLE
   XRtWhisker2 AS SINGLE
   YRtWhisker2 AS SINGLE
   XLtEye AS SINGLE
   YLtEye AS SINGLE
   XRtEye AS SINGLE
   YRtEye AS SINGLE
END TYPE

CALL AInitialization
CALL AProcess
CALL ASummary

SYSTEM

'format of maze data statements:
'maze row offset, maze col offset
'entrance row, entrance col
'exit row, exit col
'wall structure of maze (4 cells; each cell has 4 walls;
'   binary value represents walls: 0 = no wall, 1 = wall
'   where bit 0 = up, bit 1 = right, bit 2 = down, bit 3 = left)

'Maze 1
DATA 0,0
DATA 3,1
DATA 0,1
DATA 12,3,9,6

'Maze 2
DATA 0,4
DATA 3,1
DATA 0,1
DATA 8,7,8,7

'Maze 3
DATA 4,0
DATA 3,1
DATA 0,2
DATA 9,6,8,7

'Maze 4
DATA 4,4
DATA 3,2
DATA 0,1
DATA 10,11,12,2

'END OF MAIN PROGRAM

SUB AInitialization STATIC

   DIM I AS INTEGER
   DIM Row AS INTEGER, Col AS INTEGER, Dir AS INTEGER

   RANDOMIZE TIMER
  
   EscKey$ = CHR$(27): EnterKey$ = CHR$(13)
   Arrow$ = CHR$(26)
  
   '0 = up, 1 = right, 2 = down, 3 = left
  
   'binary weight associated with each direction
   BinaryWeight(0) = 1
   BinaryWeight(1) = 2
   BinaryWeight(2) = 4
   BinaryWeight(3) = 8
  
   'row offset associated with moving forward from each direction
   MoveRowOffset(0) = -1
   MoveRowOffset(1) = 0
   MoveRowOffset(2) = 1
   MoveRowOffset(3) = 0
  
   'col offset associated with moving forward from each direction
   MoveColOffset(0) = 0
   MoveColOffset(1) = 1
   MoveColOffset(2) = 0
   MoveColOffset(3) = -1
  
   SCREEN 9, , 1, 0

   COLOR 7
   PRINT "MMOUSE25.BAS"

   LOCATE 3, 1
   PRINT "The Mechanical"
   PRINT "Mouse Problem"
   PRINT
   PRINT "devise an algorithm"
   PRINT "to solve the mazes"
   PRINT
   PRINT "algorithm: turn"
   PRINT "right, spin left"
   PRINT
   IF NOT SINGLESTEP THEN
      PRINT
      PRINT
   ELSE
      PRINT "Single Step option:"
      PRINT "press <Enter> key"
   END IF
   PRINT
   PRINT "Mechanical Mouse"
   PRINT "Instruction Set:"
   PRINT "  Move Forward"
   PRINT "  Turn Right"
   PRINT "  Turn Left"
   PRINT "  Turn Around"
   PRINT "  Wall Ahead?"
   PRINT "  Maze Entrance?"
   PRINT "  Maze Exit?"
   PRINT "  Halt";
  
   VIEW (164, 1)-(638, 348), VIEWPORTBG, VIEWPORTBORDER
   WINDOW SCREEN (0, 0)-(8, 8)

   LINE (4, 0)-(4, 8), VIEWPORTBORDER
   LINE (0, 4)-(8, 4), VIEWPORTBORDER
  
   CALL ZSUBCreateMouse
  
   FOR I = 1 TO 4
      'read maze data
      CALL ZSUBReadData
      'draw maze
      FOR Row = 1 TO 2
         FOR Col = 1 TO 2
            FOR Dir = 0 TO 3
               IF NOT (Maze(Row, Col) AND BinaryWeight(Dir)) = 0 THEN CALL ZSUBDrawWall(Row, Col, Dir)
            NEXT Dir
         NEXT Col
      NEXT Row
   NEXT I

   RESTORE
  
   'slight delay so fast computers do not overrun start of program
   IF NOT SINGLESTEP THEN
      CALL ZSUBUpdateScreen
      CALL ZSUBDelay(.5)
   END IF

END SUB

SUB AProcess STATIC
 
   DIM I AS INTEGER
  
   FOR I = 1 TO 4
      CALL ZSUBReadData
     
      'draw Mouse at maze entrance pointing upward toward maze
      MouseRow = EntranceRow
      MouseCol = EntranceCol
      MouseDir = STARTDIR
      MousePtr = MouseDir * 6
      CALL ZSUBDrawMouse
     
      CALL ZSUBSolveMaze
   NEXT I

END SUB

SUB ASummary STATIC

   VIEW

END SUB

SUB Halt STATIC

   'Mechanical Mouse Instruction Set: Halt
   'instruction 8 in screen list

   CALL ZSUBSSOption(8, "")

END SUB

FUNCTION MazeEntrance% STATIC

   'Mechanical Mouse Instruction Set: Maze Entrance? (returns True or False)
   'instruction 6 in screen list

   IF NOT ((MouseRow = EntranceRow) AND (MouseCol = EntranceCol)) THEN
      CALL ZSUBSSOption(6, F$)
      MazeEntrance = FALSE
   ELSE
      CALL ZSUBSSOption(6, T$)
      MazeEntrance = TRUE
   END IF
 
END FUNCTION

FUNCTION MazeExit% STATIC

   'Mechanical Mouse Instruction Set: Maze Exit? (returns True or False)
   'instruction 7 in screen list

   IF NOT ((MouseRow = ExitRow) AND (MouseCol = ExitCol)) THEN
      CALL ZSUBSSOption(7, F$)
      MazeExit = FALSE
   ELSE
      CALL ZSUBSSOption(7, T$)
      MazeExit = TRUE
   END IF
  
END FUNCTION

SUB MoveForward STATIC

   'Mechanical Mouse Instruction Set: Move Forward
   'instruction 1 in screen list

   CALL ZSUBSSOption(1, "")
  
   CALL ZSUBEraseMouse
  
   MouseRow = MouseRow + MoveRowOffset(MouseDir)
   MouseCol = MouseCol + MoveColOffset(MouseDir)
   MousePtr = MouseDir * 6

   CALL ZSUBDrawMouse
  
END SUB

SUB TurnAround STATIC

   'Mechanical Mouse Instruction Set: Turn Around
   'instruction 4 in screen list

   DIM I AS INTEGER
 
   CALL ZSUBSSOption(4, "")
  
   'randomly select direction to turn around
   SELECT CASE INT(RND * 2) + 1
     
      CASE 1
         'turn around to the left
        
         IF MouseDir = 0 THEN
            MousePtr = 23
         ELSE
            MousePtr = MouseDir * 6 - 1
         END IF
 
         FOR I = 1 TO 12
            CALL ZSUBDrawMouse
            MousePtr = MousePtr - 1: IF MousePtr = -1 THEN MousePtr = 23
         NEXT I

         'two left-hand turns
         MouseDir = MouseDir - 1: IF MouseDir = -1 THEN MouseDir = 3
         MouseDir = MouseDir - 1: IF MouseDir = -1 THEN MouseDir = 3
     
      CASE 2
         'turn around to the right
        
         MousePtr = MouseDir * 6 + 1
        
         FOR I = 1 TO 12
            CALL ZSUBDrawMouse
            MousePtr = MousePtr + 1: IF MousePtr = 24 THEN MousePtr = 0
         NEXT I
        
         'two right-hand turns
         MouseDir = MouseDir + 1: IF MouseDir = 4 THEN MouseDir = 0
         MouseDir = MouseDir + 1: IF MouseDir = 4 THEN MouseDir = 0
   
   END SELECT

END SUB

SUB TurnLeft STATIC
  
   'Mechanical Mouse Instruction Set: Turn Left
   'instruction 3 in screen list
  
   DIM I AS INTEGER
  
   CALL ZSUBSSOption(3, "")
  
   IF MouseDir = 0 THEN
      MousePtr = 23
   ELSE
      MousePtr = MouseDir * 6 - 1
   END IF
   
   FOR I = 1 TO 6
      CALL ZSUBDrawMouse
      MousePtr = MousePtr - 1
   NEXT I
 
   MouseDir = MouseDir - 1: IF MouseDir = -1 THEN MouseDir = 3

END SUB

SUB TurnRight STATIC

   'Mechanical Mouse Instruction Set: Turn Right
   'instruction 2 in screen list

   DIM I AS INTEGER
  
   CALL ZSUBSSOption(2, "")
  
   MousePtr = MouseDir * 6 + 1
  
   FOR I = 1 TO 6
      CALL ZSUBDrawMouse
      MousePtr = MousePtr + 1: IF MousePtr = 24 THEN MousePtr = 0
   NEXT I
  
   MouseDir = MouseDir + 1: IF MouseDir = 4 THEN MouseDir = 0
  
END SUB

FUNCTION WallAhead% STATIC

   'Mechanical Mouse Instruction Set: Wall Ahead? (returns True or False)
   'instruction 5 in screen list

   IF (Maze(MouseRow, MouseCol) AND BinaryWeight(MouseDir)) = 0 THEN
      CALL ZSUBSSOption(5, F$)
      WallAhead = FALSE
   ELSE
      IF SOUNDON THEN SOUND NOTEFREQ, NOTEDUR
      CALL ZSUBSSOption(5, T$)
      WallAhead = TRUE
   END IF
 
END FUNCTION

SUB ZSUBCreateMouse STATIC

   CONST XCenter = .5, YCenter = .5
  
   DIM I AS INTEGER
   DIM X1 AS SINGLE, Y1 AS SINGLE
   DIM X2 AS SINGLE, Y2 AS SINGLE
   DIM MG AS DataSet

   X1 = PMAP(PMAP(0, 0) + 2, 2)
   Y1 = PMAP(PMAP(0, 1) + 2, 3)
   X2 = PMAP(PMAP(1, 0) - 2, 2)
   Y2 = PMAP(PMAP(1, 1) - 2, 3)
  
   'save blank graphic
   GET (X1, Y1)-(X2, Y2), BlankGraphic(0)

   'define points for Mouse graphic
   MG.XHead = 0: MG.YHead = -.2
   MG.XBody = 0: MG.YBody = 0
   MG.XTail = 0: MG.YTail = .4
   MG.XLtWhisker1 = -.2: MG.YLtWhisker1 = -.29
   MG.XRtWhisker1 = .2: MG.YRtWhisker1 = -.29
   MG.XLtWhisker2 = -.2: MG.YLtWhisker2 = -.24
   MG.XRtWhisker2 = .2: MG.YRtWhisker2 = -.24
   MG.XLtEye = -.07: MG.YLtEye = -.265
   MG.XRtEye = .07: MG.YRtEye = -.265
  
   FOR I = 0 TO 23

      'draw Mouse
      CIRCLE (XCenter + MG.XHead, YCenter + MG.YHead), .11, MOUSEON
      PAINT (XCenter + MG.XHead, YCenter + MG.YHead), MOUSEON, MOUSEON
     
      CIRCLE (XCenter + MG.XBody, YCenter + MG.YBody), .2, MOUSEON
      PAINT (XCenter + MG.XBody, YCenter + MG.YBody), MOUSEON, MOUSEON

      LINE (XCenter + MG.XBody, YCenter + MG.YBody)-(XCenter + MG.XTail, YCenter + MG.YTail), MOUSEON

      LINE (XCenter + MG.XLtWhisker1, YCenter + MG.YLtWhisker1)-(XCenter + MG.XRtWhisker1, YCenter + MG.YRtWhisker1), MOUSEON
      LINE (XCenter + MG.XLtWhisker2, YCenter + MG.YLtWhisker2)-(XCenter + MG.XRtWhisker2, YCenter + MG.YRtWhisker2), MOUSEON

      PSET (XCenter + MG.XLtEye, YCenter + MG.YLtEye), EYEON
      PSET (XCenter + MG.XRtEye, YCenter + MG.YRtEye), EYEON

      'save graphic (each successive graphic is rotated 15 degrees cw)
      ' 0 =   0 deg. (up),  1 =  15,  2 =  30,  3 =  45,  4 =  60,  5 =  75
      ' 6 =  90 deg. (rt),  7 = 105,  8 = 120,  9 = 135, 10 = 150, 11 = 165
      '12 = 180 deg. (dn), 13 = 195, 14 = 210, 15 = 225, 16 = 240, 17 = 255
      '18 = 270 deg. (lt), 19 = 285, 20 = 300, 21 = 315, 22 = 330, 23 = 345
      GET (X1, Y1)-(X2, Y2), DirGraphic(I * GRAPHICSIZE)
     
      'erase graphic
      PUT (X1, Y1), BlankGraphic(0), PSET
     
      'rotate points for Mouse graphic 15 degrees cw
      CALL ZSUBTransform(MG.XBody, MG.YBody)
      CALL ZSUBTransform(MG.XTail, MG.YTail)
      CALL ZSUBTransform(MG.XHead, MG.YHead)
      CALL ZSUBTransform(MG.XLtWhisker1, MG.YLtWhisker1)
      CALL ZSUBTransform(MG.XRtWhisker1, MG.YRtWhisker1)
      CALL ZSUBTransform(MG.XLtWhisker2, MG.YLtWhisker2)
      CALL ZSUBTransform(MG.XRtWhisker2, MG.YRtWhisker2)
      CALL ZSUBTransform(MG.XLtEye, MG.YLtEye)
      CALL ZSUBTransform(MG.XRtEye, MG.YRtEye)
  
   NEXT I
  
   'graphic offsets
   GRowOffset = Y1: GColOffset = X1

END SUB

SUB ZSUBDelay (Value AS SINGLE) STATIC

   CONST SPD = 86400   'seconds per day
 
   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
     
   WEND

END SUB

SUB ZSUBDrawMouse STATIC

   PUT (MColOffset + MouseCol + GColOffset, MRowOffset + MouseRow + GRowOffset), DirGraphic(MousePtr * GRAPHICSIZE), PSET

   CALL ZSUBUpdateScreen

   'delay if Mouse is pointing up, right, down or left (not while turning)
   IF (MousePtr MOD 6) = 0 THEN CALL ZSUBDelay(DELAY)
  
END SUB

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

   DIM X1 AS INTEGER, Y1 AS INTEGER
   DIM X2 AS INTEGER, Y2 AS INTEGER

   SELECT CASE Dir
      CASE 0
         X1 = Col: Y1 = Row
         X2 = Col + 1: Y2 = Row
      CASE 1
         X1 = Col + 1: Y1 = Row
         X2 = Col + 1: Y2 = Row + 1
      CASE 2
         X1 = Col + 1: Y1 = Row + 1
         X2 = Col: Y2 = Row + 1
      CASE 3
         X1 = Col: Y1 = Row + 1
         X2 = Col: Y2 = Row
   END SELECT

   LINE (MColOffset + X1, MRowOffset + Y1)-(MColOffset + X2, MRowOffset + Y2), WALLON

END SUB

SUB ZSUBEraseMouse STATIC

   PUT (MColOffset + MouseCol + GColOffset, MRowOffset + MouseRow + GRowOffset), BlankGraphic(0), PSET
  
END SUB

SUB ZSUBReadData STATIC

   DIM Row AS INTEGER, Col AS INTEGER
  
   READ MRowOffset, MColOffset
   READ EntranceRow, EntranceCol
   READ ExitRow, ExitCol
  
   FOR Row = 1 TO 2
      FOR Col = 1 TO 2
         READ Maze(Row, Col)
      NEXT Col
   NEXT Row
   
END SUB

SUB ZSUBSolveMaze STATIC

   'maze solution algorithm: turn right, spin left (follow right-hand wall)
  
   MoveForward

   DO UNTIL MazeExit = TRUE

      TurnRight

      WHILE WallAhead = TRUE
         TurnLeft
      WEND

      MoveForward
  
   LOOP

   Halt

END SUB

SUB ZSUBSSOption (Number AS INTEGER, S AS STRING) STATIC

   DIM A AS STRING
  
   IF SINGLESTEP THEN

      LOCATE 16 + Number, 1: PRINT Arrow$;
      LOCATE 16 + Number, 18: PRINT S$;
     
      CALL ZSUBUpdateScreen
     
      DO
         A$ = INKEY$
      LOOP WHILE NOT A$ = ""

      DO
         DO
            A$ = INKEY$
         LOOP WHILE A$ = ""
         IF A$ = EscKey$ THEN STOP
      LOOP UNTIL A$ = EnterKey$

      LOCATE 16 + Number, 1: PRINT B$;
      LOCATE 16 + Number, 18: PRINT B$;
  
   END IF

END SUB

SUB ZSUBTransform (X AS SINGLE, Y AS SINGLE) STATIC

   'transformation matrix for ccw rotation
   'rotation is actually cw since WINDOW SCREEN statment reverses the
   'Y screen coordinates
  
   CONST COSINE = .9659258         'Cosine = COS(15 degrees * 3.141593 / 180)
   CONST SINE = .2588191           'Sine =   SIN(15 degrees * 3.141593 / 180)
  
   DIM Xt AS SINGLE, Yt AS SINGLE

   Xt = COSINE * X + -SINE * Y
   Yt = SINE * X + COSINE * Y

   X = Xt
   Y = Yt

END SUB

SUB ZSUBUpdateScreen STATIC

   'wait for vertical retrace
   'REMmed out (inactivated); reactivate if graphics are not smooth
   'WAIT &H3DA, 8
   'WAIT &H3DA, 8, 8
  
   'update screen
   PCOPY 1, 0

END SUB