        PROGRAM MAZES

C  PROGRAM TO GENERATE RANDOM MAZES (WITH UNIQUE SOLUTIONS)

C  ORIGINAL (BASIC): JACK HAUBER, LOOMIS SCHOOL, WINDSOR, CONNECTICUT
C  MODIFIED (BASIC): D J LEIGH - DECEMBER 1976
C  REWRITTEN (FORTRAN-77): M S OAKES - JANUARY 1986
C  DATE LAST EDITED: 1 AUGUST 1987

        INTEGER  I,ILIM,J,JLIM,JSTART,MAXSIZ
        PARAMETER (MAXSIZ = 25)
        INTEGER  WALLS(MAXSIZ,MAXSIZ)
        INTEGER  CHOICE,WAYS,COUNT,SIZE

        LOGICAL  AFFIRM
        LOGICAL  LEFT,RIGHT,UP,DOWN,EXIT
        LOGICAL  OK
        LOGICAL*1  BEENTO(MAXSIZ,MAXSIZ)

        CHARACTER*3 ROW(MAXSIZ),PATRN1,PATRN2,PATRN3,PATRN4

C  PATTERNS FOR PRINTING MAZE

        DATA  PATRN1,PATRN2/'--:','  :'/
        DATA  PATRN3,PATRN4/'   ','  I'/

C  STATEMENT FUNCTIONS

C  INPUT VALIDATION
        OK(WAYS) = (1.LE.WAYS) .AND. (WAYS.LE.MAXSIZ)
C  RANDOM MULTI-WAY BRANCH GENERATOR
        CHOICE(WAYS) = 1 + INT(RANDOM(0) * WAYS)

C  START OF EXECUTION

        PRINT *,' This program will print out a different maze every'
        PRINT *,' time it is run and guarantees only one path through.'
        PRINT *,' You can choose the dimensions of the maze, i.e. the'
        PRINT *,' number of squares long and the number of squares'
        PRINT *,' wide.  A 25 by 25 maze is the maximum, and any'
        PRINT *,' dimensions up to these limits are O.K.'

C  START OF EACH MAZE

100     CONTINUE
        PRINT *
        PRINT *,' Length: '
        READ *, ILIM
        PRINT *,' Width: '
        READ *, JLIM
        IF (.NOT. OK(ILIM) .OR. .NOT. OK(JLIM)) THEN
           PRINT *,' Meaningless dimensions - try again'
           GOTO 100
        ENDIF
        PRINT *

C  INITIALIZATION

        SIZE = ILIM * JLIM
        EXIT = .FALSE.
        DO 220 I = 1,ILIM
        DO 210 J = 1,JLIM
        BEENTO(I,J) = .FALSE.
        WALLS(I,J) = 0
  210   CONTINUE
  220   CONTINUE

C  PICK THE STARTING SQUARE AND PRINT THE TOP BOUNDARY

        JSTART = CHOICE(JLIM)
        DO 300 J = 1,JLIM
        IF (J .EQ. JSTART) THEN
           ROW(J) = PATRN2
        ELSE
          ROW(J) = PATRN1
        ENDIF
  300   CONTINUE
        PRINT *, PATRN2,(ROW(J),J=1,JLIM)

        I = 1
        J = JSTART
        BEENTO(I,J) = .TRUE.
        COUNT = 1

C  START OF MAIN PROCESSING LOOP

  400   IF (COUNT.GE.SIZE) GOTO 2000

	IF (J.GT.1) THEN
	   LEFT = .NOT. BEENTO(I,J-1)
	ELSE
	   LEFT = .FALSE.
	ENDIF
	IF (J.LT.JLIM) THEN
	   RIGHT = .NOT. BEENTO(I,J+1)
	ELSE
	   RIGHT = .FALSE.
	ENDIF
	IF (I.GT.1) THEN
	   UP = .NOT. BEENTO(I-1,J)
	ELSE
	   UP = .FALSE.
	ENDIF
	IF (I.LT.ILIM) THEN
	   DOWN = .NOT. BEENTO(I+1,J)
	ELSE
	   DOWN = .NOT. EXIT
	ENDIF

        IF (LEFT) THEN
           IF (UP) THEN
              IF (RIGHT) THEN
                 GOTO (1100,1200,1300), CHOICE(3)
	      ELSE
C  MUSN'T GO RIGHT
                 IF (DOWN)  GOTO (1100,1200,1400), CHOICE(3)
                 GOTO (1100,1200), CHOICE(2)
              ENDIF
           ELSE
C  MUSN'T GO UP
              IF (RIGHT) THEN
                 IF (DOWN)  GOTO (1100,1300,1400), CHOICE(3)
                 GOTO (1100,1300), CHOICE(2)
              ELSE
C  MUSN'T GO UP OR RIGHT
                 IF (DOWN)  GOTO (1100,1400), CHOICE(2)
                 GOTO 1100
              ENDIF
           ENDIF
        ELSE
C  MUSN'T GO LEFT
           IF (UP) THEN
              IF (RIGHT) THEN
                 IF (DOWN)  GOTO (1200,1300,1400), CHOICE(3)
                 GOTO (1200, 1300), CHOICE(2)
              ELSE
C  MUSN'T GO LEFT OR RIGHT
                 IF (DOWN)  GOTO (1200,1400), CHOICE(2)
                 GOTO 1200
              ENDIF
           ELSE
C  MUSN'T GO LEFT OR UP
              IF (RIGHT) THEN
                 IF (DOWN)  GOTO (1300,1400), CHOICE(2)
                 GOTO 1300
              ELSE
C  MUSN'T GO LEFT OR UP OR RIGHT
                 IF (DOWN)  GOTO 1400
C  CAN'T GO ANYWHERE, SO GROW A NEW BRANCH
                 GOTO 1800
              ENDIF
           ENDIF
        ENDIF

C  GO LEFT
 1100   J = J - 1
        WALLS(I,J) = 2
        GOTO 1600

C  GO UP
 1200   I = I - 1
        WALLS(I,J) = 1
        GOTO 1600

C  GO RIGHT
 1300   IF (WALLS(I,J).EQ.0) THEN
           WALLS(I,J) = 2
        ELSE
           WALLS(I,J) = 3
        ENDIF
        J = J + 1
        GOTO 1600

C  GO DOWN
 1400   IF (WALLS(I,J).EQ.0) THEN
           WALLS(I,J) = 1
        ELSE
           WALLS(I,J) = 3
        ENDIF
        IF (I.EQ.ILIM) GOTO 1700
        I = I + 1

C  MARK THE LOCATION AS "VISITED"
 1600   COUNT = COUNT + 1
        BEENTO(I,J) = .TRUE.
        GOTO 400

C  CREATE AN EXIT, THEN START SCANNING IN TOP-LEFT CORNER
 1700   EXIT = .TRUE.
        I = ILIM
        J = JLIM

C  GROW A NEW BRANCH
 1800   IF (J.EQ.JLIM) THEN
           IF (I.EQ.ILIM) THEN
              I = 1
           ELSE
              I = I + 1
           ENDIF
           J = 1
        ELSE
           J = J + 1
        ENDIF
        IF (BEENTO(I,J)) GOTO 400
        GOTO 1800

C  CHECK THAT AN EXIT HAS BEEN MADE

 2000   IF (.NOT. EXIT) THEN
           J = CHOICE(JLIM)
           WALLS(ILIM,J) = WALLS(ILIM,J) + 1
        ENDIF

C  PRINT OUT THE MAZE

        DO 2300 I = 1,ILIM

        DO 2100 J = 1,JLIM
        IF (WALLS(I,J).LT.2) THEN
           ROW(J) = PATRN4
        ELSE
           ROW(J) = PATRN3
        ENDIF
 2100   CONTINUE
        PRINT*, PATRN4,(ROW(J),J=1,JLIM)

        DO 2200 J = 1,JLIM
        IF ((WALLS(I,J).EQ.0).OR.(WALLS(I,J).EQ.2)) THEN
           ROW(J) = PATRN1
        ELSE
           ROW(J) = PATRN2
        ENDIF
 2200   CONTINUE
        PRINT *, PATRN2,(ROW(J),J=1,JLIM)

 2300   CONTINUE
        PRINT *
        PRINT *

C  POSSIBLY RETURN FOR ANOTHER GO

        IF (AFFIRM('Another maze')) GOTO 100

        END
