home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / P_FOTRAN.LZH / DEMOS.FOR / MAZES.FOR < prev    next >
Text File  |  1987-12-31  |  6KB  |  245 lines
  1.         PROGRAM MAZES
  2.  
  3. C  PROGRAM TO GENERATE RANDOM MAZES (WITH UNIQUE SOLUTIONS)
  4.  
  5. C  ORIGINAL (BASIC): JACK HAUBER, LOOMIS SCHOOL, WINDSOR, CONNECTICUT
  6. C  MODIFIED (BASIC): D J LEIGH - DECEMBER 1976
  7. C  REWRITTEN (FORTRAN-77): M S OAKES - JANUARY 1986
  8. C  DATE LAST EDITED: 1 AUGUST 1987
  9.  
  10.         INTEGER  I,ILIM,J,JLIM,JSTART,MAXSIZ
  11.         PARAMETER (MAXSIZ = 25)
  12.         INTEGER  WALLS(MAXSIZ,MAXSIZ)
  13.         INTEGER  CHOICE,WAYS,COUNT,SIZE
  14.  
  15.         LOGICAL  AFFIRM
  16.         LOGICAL  LEFT,RIGHT,UP,DOWN,EXIT
  17.         LOGICAL  OK
  18.         LOGICAL*1  BEENTO(MAXSIZ,MAXSIZ)
  19.  
  20.         CHARACTER*3 ROW(MAXSIZ),PATRN1,PATRN2,PATRN3,PATRN4
  21.  
  22. C  PATTERNS FOR PRINTING MAZE
  23.  
  24.         DATA  PATRN1,PATRN2/'--:','  :'/
  25.         DATA  PATRN3,PATRN4/'   ','  I'/
  26.  
  27. C  STATEMENT FUNCTIONS
  28.  
  29. C  INPUT VALIDATION
  30.         OK(WAYS) = (1.LE.WAYS) .AND. (WAYS.LE.MAXSIZ)
  31. C  RANDOM MULTI-WAY BRANCH GENERATOR
  32.         CHOICE(WAYS) = 1 + INT(RANDOM(0) * WAYS)
  33.  
  34. C  START OF EXECUTION
  35.  
  36.         PRINT *,' This program will print out a different maze every'
  37.         PRINT *,' time it is run and guarantees only one path through.'
  38.         PRINT *,' You can choose the dimensions of the maze, i.e. the'
  39.         PRINT *,' number of squares long and the number of squares'
  40.         PRINT *,' wide.  A 25 by 25 maze is the maximum, and any'
  41.         PRINT *,' dimensions up to these limits are O.K.'
  42.  
  43. C  START OF EACH MAZE
  44.  
  45. 100     CONTINUE
  46.         PRINT *
  47.         PRINT *,' Length: '
  48.         READ *, ILIM
  49.         PRINT *,' Width: '
  50.         READ *, JLIM
  51.         IF (.NOT. OK(ILIM) .OR. .NOT. OK(JLIM)) THEN
  52.            PRINT *,' Meaningless dimensions - try again'
  53.            GOTO 100
  54.         ENDIF
  55.         PRINT *
  56.  
  57. C  INITIALIZATION
  58.  
  59.         SIZE = ILIM * JLIM
  60.         EXIT = .FALSE.
  61.         DO 220 I = 1,ILIM
  62.         DO 210 J = 1,JLIM
  63.         BEENTO(I,J) = .FALSE.
  64.         WALLS(I,J) = 0
  65.   210   CONTINUE
  66.   220   CONTINUE
  67.  
  68. C  PICK THE STARTING SQUARE AND PRINT THE TOP BOUNDARY
  69.  
  70.         JSTART = CHOICE(JLIM)
  71.         DO 300 J = 1,JLIM
  72.         IF (J .EQ. JSTART) THEN
  73.            ROW(J) = PATRN2
  74.         ELSE
  75.           ROW(J) = PATRN1
  76.         ENDIF
  77.   300   CONTINUE
  78.         PRINT *, PATRN2,(ROW(J),J=1,JLIM)
  79.  
  80.         I = 1
  81.         J = JSTART
  82.         BEENTO(I,J) = .TRUE.
  83.         COUNT = 1
  84.  
  85. C  START OF MAIN PROCESSING LOOP
  86.  
  87.   400   IF (COUNT.GE.SIZE) GOTO 2000
  88.  
  89.     IF (J.GT.1) THEN
  90.        LEFT = .NOT. BEENTO(I,J-1)
  91.     ELSE
  92.        LEFT = .FALSE.
  93.     ENDIF
  94.     IF (J.LT.JLIM) THEN
  95.        RIGHT = .NOT. BEENTO(I,J+1)
  96.     ELSE
  97.        RIGHT = .FALSE.
  98.     ENDIF
  99.     IF (I.GT.1) THEN
  100.        UP = .NOT. BEENTO(I-1,J)
  101.     ELSE
  102.        UP = .FALSE.
  103.     ENDIF
  104.     IF (I.LT.ILIM) THEN
  105.        DOWN = .NOT. BEENTO(I+1,J)
  106.     ELSE
  107.        DOWN = .NOT. EXIT
  108.     ENDIF
  109.  
  110.         IF (LEFT) THEN
  111.            IF (UP) THEN
  112.               IF (RIGHT) THEN
  113.                  GOTO (1100,1200,1300), CHOICE(3)
  114.           ELSE
  115. C  MUSN'T GO RIGHT
  116.                  IF (DOWN)  GOTO (1100,1200,1400), CHOICE(3)
  117.                  GOTO (1100,1200), CHOICE(2)
  118.               ENDIF
  119.            ELSE
  120. C  MUSN'T GO UP
  121.               IF (RIGHT) THEN
  122.                  IF (DOWN)  GOTO (1100,1300,1400), CHOICE(3)
  123.                  GOTO (1100,1300), CHOICE(2)
  124.               ELSE
  125. C  MUSN'T GO UP OR RIGHT
  126.                  IF (DOWN)  GOTO (1100,1400), CHOICE(2)
  127.                  GOTO 1100
  128.               ENDIF
  129.            ENDIF
  130.         ELSE
  131. C  MUSN'T GO LEFT
  132.            IF (UP) THEN
  133.               IF (RIGHT) THEN
  134.                  IF (DOWN)  GOTO (1200,1300,1400), CHOICE(3)
  135.                  GOTO (1200, 1300), CHOICE(2)
  136.               ELSE
  137. C  MUSN'T GO LEFT OR RIGHT
  138.                  IF (DOWN)  GOTO (1200,1400), CHOICE(2)
  139.                  GOTO 1200
  140.               ENDIF
  141.            ELSE
  142. C  MUSN'T GO LEFT OR UP
  143.               IF (RIGHT) THEN
  144.                  IF (DOWN)  GOTO (1300,1400), CHOICE(2)
  145.                  GOTO 1300
  146.               ELSE
  147. C  MUSN'T GO LEFT OR UP OR RIGHT
  148.                  IF (DOWN)  GOTO 1400
  149. C  CAN'T GO ANYWHERE, SO GROW A NEW BRANCH
  150.                  GOTO 1800
  151.               ENDIF
  152.            ENDIF
  153.         ENDIF
  154.  
  155. C  GO LEFT
  156.  1100   J = J - 1
  157.         WALLS(I,J) = 2
  158.         GOTO 1600
  159.  
  160. C  GO UP
  161.  1200   I = I - 1
  162.         WALLS(I,J) = 1
  163.         GOTO 1600
  164.  
  165. C  GO RIGHT
  166.  1300   IF (WALLS(I,J).EQ.0) THEN
  167.            WALLS(I,J) = 2
  168.         ELSE
  169.            WALLS(I,J) = 3
  170.         ENDIF
  171.         J = J + 1
  172.         GOTO 1600
  173.  
  174. C  GO DOWN
  175.  1400   IF (WALLS(I,J).EQ.0) THEN
  176.            WALLS(I,J) = 1
  177.         ELSE
  178.            WALLS(I,J) = 3
  179.         ENDIF
  180.         IF (I.EQ.ILIM) GOTO 1700
  181.         I = I + 1
  182.  
  183. C  MARK THE LOCATION AS "VISITED"
  184.  1600   COUNT = COUNT + 1
  185.         BEENTO(I,J) = .TRUE.
  186.         GOTO 400
  187.  
  188. C  CREATE AN EXIT, THEN START SCANNING IN TOP-LEFT CORNER
  189.  1700   EXIT = .TRUE.
  190.         I = ILIM
  191.         J = JLIM
  192.  
  193. C  GROW A NEW BRANCH
  194.  1800   IF (J.EQ.JLIM) THEN
  195.            IF (I.EQ.ILIM) THEN
  196.               I = 1
  197.            ELSE
  198.               I = I + 1
  199.            ENDIF
  200.            J = 1
  201.         ELSE
  202.            J = J + 1
  203.         ENDIF
  204.         IF (BEENTO(I,J)) GOTO 400
  205.         GOTO 1800
  206.  
  207. C  CHECK THAT AN EXIT HAS BEEN MADE
  208.  
  209.  2000   IF (.NOT. EXIT) THEN
  210.            J = CHOICE(JLIM)
  211.            WALLS(ILIM,J) = WALLS(ILIM,J) + 1
  212.         ENDIF
  213.  
  214. C  PRINT OUT THE MAZE
  215.  
  216.         DO 2300 I = 1,ILIM
  217.  
  218.         DO 2100 J = 1,JLIM
  219.         IF (WALLS(I,J).LT.2) THEN
  220.            ROW(J) = PATRN4
  221.         ELSE
  222.            ROW(J) = PATRN3
  223.         ENDIF
  224.  2100   CONTINUE
  225.         PRINT*, PATRN4,(ROW(J),J=1,JLIM)
  226.  
  227.         DO 2200 J = 1,JLIM
  228.         IF ((WALLS(I,J).EQ.0).OR.(WALLS(I,J).EQ.2)) THEN
  229.            ROW(J) = PATRN1
  230.         ELSE
  231.            ROW(J) = PATRN2
  232.         ENDIF
  233.  2200   CONTINUE
  234.         PRINT *, PATRN2,(ROW(J),J=1,JLIM)
  235.  
  236.  2300   CONTINUE
  237.         PRINT *
  238.         PRINT *
  239.  
  240. C  POSSIBLY RETURN FOR ANOTHER GO
  241.  
  242.         IF (AFFIRM('Another maze')) GOTO 100
  243.  
  244.         END
  245.