##MISC 4 MAZE (W5UNPACK-ED) // EXEC FWCLG,PARM='NOSOURCE,NOEXT' //SYSIN DD * CPARM SOURCE=OFF IMPLICITINTEGER(A-Z) 00000050 REALF,RAND 00000100 CHARACTER*1LINE(121)/121*' '/ 00000150 DIMENSIONGRID(27,42),SUR(4),NOSUR(4),MAZE(27,42,2) 00000200 DATAGRID/1134*0/,MAZE/2268*1/,CLEAN/2000/ 00000250 CALLTIME(K) 00000300 CALLSETBAS(K) 00000350 READ,LEN,WID,TRACE 00000400 IF((LEN.LT.2.OR.LEN.GT.25).OR.(WID.LT.2.OR.WID.GT.40))STOP 00000450 LEN1=LEN+1 00000500 LEN2=LEN+2 00000550 WID1=WID+1 00000600 WID2=WID+2 00000650 DO301I=1,27 00000700 301 GRID(I,1)=-1 00000750 DO302I=1,42 00000800 302 GRID(1,I)=-1 00000850 DO303I=2,LEN2 00000900 303 GRID(I,WID2)=-1 00000950 DO304I=2,WID2 00001000 304 GRID(LEN2,I)=-1 00001050 F=FLOAT(WID) 00001100 START=RAND(F)+2 00001150 A=2 00001200 B=START 00001250 GRID(2,B)=GRID(1,B)=SQR=1 00001300 DIR=DIR2=3 00001350 DIS=TURNS=0 00001400 20 DO309I=1,4 00001450 309 NOSUR(I)=0 00001500 CALLSURRND(SUR,GRID,A,B) 00001550 10 DO310I=1,4 00001600 IF(SUR(I).NE.0)NOSUR(I)=1 00001650 IF(SUR(I).NE.-1)GOTO310 00001700 IF(I.EQ.3)NOSUR(3)=0 00001750 IF(I.EQ.3)NOSUR(1)=1 00001800 IF(A.EQ.2.AND.B.LT.START)NOSUR(2)=1 00001850 IF(A.EQ.2.AND.B.GT.START)NOSUR(4)=1 00001900 IF(B.EQ.2.OR.B.EQ.WID1)NOSUR(1)=1 00001950 310 CONTINUE 00002000 IF(IABS(TURNS).EQ.3)NOSUR(3)=1 00002050 I3=0 00002100 DO320I=1,4 00002150 IF(NOSUR(I).EQ.0)I3=I3+1 00002200 320 CONTINUE 00002250 IF(I3.NE.0)GOTO311 00002300 GRID(A,B)=1000 00002350 IF(DIR2.GT.2)OPP=DIR2-2 00002400 IF(DIR2.LE.2)OPP=DIR2+2 00002450 CALLNEXT(OPP,A,B) 00002500 SQR=SQR-1 00002550 CALLSURRND(SUR,GRID,A,B) 00002600 DO322I=1,4 00002650 IF(SUR(I).EQ.SQR-1)GOTO323 00002700 322 CONTINUE 00002750 323 IF(I.GT.2)OPP=I-2 00002800 IF(I.LE.2)OPP=I+2 00002850 DIS=0 00002900 IF(OPP.EQ.DIR2)GOTO20 00002950 IF(DIR2-1.EQ.OPP.OR.(DIR2.EQ.1.AND.OPP.EQ.4))TURNS=TURNS-1 00003000 IF(DIR2+1.EQ.OPP.OR.(DIR2.EQ.4.AND.OPP.EQ.1))TURNS=TURNS+1 00003050 DIR2=OPP 00003100 324 GOTO20 00003150 311 IF(DIS.NE.0)GOTO330 00003200 DIR=RAND(5.)+1 00003250 IF(DIR.EQ.5)DIR=1 00003300 IF(DIR.EQ.5.AND.SQR.GT.WID*2)DIR=3 00003350 330 IF(NOSUR(DIR).EQ.0)GOTO335 00003400 DIS=0 00003450 GOTO311 00003500 335 IF(DIS.NE.0)GOTO340 00003550 DIS=RAND(4.)+1 00003600 340 DIS=DIS-1 00003650 CALLNEXT(DIR,A,B) 00003700 IF(DIR.EQ.DIR2)GOTO345 00003750 IF(DIR-1.EQ.DIR2.OR.(DIR.EQ.1.AND.DIR2.EQ.4))TURNS=TURNS+1 00003800 IF(DIR+1.EQ.DIR2.OR.(DIR.EQ.4.AND.DIR2.EQ.1))TURNS=TURNS-1 00003850 DIR2=DIR 00003900 345 SQR=SQR+1 00003950 IF(GRID(A,B).EQ.-1)GOTO350 00004000 GRID(A,B)=SQR 00004050 GOTO20 00004100 350 PRINT,'FINISHED PATH!!!!!!' 00004150 DO351I=2,LEN1 00004200 DO351I2=2,WID1 00004250 351 IF(GRID(I,I2).EQ.1000)GRID(I,I2)=0 00004300 GRID(A,B)=MAX=SQR 00004350 LAST=B 00004400 SQR=1 00004450 A=2 00004500 B=START 00004550 375 CALLSURRND(SUR,GRID,A,B) 00004600 DO370I=1,4 00004650 IF(SUR(I).EQ.SQR+1)GOTO380 00004700 370 CONTINUE 00004750 380 CALLNEXT(I,A,B) 00004800 CALLLASSID(I,MAZE,A,B) 00004850 SQR=SQR+1 00004900 IF(SQR.EQ.MAX)GOTO385 00004950 GOTO375 00005000 385 A=J=LEN1 00005050 B=J2=LAST 00005100 SQR=MAX-1 00005150 430 IF(INT(RAND(3.)+1).EQ.3)GOTO390 00005200 DIS=0 00005250 SQR1=1 00005300 387 CALLSURRND(SUR,GRID,J,J2) 00005350 I3=0 00005400 DO395I=1,4 00005450 NOSUR(I)=1 00005500 IF(SUR(I).NE.0)GOTO395 00005550 NOSUR(I)=0 00005600 I3=I3+1 00005650 395 CONTINUE 00005700 IF(I3.EQ.0)GOTO390 00005750 IF(DIS.NE.0)GOTO405 00005800 410 DIR=RAND(4.)+1 00005850 405 IF(NOSUR(DIR).EQ.0)GOTO415 00005900 DIS=0 00005950 GOTO410 00006000 415 IF(DIS.NE.0)GOTO420 00006050 DIS=RAND(4.)+1 00006100 420 DIS=DIS-1 00006150 CALLNEXT(DIR,J,J2) 00006200 CALLLASSID(DIR,MAZE,J,J2) 00006250 GRID(J,J2)=1000 00006300 I=WID/3+1 00006350 IF(SQR1.EQ.I)GOTO390 00006400 SQR1=SQR1+1 00006450 GOTO387 00006500 390 CALLSURRND(SUR,GRID,A,B) 00006550 DO435I=1,4 00006600 IF(SUR(I).EQ.SQR-1)GOTO440 00006650 435 CONTINUE 00006700 440 SQR=SQR-1 00006750 IF(SQR.EQ.1)GOTO500 00006800 CALLNEXT(I,A,B) 00006850 J=A 00006900 J2=B 00006950 GOTO430 00007000 500 DO510A=2,LEN1 00007050 DO510B=2,WID1 00007100 IF(GRID(A,B).NE.0)GOTO510 00007150 J=A 00007200 J2=B 00007250 520 GRID(J,J2)=CLEAN 00007300 CALLSURRND(SUR,GRID,J,J2) 00007350 DO525I=1,4 00007400 NOSUR(I)=0 00007450 IF(SUR(I).NE.0)NOSUR(I)=1 00007500 525 CONTINUE 00007550 I3=0 00007600 DO530I=1,4 00007650 IF(NOSUR(I).EQ.0)I3=I3+1 00007700 530 CONTINUE 00007750 IF(I3.EQ.0)GOTO535 00007800 540 DIR=RAND(4.)+1 00007850 IF(NOSUR(DIR).NE.0)GOTO540 00007900 CALLNEXT(DIR,J,J2) 00007950 CALLLASSID(DIR,MAZE,J,J2) 00008000 GOTO520 00008050 535 CLEAN=CLEAN+1 00008100 510 CONTINUE 00008150 DO610A=2,LEN1 00008200 DO610B=2,WID1 00008250 IF(GRID(A,B).LT.2000)GOTO610 00008300 CALLSURRND(SUR,GRID,A,B) 00008350 I3=0 00008400 DO620I=1,4 00008450 NOSUR(I)=1 00008500 IF(SUR(I).NE.1000)GOTO620 00008550 NOSUR(I)=0 00008600 I3=I3+1 00008650 620 CONTINUE 00008700 IF(I3.EQ.0)GOTO610 00008750 J=A 00008800 J2=B 00008850 625 DIR=RAND(4.)+1 00008900 IF(NOSUR(DIR).NE.0)GOTO625 00008950 CALLNEXT(DIR,J,J2) 00009000 CALLLASSID(DIR,MAZE,J,J2) 00009050 SQR=GRID(A,B) 00009100 DO630J=2,LEN1 00009150 DO630J2=2,WID1 00009200 IF(GRID(J,J2).EQ.SQR)GRID(J,J2)=1999 00009250 630 CONTINUE 00009300 610 CONTINUE 00009350 1000 LINE(1)=':' 00009400 WRITE(6,1002) 00009450 1002 FORMAT (1H1) 00009500 DO1001I=1,WID 00009550 I2=I*3-1 00009600 IF(I.EQ.START-1)GOTO1001 00009650 LINE(I2)='-' 00009700 LINE(I2+1)='-' 00009750 1001 LINE(I2+2)=':' 00009800 WRITE(6,1020)LINE 00009850 1020 FORMAT (1X,121A1) 00009900 DO1005I=2,LEN1 00009950 DO1005I2=1,2 00010000 DO1010I3=1,121 00010050 1010 LINE(I3)=' ' 00010100 IF(I2.EQ.2)GOTO1015 00010150 LINE(1)='|' 00010200 DO1025I3=2,WID1 00010250 I4=I3*3-2 00010300 IF(MAZE(I,I3,1).EQ.1)LINE(I4)='|' 00010350 IF(TRACE.NE.2)GOTO1025 00010400 IF(GRID(I,I3).GE.1000.OR.GRID(I,I3).LT.1)GOTO1025 00010450 LINE(I4-2)='*' 00010500 LINE(I4-1)='*' 00010550 1025 CONTINUE 00010600 GOTO1005 00010650 1015 LINE(1)=':' 00010700 DO1030I3=2,WID1 00010750 I4=(I3-1)*3-1 00010800 IF(MAZE(I,I3,2).EQ.0)GOTO1030 00010850 LINE(I4)='-' 00010900 LINE(I4+1)='-' 00010950 1030 LINE(I4+2)=':' 00011000 1005 WRITE(6,1020)LINE 00011050 IF(TRACE.EQ.0.OR.TRACE.EQ.2)STOP 00011100 TRACE=2 00011150 GOTO1000 00011200 END 00011250 SUBROUTINESURRND(DSUR,DGRID,DA,DB) 00011300 INTEGERDSUR(4),DGRID(27,42),DA,DB 00011350 DSUR(1)=DGRID(DA-1,DB) 00011400 DSUR(2)=DGRID(DA,DB+1) 00011450 DSUR(3)=DGRID(DA+1,DB) 00011500 DSUR(4)=DGRID(DA,DB-1) 00011550 RETURN 00011600 END 00011650 SUBROUTINENEXT(DDIR,DA,DB) 00011700 INTEGERDDIR,DA,DB 00011750 IF(DDIR.EQ.1)DA=DA-1 00011800 IF(DDIR.EQ.2)DB=DB+1 00011850 IF(DDIR.EQ.3)DA=DA+1 00011900 IF(DDIR.EQ.4)DB=DB-1 00011950 RETURN 00012000 END 00012050 SUBROUTINELASSID(DDIR,DMAZE,DA,DB) 00012100 INTEGERDMAZE(27,42,2),DA,DB,DDIR 00012150 IF(DDIR.EQ.1)DMAZE(DA,DB,2)=0 00012200 IF(DDIR.EQ.2)DMAZE(DA,DB-1,1)=0 00012250 IF(DDIR.EQ.3)DMAZE(DA-1,DB,2)=0 00012300 IF(DDIR.EQ.4)DMAZE(DA,DB,1)=0 00012350 RETURN 00012400 END 00012450 //DATA.INPUT DD * 25 40 0 .. .