C THIS PROGRAM PLAYS THREE DIMENSIONAL TIC-TAC-TOE ON A VT52 CRT. C WRITTEN BY NORM PERRON, DIGITAL, EL SEGUNDO, CA. INTEGER SUM(76),ROW(304),WAIT(20),TEST(3,14) DIMENSION MOVE(64),LAST(4) COMMON MOVE,SUM,ROW,WAIT,TEST,M1,M2,M3 DATA ROW/ 1 22,43,64,01,23,42,61,04,26,39,52,13,27,38,49,16,22,42,62,02,23,43 2,63,03,23,38,53,08,27,42,57,12,26,38,50,14,27,39,51,15,22,39,56,05 3,26,43,60,09,22,38,54,06,23,39,55,07,26,42,58,10,27,43,59,11,22,23 4,24,21,26,27,28,25,22,26,30,18,23,27,31,19,22,27,32,17,23,26,29,20 5,38,39,40,37,42,43,44,41,38,42,46,34,39,43,47,35,38,43,48,33,39,42 6,45,36,61,01,21,41,64,04,24,44,49,04,19,34,61,16,31,46,49,13,25,37 7,52,16,28,40,52,01,18,35,64,13,30,47,49,01,17,33,52,04,20,36,61,13 8,29,45,64,16,32,48,04,01,02,03,16,13,14,15,13,01,05,09,16,04,08,12 9,16,01,06,11,13,04,07,10,52,49,50,51,64,61,62,63,61,49,53,57,64,52 A,56,60,64,49,54,59,61,52,55,58,18,34,50,02,19,35,51,03,21,37,53,05 B,24,40,56,08,25,41,57,09,28,44,60,12,30,46,62,14,31,47,63,15,06,07 C,08,05,10,11,12,09,06,10,14,02,07,11,15,03,18,19,20,17,30,31,32,29 D,21,25,29,17,24,28,32,20,34,35,36,33,46,47,48,45,37,41,45,33,40,44 E,48,36,54,55,56,53,58,59,60,57,54,58,62,50,55,59,63,51/ DATA WAIT/ 1 22,43,23,42,26,39,27,38,01,64,13,52,04,61,16,49,22,43,23,42/ DATA TEST/ 1 04,-1,-1,15,-1,-1,03,-1,-1,10,10,-1,10,05,10,02,02,-1,02,01,02,02 2,01,01,02,00,02,05,05,10,05,05,05,05,00,10,05,00,05,-1,-1,-1/ DATA IESC,ICHRY,ICHRJ,IYES/"33,'Y','J','Y '/ 89 FORMAT(A1) 90 FORMAT(I3) 91 FORMAT('$'4A1,'YOU WIN ON',4I4,' AFTER',I4,' MOVES. ' 1 'DO YOU WANT TO PLAY AGAIN?',2A1) 92 FORMAT('$',4A1,'I WON ON',4I4,' AFTER',I4' MOVES.' 1 ' DO YOU WANT TO TRY AGAIN ',2A1) 93 FORMAT('$',4A1,'COME ON NOW, THAT MOVE IS ILLEGAL, ' 1 'HIT TO CONTINUE',2A1) 94 FORMAT('$',4A1,'TYPE IN YOUR MOVE AS LEVEL, COLUMN, ROW ',2A1) 96 FORMAT('$',4A1,'TIE GAME, HIT TO RESTART',2A1) 98 FORMAT(1X,6A1) 99 FORMAT(1X,4A1,I3) NTYP=5 KEYBD=5 4 K1=1 CALL SKELTN DO 1 I=1,64 1 MOVE(I)=0 NUM=0 2 ILIN="66 ICOL="40 WRITE(NTYP,94)IESC,ICHRY,ILIN,ICOL,IESC,ICHRJ READ(KEYBD,90)NEXT NUM=NUM+1 ILIN="64 ICOL="40+23 WRITE(NTYP,99)IESC,ICHRY,ILIN,ICOL,NEXT IF(NEXT)19,3,6 6 IF(NEXT-999)29,28,28 28 CALL EXIT 29 K1=NEXT/100 K3=NEXT-100*K1 K2=K3/10 K3=K3-10*K2 IF(K1)8,8,22 22 IF(K1-4)23,23,8 23 IF(K2)8,8,24 24 IF(K2-4)25,25,8 25 IF(K3)8,8,26 26 IF(K3-4)7,7,8 7 NEXTM=NEXT NEXT=16*(K1-1)+4*(K2-1)+K3 IF(MOVE(NEXT))9,9,8 8 ILIN="65 ICOL="40 WRITE(NTYP,93)IESC,ICHRY,ILIN,ICOL,IESC,ICHRJ READ(NTYP,90) WRITE(NTYP,98)IESC,ICHRY,ILIN,ICOL,IESC,ICHRJ GO TO 2 9 MOVE(NEXT)=1 CALL DISPLY(NEXTM,1) 3 CALL STRAT IF(M3-2)17,17,18 17 K3=4*(M1-1) DO 11 I=1,4 K2=I+K3 11 CALL BOARD(ROW(K2),LAST(I)) IF(M3-1)15,15,16 15 DO 31 I=1,4 31 CALL DISPLY(LAST(I),1) ILIN="65 ICOL="40 WRITE(NTYP,91)IESC,ICHRY,ILIN,ICOL,LAST,NUM,IESC,ICHRJ GO TO 20 16 DO 30 I=1,4 30 CALL DISPLY(LAST(I),0) ILIN="65 ICOL="40 WRITE(NTYP,92)IESC,ICHRY,ILIN,ICOL,LAST,NUM,IESC,ICHRJ 20 READ(5,89)I IF(I.NE.IYES)GOTO 28 GO TO 4 18 IF(M1)12,12,13 12 DO 14 I=K1,20 M1=WAIT(I) IF(MOVE(M1))13,13,14 14 CONTINUE 19 ILIN="65 ICOL="40 WRITE(NTYP,96)IESC,ICHRY,ILIN,ICOL,IESC,ICHRJ READ(NTYP,90) GO TO 4 13 MOVE(M1)=5 CALL BOARD(M1,M1) CALL BOARD(M2,M2) ILIN="64 ICOL="50+57 WRITE(NTYP,99)IESC,ICHRY,ILIN,ICOL,M1 CALL DISPLY(M1,0) GO TO 2 END SUBROUTINE SKELTN DIMENSION IHOM(4) DATA IHOM/"33,'H',"33,'J'/ DATA IYES/'Y '/ IF(IPASS.NE.0)GO TO 50 IPASS=1 WRITE(5,9)(IHOM(I),I=1,4) WRITE(5,1) 1 FORMAT(' THIS PROGRAM PLAYS THREE DIMENSIONAL TIC-TAC-TOE ON A'/ 1 ' BOARD CONSISTING OF 64 SQUARES ARRANGED ON 4 LEVELS'/ 2 ' OF 16 (4X4) SQUARES EACH. IF YOU WANT AN EXPLINATION'/ 3 ' OF HOW THE GAME IS PLAYED, TYPE YES. IF YOU KNOW HOW'/ 4 ' TO PLAY, TYPE NO AND NO EXPLINATION WILL BE PROVIDED.') READ(5,2)I 2 FORMAT(A1) IF(I.NE.IYES)GOTO 50 WRITE(5,3) 3 FORMAT(' THE PURPOSE OF THE GAME IS TO GET 4 MOVES IN A ROW.'/ 1 ' WINNING ROWS MAY BE SET UP VERTICALLY, HORIZONTALLY,'/ 2 ' OR DIAGONALLY IN ANY DIRECTION. TO ENTER YOUR MOVE,'/ 3 ' TYPE IN A 3-DIGIT NUMBER. FOR EXAMPLE 243 WOULD BE'/ 4 ' 2ND LEVEL, 4TH COLUMN, 3RD ROW. TO LET ME MOVE FIRST'/ 5 ' YOU CAN SKIP YOUR MOVE BY TYPING IN ZERO (000). WHEN'/ 6 ' YOU WISH TO START A NEW GAME, TYPE IN A NEGATIVE MOVE'/ 7 ' SUCH AS -11. TO GET OFF THE COMPUTER TYPE IN A 999.'/ 8 ' HIT THE RETURN KEY WHEN YOU ARE READY') READ(5,9) 50 WRITE(5,9)(IHOM(I),I=1,4) 9 FORMAT(1X,4A1) DO 100 I=1,3 DO 75 J=1,3 75 WRITE(5,10) 10 FORMAT( 1 ' I I I I I I ', 2 ' I I I I I I') C WRITE(5,11) C11 FORMAT( C 1 ' XX I XX I XX I XX XX I XX I XX I XX ', C 2 ' XX I XX I XX I XX XX I XX I XX I XX') WRITE(5,11)I,I,I,I,I,I,I,I,I,I,I,I,I,I,I,I C11 FORMAT( C 1 ' 1',I1,'1I 1',I 1,'2I 1',I1,'3I 1',I1,'4', C 2 ' 2',I1,'1I 2',I1,'2I 2',I1,'3I 2',I1,'4 ' C 3 ' 3',I1,'1I 3',I1,'2I 3',I1,'3I 3',I1,'4', C 4 ' 4',I1,'1I 4',I1,'2I 4',I1,'3I4',I1,'4') 11 FORMAT( 1 ' 11',I1,'I 12',I1,'I 13',I1,'I 14',I1, 2 ' 21',I1,'I 22',I1,'I 23',I1,'I 24',I1, 3 ' 31',I1,'I 32',I1,'I 33',I1,'I 34',I1, 4 ' 41',I1,'I 42',I1,'I 43',I1,'I44',I1) 100 WRITE(5,12) 12 FORMAT( 1 ' ---+----+----+---- ----+----+----+---- ', 2 '----+----+----+---- ----+----+----+---') DO 125 J=1,3 125 WRITE(5,10) I=4 WRITE(5,11)I,I,I,I,I,I,I,I,I,I,I,I,I,I,I,I WRITE(5,13) 13 FORMAT(' HUMAN''S LAST MOVE WAS ' 1 'COMPUTER''S LAST MOVE WAS') RETURN END SUBROUTINE DISPLY (ICORD,ILETR) DATA IESC,ICHRY/"33,'Y'/ K1=ICORD/100 K3=ICORD-100*K1 K2=K3/10 K3=K3-10*K2 ILIN=((K3-1)*5)+"41 ICOL=((K2-1)*5)+((K1-1)*21)+"40 C WRITE(5,999)K1,K2,K3,ILIN,ICOL,ICORD 999 FORMAT(' K1,K2,K3=',3I2,' ILIN,ICOL= ',2I4,' ICORD=',I5) K1=ILIN+1 IF(ILETR.EQ.0)GOTO 10 WRITE(5,100)IESC,ICHRY,ILIN,ICOL,IESC,ICHRY,K1,ICOL 100 FORMAT(1X,4A1,'XX',4A1,'XX') RETURN 10 WRITE(5,101)IESC,ICHRY,ILIN,ICOL,IESC,ICHRY,K1,ICOL 101 FORMAT(1X,4A1,'OO',4A1,'OO') RETURN END SUBROUTINE STRAT INTEGER SUM(76),ROW(304),WAIT(20),TEST(3,14),TEST1,TEST2,TEST3 DIMENSION MOVE(64) COMMON MOVE,SUM,ROW,WAIT,TEST,M1,M2,M3 DO 15 J1=1,76 SUM(J1)=0 K2=4*J1 L2=K2-3 DO 15 J2=L2,K2 J3=ROW(J2) 15 SUM(J1)=SUM(J1)+MOVE(J3) DO 21 J1=1,14 M3=J1 TEST1=TEST(1,J1) IF(TEST1)21,2,2 2 TEST2=TEST(2,J1) TEST3=TEST(3,J1) DO 22 J2=1,76 IF(SUM(J2)-TEST1)22,3,22 3 IF(J1-2)18,18,4 4 K3=4*J2 L3=K3-3 DO 23 J3=L3,K3 M1=ROW(J3) IF(MOVE(M1))23,5,23 5 IF(TEST2)17,10,10 10 DO 24 J4=1,76 IF(SUM(J4)-TEST2)24,6,24 6 IF(J4-J2)7,24,7 7 K5=4*J4 L5=K5-3 DO 25 J5=L5,K5 IF(M1-ROW(J5))25,8,25 8 IF(TEST3)17,9,9 9 DO 26 J6=L5,K5 M2=ROW(J6) IF(MOVE(M2))26,11,26 11 DO 27 J7=1,76 IF(SUM(J7)-TEST3)27,12,27 12 IF(J7-J2)13,27,13 13 IF(J7-J4)14,27,14 14 K8=4*J7 L8=K8-3 DO 28 J8=L8,K8 IF(M2-ROW(J8))28,16,28 28 CONTINUE 27 CONTINUE 26 CONTINUE 25 CONTINUE 24 CONTINUE 23 CONTINUE 22 CONTINUE 21 CONTINUE M1=0 GOTO 17 18 M1=J2 17 M2=0 16 RETURN END SUBROUTINE BOARD(I,NEWMV) IF(I)1,1,2 1 NEWMV=I RETURN 2 L1=(I-1)/16 L2=I-16*L1 L3=(L2-1)/4 NEWMV=100*(L1+1)+10*(L3+1)+L2-4*L3 RETURN END