DEFINT A-Z
DECLARE SUB DrawBox (C$)
DECLARE SUB ClearStatus ()
DECLARE FUNCTION Trim$ (a)
DECLARE SUB LoadScreen ()
DECLARE SUB MakeScreen (Scr, Wide, High)
DECLARE SUB Intro (Scr)
DECLARE SUB PrintSave (Wide, High)
DECLARE SUB PrintScreen ()
DECLARE SUB Status (Wide%, High%)
DIM SHARED Bottom
ON ERROR GOTO Printer.Error

'   Labyrinth Maker - Michael Hondrosmos 21-1-93
'   Re-Designed to Quick Basic from a BASICA Version
'   Source: '100 ready-to-run programs to rhe IBM-PC' - J.BERTZ J.C.CRAIG

    RANDOMIZE TIMER
    Wide = 20
    High = 15

    Bottom = 25
    Scr = 2
    SCREEN Scr
    Intro (Scr)

ErroResume:

DO
    a$ = INPUT$(1)
      SELECT CASE UCASE$(a$)
       
        CASE "Q"
          IF Scr = 2 THEN Scr = 11 ELSE Scr = 2
          SCREEN Scr
          Intro (Scr)
         
        CASE "P", CHR$(9): IF Scr = 2 THEN PrintScreen
        CASE "S", " ": IF Scr = 2 THEN CALL PrintSave(Wide, High)
        CASE "L": IF Scr = 2 THEN LoadScreen
        CASE "M", CHR$(13): CALL MakeScreen(Scr, Wide, High)
        CASE CHR$(27): EXIT DO
        CASE ELSE: Intro (Scr)
      END SELECT
     
      IF Scr = 2 THEN Bottom = 25 ELSE Bottom = 30

LOOP UNTIL a$ = CHR$(27)
SCREEN 0
END

Printer.Error:
  SELECT CASE ERR
   
    CASE 6: DrawBox "Too Many Rows/Cols"
   
    CASE 5
      DrawBox "Graphics Card not Supported"
      IF Scr = 11 THEN Scr = 2 ELSE END
   
    CASE 24, 27, 25, 71: DrawBox "Printer Not Ready"
   
    CASE ELSE: DrawBox "Error #" + STR$(ERR)
 
  END SELECT
BEEP

RESUME ErroResume

SUB ClearStatus
  LOCATE Bottom, 1
  PRINT SPC(79);
  LOCATE Bottom, 1
END SUB

SUB DrawBox (C$)
  LOCATE 11, 20: PRINT SPACE$(LEN(C$) + 16)
  LOCATE 12, 20: PRINT "   ***  "; C$; "  ***   "
  LOCATE 13, 20: PRINT SPACE$(LEN(C$) + 16)
END SUB

SUB Intro (Scr)
    CLS
    PRINT TAB(20); "Labyrinth Maker v4 - Michael Hondrosmos"
    PRINT STRING$(79, "-")
    PRINT : PRINT
    PRINT , "Q   - Change Screen Mode ";
      IF Scr = 2 THEN PRINT "( Cga -> Vga )" ELSE PRINT "( Vga -> Cga )"
    PRINT , "M   - Make a Screen  [ENTER]"
      IF Scr = 2 THEN
        PRINT , "S   - Save a Screen  [SPACE] (When Labyrinth on screen)"
        PRINT , "P   - Print a Screen [TAB]   (When Labyrinth on screen)"
        PRINT , "L   - Load a Saved Screen"
      END IF
    PRINT , "ESC - Exit"
    PRINT : PRINT

END SUB

SUB LoadScreen
    DEF SEG = &HB800
    ClearStatus
    INPUT ; "Load File"; File$
    BLOAD File$ + ".BAS"
END SUB

SUB MakeScreen (Scr, Wide, High)

    IF Scr = 2 THEN Bottom = 25 ELSE Bottom = 30
   
    ClearStatus
    LOCATE Bottom, 5
    PRINT "Columns Wide ("; Trim$(Wide); ")";
    INPUT ; ":", Wide2
    IF Wide2 <> 0 THEN Wide = Wide2 ELSE PRINT Wide;
   
    High = Wide * (48 / 64)
    LOCATE Bottom, 40
    PRINT "Columns High ("; Trim$(High); ")";
    INPUT ; ":", High2
    IF High2 <> 0 THEN High = High2 ELSE PRINT High;
   
    Winc = 640 \ (Wide + 1)
      IF Scr = 2 THEN
        Hinc = 200 \ (High + 1)
      ELSE
        Hinc = 480 \ (High + 1)
      END IF

    CLS
    LINE (0, 0)-(Wide * Winc, High * Hinc), , B
    Count = Wide * High
      FOR i = 0 TO Count
        Ptr = (Ptr + 997) MOD Count
        x = Ptr \ High
        y = Ptr - x * High
        x = x * Winc
        y = y * Hinc
        IF POINT(x, y) THEN 600
        Dir = INT(4 * RND + 1)
        Dir2 = Dir
400     Dir = Dir MOD 4 + 1
        Xn = ((Dir = 1) - (Dir = 3)) * Winc + x
        Yn = ((Dir = 2) - (Dir = 4)) * Hinc + y
        IF POINT(Xn, Yn) = 0 THEN 550
        LINE (x, y)-(Xn, Yn)
450     Dir = INT(4 * RND + 1)
          FOR k = 1 TO 4
            Dir = Dir MOD 4 + 1
            Xn = ((Dir = 1) - (Dir = 3)) * Winc + x
            Yn = ((Dir = 2) - (Dir = 4)) * Hinc + y
            IF POINT(Xn, Yn) THEN 590
            LINE (x, y)-(Xn, Yn)
            x = Xn
            y = Yn
            GOTO 450
550         IF Dir <> Dir2 THEN 400
            x = Xn
            y = Yn
580         GOTO 400
590       NEXT
600   NEXT

    y = (High \ 2) * Hinc - 2
    LINE (0, y)-(0, y + Hinc), 0
    LINE (Wide * Winc, y)-(Wide * Winc, y + Hinc), 0

    Status Wide, High

END SUB

SUB PrintSave (Wide, High)
    ClearStatus
    INPUT ; "Saved as:"; File$
    ClearStatus
    Status Wide, High
    IF File$ = "" THEN EXIT SUB
    DEF SEG = &HB800
    BSAVE File$, 0, &H4000
END SUB

SUB PrintScreen
    DEF SEG = &HB800
    e$ = CHR$(27)
    Wob = 0 ' Wob = 0 | 255
    WIDTH "LPT1:", 255
    LPRINT e$ + "1" + e$ + "W" + CHR$(1)
      FOR Row = 0 TO 79
        LPRINT e$ + "K" + CHR$(144) + CHR$(1);
          FOR Col = 99 TO 0 STEP -1
            LocA = Col * 80 + Row
            Byte = PEEK(LocA + &H2000) XOR Wob
            LPRINT CHR$(Byte); CHR$(Byte);
            Byte = PEEK(LocA) XOR Wob
            LPRINT CHR$(Byte); CHR$(Byte);
          NEXT Col
        LPRINT
      NEXT Row
    LPRINT e$ + "@" + CHR$(12)
END SUB

SUB Status (Wide, High)
   
    LOCATE Bottom, 25
    PRINT "** Labyrinth "; Wide; "x"; High; " **";

END SUB

FUNCTION Trim$ (a)
  Trim$ = LTRIM$(RTRIM$(STR$(a)))
END FUNCTION