'===========================================================================
' Subject: PB VGA MAZE GENERATOR/SOLVER      Date: 05-16-96 (00:00)       
' Author:  Bob Ellis                         Code: PB                     
' Origin:  www.voicenet.com/~rellis/       Packet: EGAVGA.ABC
'===========================================================================
  rem - VGAMAZE2.BAS - 16 May 96 - Bob Ellis (rellis@voicenet.com)

  rem - based on VGA Maze Generator by Steve Harmon, who commented:

'Don't remember if I wrote this or picked it up somewhere and modified it
'for VGA. It's a little slow, but it works.

  rem - modified to increase speed, change aspect ratio to 1/1, solve maze
  rem - tested on a Gateway 2000 386DX25 system running under the
  rem - PowerBasic 3.20 IDE:
  rem -   33% decrease in grid size
  rem -   97% decrease in run time (using optimal starting cell)

  DEFINT A-Z

  x_boxes = 106  ' vertical lines - 1
  x_pixels = 6   ' pixels from 1 vertical line to the next
  x_linlen = x_boxes * x_pixels
  A = x_boxes - 1
  x_gap = x_pixels - 1

  y_boxes = 79   ' horizontal lines -1
  y_pixels = 6   ' pixels from 1 horizontal line to the next
  y_linlen = y_boxes * y_pixels
  B = y_boxes - 1
  y_gap = y_pixels - 1

  DIM F(A, B)
  DIM box_dat1?(A, B)

  FORE = 7 : BACK = 0 : dead_end = 4

Start:
  CLS
  PRINT "Maze Generator / Solver - VGA (640x480 x 16 colors)"
  PRINT
  PRINT "This program will create a 106x79 cell maze."
  PRINT
  PRINT "If you press any key before the maze is complete the program will pause,"
  PRINT " with the next keypress causing the program to return here."
  PRINT
  PRINT "When the maze is complete, you will hear a beep.  Pressing any key at this"
  PRINT " time will cause the program to begin solving the maze."
  PRINT
  PRINT "Pressing any key before the solution of the maze is complete will cause the"
  PRINT " program to pause, with the next keypress causing the program to return"
  PRINT " here."
  PRINT
  PRINT "Ready to generate a maze (Y/N): ";

  LOCATE , , 1
  DO
    DO
      a$ = INKEY$
    LOOP UNTIL a$ <> ""
    SELECT CASE UCASE$ (a$)
      CASE "Y"
        EXIT LOOP
      CASE "N"
        END
    END SELECT
    BEEP
  LOOP

  SCREEN 12
  CLS

  FOR Y = 0 TO y_linlen STEP y_pixels
    LINE (0,Y) - (x_linlen, Y), FORE
  NEXT Y

  FOR X = 0 TO x_linlen STEP x_pixels
    LINE (X,0) - (X, y_linlen), FORE
  NEXT X

  RANDOMIZE TIMER

  FOR E = 0 TO B
    FOR D = 0 TO A
      F(D, E) = 0
      box_dat1?(D, E) = 15?
    NEXT D
  NEXT E

  x_first = INT (x_boxes * RND (1))
  y_first = INT (y_boxes * RND (1))
  F(x_first, y_first) = 2

  DO
    D = A
    E = -1
    last_elmt = 0
    DO
      incr D
      IF D > A THEN
        D = 0
        INCR E
        IF E > B THEN EXIT LOOP
      END IF
      ARRAY SCAN F(D, E), =2, TO elmt
      IF elmt = 0 THEN EXIT LOOP
      last_elmt = elmt
      INCR D, elmt - 1
      WHILE D > A
        DECR D, x_boxes
        INCR E
      WEND
      X = D * x_pixels
      Y = E * y_pixels
      GOSUB Check_lines
      IF INKEY$ <> "" THEN All_done
    LOOP
  LOOP UNTIL last_elmt = 0

Set_entry_exit:
  X = 0
  E = INT (RND (1) * y_boxes)
  BIT RESET box_dat1?(0, E), 3
  Y = E * y_pixels
  LINE (X, Y + 1) - (X, Y + y_gap), BACK

  X = x_linlen
  E = INT (RND (1) * y_boxes)
  BIT RESET box_dat1?(A, E), 1
  Y = E * y_pixels
  LINE (X, Y + 1) - (X, Y + y_gap), BACK

  BEEP
  WHILE INKEY$ = "" : WEND

Solve_It:
  FOR E = 0 TO B
    FOR D = 0 TO A
      i = D
      j = E
      DO
        i1 = i
        j1 = j
        GOSUB Check_4_Dead_End
      LOOP UNTIL (i = i1) AND (j = j1)
      IF INKEY$ <> "" THEN All_Done
    NEXT D
  NEXT E

All_Done:
  BEEP
  WHILE INKEY$ = "" : WEND
  SCREEN 0
  GOTO Start

Check_4_Dead_End:
  SELECT CASE box_dat1?(i, j) AND 15?
    CASE 14?
      box_dat1?(i, j) = 31?
      LINE ((i * x_pixels) + 1, (j * y_pixels)) _
       - ((i * x_pixels) + x_gap, (j * y_pixels) + y_gap), dead_end, BF
      DECR j
      BIT SET box_dat1?(i, j), 2
    CASE 13?
      box_dat1?(i, j) = 31?
      LINE ((i * x_pixels) + 1, (j * y_pixels) + 1) _
       - (((i + 1) * x_pixels), (j * y_pixels) + y_gap), dead_end, BF
      INCR i
      BIT SET box_dat1?(i, j), 3
    CASE 11?
      box_dat1?(i, j) = 31?
      LINE ((i * x_pixels) + 1, (j * y_pixels) + 1) _
       - ((i * x_pixels) + x_gap, ((j + 1) * y_pixels)), dead_end, BF
      INCR j
      BIT SET box_dat1?(i, j), 0
    CASE 7?
      box_dat1?(i, j) = 31?
      LINE ((i * x_pixels), (j * y_pixels) + 1) _
       - ((i * x_pixels) + x_gap, (j * y_pixels) + y_gap), dead_end, BF
      DECR i
      BIT SET box_dat1?(i, j), 1
  END SELECT
  RETURN

Check_lines:
  todo = 0

  IF D > 0 THEN
    SELECT CASE F(D - 1, E)
      CASE 0
        F(D - 1, E) = 1
        INCR todo
      CASE 1
        INCR todo
    END SELECT
  END IF

  IF D < A THEN
    SELECT CASE F(D + 1, E)
      CASE 0
        F(D + 1, E) = 1
        INCR todo
      CASE 1
        INCR todo
    END SELECT
  END IF

  IF E > 0 THEN
    SELECT CASE F(D, E - 1)
      CASE 0
        F(D, E - 1) = 1
        INCR todo
      CASE 1
        INCR todo
    END SELECT
  END IF

  IF E < B THEN
    SELECT CASE F(D, E + 1)
      CASE 0
        F(D, E + 1) = 1
        INCR todo
      CASE 1
        INCR todo
    END SELECT
  END IF

  IF todo = 0 THEN F(D, E) = 3 : RETURN

  SELECT CASE CEIL(RND(1) * 4)
    CASE 1
      IF D > 0 THEN
        IF F(D - 1, E) = 1 THEN
          F(D - 1, E) = 2
          BIT RESET box_dat1?(D, E), 3
          BIT RESET box_dat1?(D - 1, E), 1
          r = X
          GOSUB Del_vert_line
        END IF
      END IF
    CASE 2
      IF D < A THEN
        IF F(D + 1, E) = 1 THEN
          F(D + 1, E) = 2
          BIT RESET box_dat1?(D, E), 1
          BIT RESET box_dat1?(D + 1, E), 3
          r = X + x_pixels
          GOSUB Del_vert_line
        END IF
      END IF
    CASE 3
      IF E > 0 THEN
        IF F(D, E - 1) = 1 THEN
          F(D, E - 1) = 2
          BIT RESET box_dat1?(D, E), 0
          BIT RESET box_dat1?(D, E - 1), 2
          s = Y
          GOSUB Del_horz_line
        END IF
      END IF
    CASE 4
      IF E < B THEN
        IF F(D, E + 1) = 1 THEN
          F(D, E + 1) = 2
          BIT RESET box_dat1?(D, E), 2
          BIT RESET box_dat1?(D, E + 1), 0
          s = Y + y_pixels
          GOSUB Del_horz_line
        END IF
      END IF
  END SELECT
  RETURN

Del_vert_line:
  LINE (r, Y + 1) - (r, Y + y_gap), BACK
  RETURN

Del_horz_line:
  LINE (X + 1, s) - (X + x_gap, s), BACK
  RETURN