'
'   File:   hpmazeb.bas
'   Creation Date:  Wed 12-Jul-2000 18:23:01        Jonathan D. Kirwan
'   Last Modified:  Thu 17-Jun-2004 00:29:31        Initial version.
'
'   Copyright (C) 2000, 2004 Jonathan Dale Kirwan
'   All Rights Reserved: See the file COPYRGHT for a full description.
'
'
'   DESCRIPTION
'
'   This module demonstrates generating and printing a series of mazes on
'   the HP LaserJet printer.  See,
'
'       http://users.easystreet.com/jkirwan/maze.htm
'
'   for more information on the design.
'
'
'   MODIFICATIONS
'
'   No modifications.
'
'
'   COPYRIGHT NOTICE
'
'   Jonathan Dale Kirwan grants you a non-transferable, non-exclusive,
'   royalty-free worldwide license to use, copy, modify, prepare deriva-
'   tive works of and distribute this software, subject to your agreement
'   that you acquire no ownership right, title, or interest in this soft-
'   ware and your agreement that this software is research work which is
'   provided 'as is', where Jonathan Dale Kirwan disclaims all warranties
'   with regard to this software, including all implied warranties of
'   merchantability and fitness of purpose.  In no event shall Jonathan
'   Dale Kirwan be liable for any direct, indirect, consequential or
'   special damages or any damages whatsoever resulting from loss of use,
'   data or profits, whether in an action of contract, negligence or
'   other tortious action, arising out of or in connection with the use
'   or performance of this software.

DECLARE SUB GenerateMaze (MazeWidth AS INTEGER, MazeHeight AS INTEGER, WestWalls() AS INTEGER, SouthWalls() AS INTEGER)
DECLARE SUB PCLDrawMaze (unit AS INTEGER, MazeWidth AS INTEGER, MazeHeight AS INTEGER, WestWalls() AS INTEGER, SouthWalls() AS INTEGER)
DECLARE SUB PCLOpenJob (unit AS INTEGER)
DECLARE SUB PCLCloseJob (unit AS INTEGER)
DECLARE SUB PCLPosition (unit AS INTEGER, x AS INTEGER, y AS INTEGER)
DECLARE SUB PCLSetMacros (unit AS INTEGER, x AS INTEGER, y AS INTEGER)
DECLARE SUB PCLSelectMacro (unit AS INTEGER, macroid AS INTEGER)

    DIM answer AS STRING, idx AS INTEGER, PosX AS DOUBLE, PosY AS DOUBLE
    DIM part1 AS STRING, part2 AS STRING, DimX AS DOUBLE, DimY AS DOUBLE
    DIM unit AS INTEGER, MazeWidth AS DOUBLE, MazeHeight AS DOUBLE
    REDIM SouthWalls(0 TO 0) AS INTEGER, WestWalls(0 TO 0) AS INTEGER

        RANDOMIZE TIMER

        CLS

        COLOR 9
        PRINT STRING$(80, 196)
        COLOR 2
        PRINT TAB(39); "MAZE"
        COLOR 9
        PRINT STRING$(80, 196)
        COLOR 7

        PRINT
        PRINT "  This program allows you to generate several mazes onto a single page from an"
        PRINT "  HP LaserJet printer.  The program will first ask you to give a file name for"
        PRINT "  placing the final maze composite.  This file can be LPT1:BIN, if you want to"
        PRINT "  directly send information to the printer.  Or if you prefer, you can specify"
        PRINT "  a regular DOS-style file name and then later send or copy it to the printer."
        PRINT "  If you decide to quit, just hit ENTER for the file name and the program will"
        PRINT "  stop.  Otherwise, you will continue into some questions about the mazes you"
        PRINT "  want to generate.  You'll be allowed to enter any number of mazes and place"
        PRINT "  them where you want.  When you don't want any more mazes, just hit ENTER at"
        PRINT "  question asking for the maze's width and height.  That signals you are done."
        PRINT
        PRINT "  You can enter the page position and the room sizes using 'in' for inches and"
        PRINT "  mm for millimeters.  If you don't use either, then HP dots are assumed.  You"
        PRINT "  may also just enter the room size in the X direction alone, if you want.  If"
        PRINT "  so, the program simply assumes that the Y size of the room is the same."
        PRINT
        PRINT "  (You will be allowed to place a generated maze, several times.  So don't be"
        PRINT "  confused by the program asking you to enter a position more than once.  It's"
        PRINT "  asking that so you have an opportunity to test out different sizes for the"
        PRINT "  same generated maze or to place it multiple times so you can cut them out,"
        PRINT "  once the page is printed and hand them to several people for time trials.)"
        PRINT
        PRINT
        PRINT

        PRINT "Enter the filename on which to write the HP LaserJet page: ";
        LINE INPUT answer
        LET answer = LTRIM$(RTRIM$(answer))
        IF answer = "" THEN
            END
        END IF

        LET unit = FREEFILE
        OPEN answer FOR OUTPUT AS #unit
        PCLOpenJob unit

        DO
            DO
                PRINT "Enter the maze width and height: ";
                LINE INPUT answer
                LET answer = LTRIM$(RTRIM$(answer))
                IF answer = "" THEN
                    EXIT DO
                END IF
                LET idx = INSTR(answer, ",")
                IF idx >= 2 THEN
                    LET MazeWidth = INT(VAL(LEFT$(answer, idx - 1)))
                    LET MazeHeight = INT(VAL(MID$(answer, idx + 1)))
                    IF MazeWidth < 1# THEN
                        PRINT "  The width is either missing or too small."
                    ELSEIF MazeHeight < 1# THEN
                        PRINT "  The height is either missing or too small."
                    ELSEIF MazeWidth > 32760# THEN
                        PRINT "  The width is way too big."
                    ELSEIF MazeHeight > 32760# THEN
                        PRINT "  The height is way too big."
                    ELSEIF (CLNG(MazeWidth + 2) * CLNG(MazeHeight + 2) + 15&) > 32760& * &H10& THEN
                        PRINT "  The maze area is way too big."
                    ELSE
                        EXIT DO
                    END IF
                ELSE
                    PRINT "  You must enter both values, separated by a comma."
                END IF
            LOOP
            IF answer = "" THEN
                EXIT DO
            END IF

            GenerateMaze CINT(MazeWidth), CINT(MazeHeight), WestWalls(), SouthWalls()

            PRINT "  The maze is completed."
            PRINT

            DO
                DO
                    PRINT "Enter the page position for the maze (x, y): ";
                    LINE INPUT answer
                    LET answer = LTRIM$(RTRIM$(answer))
                    IF answer = "" THEN
                        EXIT DO
                    END IF
                    LET idx = INSTR(answer, ",")
                    IF idx >= 2 THEN
                        LET part1 = LEFT$(answer, idx - 1)
                        LET PosX = VAL(part1)
                        IF INSTR(part1, "in") > 0 THEN
                            LET PosX = PosX * 300#
                        ELSEIF INSTR(part1, "mm") > 0 THEN
                            LET PosX = (PosX / 25.4#) * 300#
                        END IF
                        LET PosX = INT(PosX + .5#)
                        LET part2 = MID$(answer, idx + 1)
                        LET PosY = VAL(part2)
                        IF INSTR(part2, "in") > 0 THEN
                            LET PosY = PosY * 300#
                        ELSEIF INSTR(part1, "mm") > 0 THEN
                            LET PosY = (PosY / 25.4#) * 300#
                        END IF
                        LET PosY = INT(PosY + .5#)
                        IF PosX < 0# OR PosY < 0# THEN
                            PRINT "  Both X and Y must be positive valued."
                        ELSEIF PosX > 300# * 8# THEN
                            PRINT "  The X value must be no more than 8 inches."
                        ELSEIF PosY > 300# * 10.5# THEN
                            PRINT "  The Y value must be no more than 10.5 inches."
                        ELSE
                            EXIT DO
                        END IF
                    ELSE
                        PRINT "  You must enter both an X and a Y value."
                    END IF
                LOOP
                IF answer = "" THEN
                    EXIT DO
                END IF

                DO
                    PRINT "Enter the size of a maze room (width, height): ";
                    LINE INPUT answer
                    LET answer = LTRIM$(RTRIM$(answer))
                    IF answer = "" THEN
                        EXIT DO
                    END IF
                    LET idx = INSTR(answer, ",")
                    IF idx = 0 THEN
                        LET DimX = VAL(answer)
                        IF INSTR(answer, "in") > 0 THEN
                            LET DimX = DimX * 300#
                        ELSEIF INSTR(answer, "mm") > 0 THEN
                            LET DimX = (DimX / 25.4#) * 300#
                        END IF
                        LET DimX = INT(DimX + .5#)
                        LET DimY = DimX
                    ELSEIF idx = 1 THEN
                        LET DimY = VAL(answer)
                        IF INSTR(answer, "in") > 0 THEN
                            LET DimY = DimY * 300#
                        ELSEIF INSTR(answer, "mm") > 0 THEN
                            LET DimY = (DimY / 25.4#) * 300#
                        END IF
                        LET DimY = INT(DimY + .5#)
                        LET DimX = DimY
                    ELSEIF idx >= 2 THEN
                        LET part1 = LEFT$(answer, idx - 1)
                        LET DimX = VAL(part1)
                        IF INSTR(part1, "in") > 0 THEN
                            LET DimX = DimX * 300#
                        ELSEIF INSTR(part1, "mm") > 0 THEN
                            LET DimX = (DimX / 25.4#) * 300#
                        END IF
                        LET DimX = INT(DimX + .5#)
                        LET part2 = MID$(answer, idx + 1)
                        LET DimY = VAL(part2)
                        IF INSTR(part2, "in") > 0 THEN
                            LET DimY = DimY * 300#
                        ELSEIF INSTR(part2, "mm") > 0 THEN
                            LET DimY = (DimY / 25.4#) * 300#
                        END IF
                        LET DimY = INT(DimY + .5#)
                    END IF
                    IF DimX < 4# OR DimY < 4# THEN
                        PRINT "  Both X-width and Y-height must be at least 4."
                    ELSE
                        EXIT DO
                    END IF
                LOOP
                IF answer = "" THEN
                    EXIT DO
                END IF

                PCLPosition unit, CINT(PosX), CINT(PosY)
                PCLSetMacros unit, CINT(DimX), CINT(DimY)
                PCLDrawMaze unit, CINT(MazeWidth), CINT(MazeHeight), WestWalls(), SouthWalls()
            LOOP
            PRINT
        LOOP

        PCLCloseJob unit
        CLOSE #unit

        END

SUB GenerateMaze (MazeWidth AS INTEGER, MazeHeight AS INTEGER, WestWalls() AS INTEGER, SouthWalls() AS INTEGER)
'
' This routine accepts a width and height for a maze and calculates a
' random maze into two arrays designed to hold the west and south walls
' of each room or cell in the maze grid.  These can then be used to print
' or use the maze, as desired (such as a random labyrinth for a game.)
'

    STATIC Masks() AS INTEGER, MaskFlag AS INTEGER

    DIM i AS INTEGER, j AS LONG, k AS LONG
    DIM Exits(0 TO 3) AS INTEGER, ExitCount AS INTEGER, Selection AS INTEGER
    DIM UnvisitedRoomCount AS LONG, CurrentRoom AS LONG, count AS INTEGER

    ' Since we are packing the west and south walls, 16 to an INTEGER,
    ' we need a way to pack and unpack them from the arrays.  This array
    ' is set up exactly once; on the first call to the routine.

        IF NOT MaskFlag THEN
            DIM Masks(0 TO 15) AS INTEGER
            FOR i = 0 TO 14
                LET Masks(i) = 2 ^ i
            NEXT i
            LET Masks(15) = &H8000
            LET MaskFlag = -1
        END IF

    ' This code redimensions the west and south wall arrays, as needed.
    ' These arrays must be redimensionable, or an error will result.
    ' As an important side effect I'm depending on, redimensioning
    ' these arrays causes their element values to be initialized to 0.

        LET count = CINT(((CLNG(MazeWidth + 2) * CLNG(MazeHeight + 2)) + 15&) \ 16&)
        ERASE WestWalls
        ERASE SouthWalls
        REDIM WestWalls(0 TO count - 1) AS INTEGER
        REDIM SouthWalls(0 TO count - 1) AS INTEGER

    ' Set up our local copy of the visitation status array.  Since the
    ' grid uses a perimeter around the maze itself, we need to mark the
    ' rooms in the perimeter as having been used, so that the intervening
    ' walls are not removed (since those walls are the maze's boundary.)

        DIM Visited(0 TO count - 1) AS INTEGER
        LET j = CLNG(MazeWidth + 2) * (MazeHeight + 1) - 1&
        FOR i = 0 TO MazeWidth + 2
            LET Visited(i \ &H10) = Visited(i \ &H10) OR Masks(i AND &HF)
            LET Visited((i + j) \ &H10&) = Visited((i + j) \ &H10&) OR Masks((i + j) AND &HF&)
        NEXT i
        LET j = MazeWidth + MazeWidth + 3
        FOR i = 1 TO MazeHeight
            LET Visited(j \ &H10&) = Visited(j \ &H10&) OR Masks(j AND &HF&)
            LET Visited((j + 1) \ &H10&) = Visited((j + 1) \ &H10&) OR Masks((j + 1) AND &HF&)
            LET j = j + MazeWidth + 2
        NEXT i

    ' Set up our local copy of the rooms viable for a path branch.

        DIM Paths(0 TO count - 1) AS INTEGER

    ' Arrays are set up, the perimeter is initialized, we're ready to go.
    ' Compute the maze!  (See the discussion on the web site for details.)

        LET PathCount = 0
        LET UnvisitedRoomCount = CLNG(MazeWidth) * MazeHeight
        LET j = INT(RND * UnvisitedRoomCount)
        LET CurrentRoom = (1 + j \ MazeWidth) * (MazeWidth + 2) + (j MOD MazeWidth) + 1
        DO WHILE UnvisitedRoomCount > 1
            LET UnvisitedRoomCount = UnvisitedRoomCount - 1
            LET Visited(CurrentRoom \ &H10&) = Visited(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
            DO
                LET ExitCount = 0
                IF (Visited((CurrentRoom - MazeWidth - 2) \ &H10&) AND Masks((CurrentRoom - MazeWidth - 2) AND &HF&)) = 0 THEN
                    LET Exits(ExitCount) = 1
                    LET ExitCount = ExitCount + 1
                END IF
                IF (Visited((CurrentRoom + MazeWidth + 2) \ &H10&) AND Masks((CurrentRoom + MazeWidth + 2) AND &HF&)) = 0 THEN
                    LET Exits(ExitCount) = 2
                    LET ExitCount = ExitCount + 1
                END IF
                IF (Visited((CurrentRoom - 1) \ &H10&) AND Masks((CurrentRoom - 1) AND &HF&)) = 0 THEN
                    LET Exits(ExitCount) = 3
                    LET ExitCount = ExitCount + 1
                END IF
                IF (Visited((CurrentRoom + 1) \ &H10&) AND Masks((CurrentRoom + 1) AND &HF&)) = 0 THEN
                    LET Exits(ExitCount) = 4
                    LET ExitCount = ExitCount + 1
                END IF
                IF ExitCount >= 1 THEN
                    EXIT DO
                END IF
                LET j = INT(RND * MazeWidth * MazeHeight)
                LET k = ((1& + j \ MazeWidth) * (MazeWidth + 2) + (j MOD MazeWidth) + 1&) \ &H10&
                DO WHILE Paths(k) = 0
                    LET k = k - 1&
                    IF k < 0& THEN
                        LET k = (CLNG(MazeWidth + 2) * CLNG(MazeHeight + 2) - 1&) \ &H10
                    END IF
                LOOP
                FOR i = 0 TO 15
                    IF (Paths(k) AND Masks(i)) <> 0 THEN
                        EXIT FOR
                    END IF
                NEXT i
                LET Paths(k) = Paths(k) AND NOT Masks(i)
                LET CurrentRoom = k * &H10& + i
            LOOP
            IF ExitCount > 1 THEN
                LET Paths(CurrentRoom \ &H10&) = Paths(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
            END IF
            LET Selection = INT(RND * ExitCount)
            SELECT CASE Exits(Selection)
            CASE 1
                LET CurrentRoom = CurrentRoom - MazeWidth - 2
                LET SouthWalls(CurrentRoom \ &H10&) = SouthWalls(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
            CASE 2
                LET SouthWalls(CurrentRoom \ &H10&) = SouthWalls(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
                LET CurrentRoom = CurrentRoom + MazeWidth + 2
            CASE 3
                LET WestWalls(CurrentRoom \ &H10&) = WestWalls(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
                LET CurrentRoom = CurrentRoom - 1
            CASE 4
                LET CurrentRoom = CurrentRoom + 1
                LET WestWalls(CurrentRoom \ &H10&) = WestWalls(CurrentRoom \ &H10&) OR Masks(CurrentRoom AND &HF&)
            END SELECT
        LOOP

    ' Add an entrance and exit to the maze.  These could be placed
    ' anywhere around the perimeter, if we wanted to.  For now, it's
    ' hard-coded at the upper-left corner and the lower-right corner.

        LET SouthWalls(0) = SouthWalls(0) OR Masks(1)
        LET j = CLNG(MazeHeight + 1) * (MazeWidth + 2) - 2
        LET SouthWalls(j \ &H10&) = SouthWalls(j \ &H10&) OR Masks(j AND &HF&)

END SUB

SUB PCLCloseJob (unit AS INTEGER)

        PRINT #unit, CHR$(27); "&l0H"; CHR$(27); "E";

END SUB

SUB PCLDrawMaze (unit AS INTEGER, MazeWidth AS INTEGER, MazeHeight AS INTEGER, WestWalls() AS INTEGER, SouthWalls() AS INTEGER)
'
' This routine accepts a width and height and the west and south walls for
' a maze and prints out the maze to the given file unit.
'

    STATIC Masks() AS INTEGER, MaskFlag AS INTEGER

    DIM i AS INTEGER, j AS INTEGER, p AS LONG, lastmacro AS INTEGER

        IF NOT MaskFlag THEN
            DIM Masks(0 TO 15) AS INTEGER
            FOR i = 0 TO 14
                LET Masks(i) = 2 ^ i
            NEXT i
            LET Masks(15) = &H8000
            LET MaskFlag = -1
        END IF

        PCLSelectMacro unit, -1
        PRINT #unit, CHR$(27); "&f0s";
        FOR j = 1 TO MazeWidth
            IF (SouthWalls(j \ &H10) AND Masks(j AND &HF)) <> 0 THEN
                PCLSelectMacro unit, 1
            ELSE
                PCLSelectMacro unit, 2
            END IF
            PRINT #unit, "2x";
        NEXT j
        LET p = 0&
        FOR i = 1 TO MazeHeight
            PCLSelectMacro unit, 1
            PRINT #unit, "2x1s";
            PCLSelectMacro unit, 3
            PRINT #unit, "2x0s";
            LET p = p + MazeWidth + 2&
            FOR j = 1 TO MazeWidth
                IF (WestWalls((p + j) \ &H10) AND Masks((p + j) AND &HF)) <> 0 THEN
                    PCLSelectMacro unit, 4
                ELSE
                    PCLSelectMacro unit, 5
                END IF
                PRINT #unit, "2x";
            NEXT j
            IF (WestWalls((p + MazeWidth + 1) \ &H10) AND Masks((p + MazeWidth + 1) AND &HF)) = 0 THEN
                PCLSelectMacro unit, 5
                PRINT #unit, "2x";
            END IF
            PRINT #unit, "1s";
            PCLSelectMacro unit, 6
            PRINT #unit, "2x0s";
            FOR j = 1 TO MazeWidth
                IF (SouthWalls((p + j) \ &H10) AND Masks((p + j) AND &HF)) <> 0 THEN
                    PCLSelectMacro unit, 1
                ELSE
                    PCLSelectMacro unit, 2
                END IF
                PRINT #unit, "2x";
            NEXT j
        NEXT i
        PCLSelectMacro unit, 1
        PRINT #unit, "2x1S";

END SUB

SUB PCLOpenJob (unit AS INTEGER)

        PRINT #unit, CHR$(27); "E";
        PRINT #unit, CHR$(27); "*t300R";
        PRINT #unit, CHR$(27); "&k.4H";
        PRINT #unit, CHR$(27); "&l.16C";

END SUB

SUB PCLPosition (unit AS INTEGER, x AS INTEGER, y AS INTEGER)

        PRINT #unit, CHR$(27); "*p"; LTRIM$(STR$(ABS(x))); "x"; LTRIM$(STR$(ABS(y))); "Y";

END SUB

SUB PCLSelectMacro (unit AS INTEGER, macroid AS INTEGER)

    STATIC lastmacro AS INTEGER

        IF macroid < 0 THEN
            LET lastmacro = macroid
        ELSEIF lastmacro <> macroid THEN
            PRINT #unit, LTRIM$(STR$(macroid)); "y";
            LET lastmacro = macroid
        END IF

END SUB

SUB PCLSetMacros (unit AS INTEGER, x AS INTEGER, y AS INTEGER)

    DIM count AS INTEGER, i AS INTEGER

    ' This macro draws an open south wall.

        PRINT #unit, CHR$(27); "&f1y0X";
        PRINT #unit, CHR$(27); "*r1A";
        PRINT #unit, CHR$(27); "*b1W"; CHR$(&H80);
        PRINT #unit, CHR$(27); "*rB";
        PRINT #unit, CHR$(27); "*p-1y+"; LTRIM$(STR$(ABS(x))); "X";
        PRINT #unit, CHR$(27); "&f1X";

    ' This macro draws a closed south wall.

        LET count = (ABS(x) + 7) \ 8
        PRINT #unit, CHR$(27); "&f2y0X";
        PRINT #unit, CHR$(27); "*r1A";
        PRINT #unit, CHR$(27); "*b"; LTRIM$(STR$(count)); "W";
        FOR i = 1 TO count - 1
            PRINT #unit, CHR$(&HFF);
        NEXT i
        PRINT #unit, CHR$((-2 ^ (7 - ((ABS(x) - 1) MOD 8))) AND &HFF);
        PRINT #unit, CHR$(27); "*rB";
        PRINT #unit, CHR$(27); "*p-1y+"; LTRIM$(STR$(ABS(x))); "X";
        PRINT #unit, CHR$(27); "&f1X";

    ' This macro advances vertically, after drawing south walls.

        PRINT #unit, CHR$(27); "&f3y0X";
        PRINT #unit, CHR$(27); "*p+1Y";
        PRINT #unit, CHR$(27); "&f1X";

    ' This macro draws an open west wall.

        PRINT #unit, CHR$(27); "&f4y0X";
        PRINT #unit, CHR$(27); "*p+"; LTRIM$(STR$(ABS(x))); "X";
        PRINT #unit, CHR$(27); "&f1X";

    ' This macro draws a closed west wall.

        PRINT #unit, CHR$(27); "&f5y0X";
        PRINT #unit, CHR$(27); "*r1A";
        FOR i = 1 TO ABS(y) - 1
            PRINT #unit, CHR$(27); "*b1W"; CHR$(&H80);
        NEXT i
        PRINT #unit, CHR$(27); "*rB";
        PRINT #unit, CHR$(27); "*p-"; LTRIM$(STR$(ABS(y) - 1)); "y+"; LTRIM$(STR$(ABS(x))); "X";
        PRINT #unit, CHR$(27); "&f1X";

    ' This macro advances vertically, after drawing west walls.

        PRINT #unit, CHR$(27); "&f6y0X";
        PRINT #unit, CHR$(27); "*p+"; LTRIM$(STR$(ABS(y) - 1)); "Y";
        PRINT #unit, CHR$(27); "&f1X";

END SUB