INTEGER BOARD(26),ROLL(2),MOVE(2,4),BOARD1(26) 00001 INTEGER BOARD2(26),SCORE(6),BOARD3(26),TEST(2) 00002 BYTE IBUF(20) 00003 REAL A 00004 T1=SECNDS(0.0) 00005 IF(.NOT.(T1.GT.46800.0.AND.T1.LT.59400.0)) GO TO 32758 00006 WRITE(1,*) 00007 1'Time wasted playing computer games can never be recovered!' 00008 32758 IF(.NOT.(T1.LT.43200.0.AND.T1.GT.30600.0)) GO TO 32757 00008 WRITE(1,*) 00009 1'Time wasted playing computer games can never be recovered!' 00010 32757 I1=T1/2000 00010 I2=SQRT(T1)/10 00011 DO 32756 I=1,(I1/10)+10 00012 ID=RAN(I1,I2) 00012 32756 CONTINUE 00012 9 CALL INIT(BOARD) 00015 CALL PRINTB(BOARD) 00016 WRITE(1,*) 'DO YOU NEED INSTRUCTIONS? ' 00017 READ(1,99)NCHRS,(IBUF(I),I=1,NCHRS) 00018 99 FORMAT(Q,20A1) 00019 IF(IBUF(1).EQ.'N'.OR.IBUF(1).EQ.'n')GOTO 80 00020 WRITE(1,*) 00021 +' THIS IS THE PLAYING BOARD, IT LOOKS DIFFERENT' 00022 WRITE(1,*) 00022 +'FROM THE NORMAL BOARD BECAUSE YOUR OPPONETS SIDE HAS' 00023 WRITE(1,*) 00023 +'BEEN ROTATED AND PLACED TO THE LEFT OF YOUR SIDE. A' 00024 WRITE(1,*) 00024 +'PLUS SIGN REPRESENTS A POINT ON THE BOARD. THERE ARE' 00025 WRITE(1,*) 00025 +'TWO POINTS BY THEMSELVES ON THE LEFT AND RIGHT.' 00026 WRITE(1,*) 00026 +'THESE ARE OCCUPIED BY MEN AFTER THEY HAVE BEEN HIT.' 00027 WRITE(1,*) 00027 +'THE COMPUTER PLAYS RED (SYMBOLIZED AS -R-) AND MOVES' 00028 WRITE(1,*) 00028 +'FROM RIGHT TO LEFT. THE PLAYER USES THE WHITE MEN' 00029 WRITE(1,*) 00029 +'( -W- ) AND MOVES FROM LEFT TO RIGHT.' 00030 WRITE(1,*) 00030 +' THE NUMBERS BELOW THE POINTS ARE USED WHEN' 00031 WRITE(1,*) 00031 +'MOVING YOUR MEN. THE POINTS ARE NUMBERED FROM 1 TO' 00032 WRITE(1,*) 00032 +'26, YOU MUST MENTALLY ADD THE TENS DIGIT, THERE' 00033 WRITE(1,*) 00033 +'WASN T ROOM TO PRINT IT. MOVE ARE MADE BY SPECIFYING' 00034 WRITE(1,*) 00034 +'THE -FROM- POINT AND THE ROLL OF THE DIE. THE' 00035 WRITE(1,*) 00035 +'NUMBERS ARE SEPARATED BY COMMAS. TO MAKE THE -LOVERS' 00036 WRITE(1,*) 00036 +'LEAP- MOVE ON AN OPENING ROLL OF 6 5, YOU WOULD TYPE' 00037 WRITE(1,*) 00037 +'2,6,8,5. THE COMPUTER WOULD THEN MAKE THAT MOVE FOR' 00038 WRITE(1,*) 00038 +'YOU.' 00039 80 CONTINUE 00039 WRITE(1,*)' ' 00040 CALL GETROL(ROLL,I1,I2) 00041 WRITE(1,89) ROLL(1) 00042 89 FORMAT(1X, 'I ROLLED A', I2) 00043 WRITE(1,88) ROLL(2) 00044 88 FORMAT(1X, 'YOU ROLLED A', I2) 00045 IF(ROLL(1)-ROLL(2)) 81,82,83 00046 81 CONTINUE 00047 WRITE(1,*)'YOU GO FIRST' 00048 CALL PRINTB(BOARD) 00049 GO TO 55 00050 82 CONTINUE 00051 WRITE(1,*)'DOUBLES, ROLL AGAIN.' 00052 GO TO 80 00053 83 CONTINUE 00054 WRITE(1,*)'I GO FIRST' 00055 GO TO 4 00056 1 CALL GETROL(ROLL,I1,I2) 00057 4 ISW=0 00058 JSW=0 00059 KSW=0 00060 ISCORE=1000 00061 WRITE(1,2) ROLL 00062 2 FORMAT(1X, 'I ROLL',2I2,'.') 00063 3 CONTINUE 00064 MOVE(1,1)=0 00065 MOVE(2,1)=-ROLL(1) 00066 MOVE(1,2)=0 00067 MOVE(2,2)=-ROLL(2) 00068 10 CONTINUE 00069 CALL MAKNXT(BOARD,BOARD1,MOVE(1,1)) 00070 IF(MOVE(1,1).EQ.-1) GO TO 100 00071 20 CONTINUE 00072 CALL MAKNXT(BOARD1,BOARD2,MOVE(1,2)) 00073 IF(MOVE(1,2).EQ.-1) GO TO 30 00074 CALL EVAL(BOARD2,SCORE) 00075 JSW=1 00076 IF(SCORE(6).GT.ISCORE) GO TO 20 00077 ISCORE=SCORE(6) 00078 DO 32755 I=1,26 00079 BOARD3(I)=BOARD2(I) 00079 32755 CONTINUE 00079 GO TO 20 00082 30 CONTINUE 00083 MOVE(1,2)=0 00084 GO TO 10 00085 50 CONTINUE 00086 IF(JSW.NE.0) GO TO 52 00087 ISCORE=1000 00088 DO 70 J=2,26 00089 MOVE(1,1)=J 00090 MOVE(1,2)=J 00091 I=1 00092 IF(MOVCHK(BOARD,MOVE(1,I)).NE.0) GO TO 71 00093 I=2 00094 IF(MOVCHK(BOARD,MOVE(1,I)).EQ.0) GO TO 70 00095 71 CONTINUE 00096 JSW=1 00097 CALL MAKMOV(BOARD,BOARD2,MOVE(1,I)) 00098 CALL EVAL(BOARD2,SCORE) 00099 IF(SCORE(6).GT.ISCORE) GO TO 70 00100 ISCORE=SCORE(6) 00101 DO 32754 I=1,26 00102 BOARD3(I)=BOARD2(I) 00102 32754 CONTINUE 00102 70 CONTINUE 00105 IF(JSW.NE.0) GO TO 52 00106 WRITE(1,*)'I CANNOT MOVE' 00107 GO TO 53 00108 52 CONTINUE 00109 DO 32753 I=1,26 00110 BOARD(I)=BOARD3(I) 00110 32753 CONTINUE 00110 IF(KSW.NE.0) GO TO 56 00113 KSW=1 00114 IF(ROLL(1).NE.ROLL(2)) GO TO 56 00115 JSW=0 00116 GO TO 3 00117 56 CONTINUE 00118 KSW=0 00119 CALL PRINTB(BOARD) 00120 CALL EVAL(BOARD,SCORE) 00121 IF(SCORE(2).EQ.0) GO TO 54 00122 GO TO 53 00123 54 WRITE(1,*)'I WIN, THANKS FOR THE GAME' 00124 CALL EXIT 00125 GO TO 9 00126 53 CONTINUE 00127 CALL GETROL(ROLL,I1,I2) 00128 55 CONTINUE 00129 CALL INPMOV(BOARD,ROLL) 00130 CALL PRINTB(BOARD) 00131 CALL EVAL(BOARD,SCORE) 00132 IF(SCORE(1).EQ.0) GO TO 65 00133 GO TO 1 00134 65 WRITE(1,*)'YOU WIN, THANKS' 00135 CALL EXIT 00136 GO TO 9 00137 100 CONTINUE 00138 IF(ISW.EQ.1) GO TO 50 00139 MOVE(1,1)=0 00140 MOVE(2,1)=-ROLL(2) 00141 MOVE(1,2)=0 00142 MOVE(2,2)=-ROLL(1) 00143 ISW=1 00144 GO TO 10 00145 END 00146 INTEGER FUNCTION MOVCHK(BOARD,MOVE) 00001 INTEGER IOURS,OFFBRD 00002 INTEGER BOARD(26),MOVE(2),IBRDF,IBRDT 00003 MOVCHK=0 00004 MOVEP=MOVE(1) 00005 MOVER=MOVE(2) 00006 MOVET=MOVEP+MOVER 00007 IBRDF=BOARD(MOVEP) 00008 IBRDT=BOARD(MOVET) 00009 IOURS=0 00010 IF(MOVE(2).LT.0) IOURS=1 00011 OFFBRD=26 00012 IF(IOURS.EQ.0) OFFBRD=1 00013 IF(BOARD(OFFBRD).NE.0.AND.MOVEP.NE.OFFBRD) RETURN 00014 IF(IBRDF.EQ.0) RETURN 00015 IF(ISHFT(IBRDF,-4).NE.IOURS) RETURN 00016 IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100 00017 IF(IBRDT.EQ.0) GO TO 10 00018 IF(ISHFT(IBRDT,-4).EQ.IOURS) GOTO 10 00019 IF(IAND(IBRDT,15).LT.2) GOTO 10 00020 RETURN 00021 10 CONTINUE 00022 MOVCHK=1 00023 RETURN 00024 100 CONTINUE 00025 DO 105 I=1,19 00026 I1=I 00027 IF(IOURS.NE.0) I1=27-I 00028 IF(BOARD(I1).EQ.0) GOTO 105 00029 IF(ISHFT(BOARD(I1),-4).EQ.IOURS) RETURN 00030 105 CONTINUE 00031 IF(MOVET.EQ.26.OR.MOVET.EQ.1) GO TO 110 00032 GO TO (120,130),IOURS+1 00033 WRITE(1,*)'IOURS - ILLEGAL VALUE' 00034 RETURN 00035 120 CONTINUE 00036 MOVEP1=MOVEP-1 00037 IF(MOVEP1.LE.20) GO TO 126 00038 DO 125 I=20,MOVEP1 00039 IF(BOARD(I).EQ.0) GO TO 125 00040 IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN 00041 125 CONTINUE 00042 126 MOVCHK=1 00043 RETURN 00044 130 CONTINUE 00045 MOVEP1=MOVEP+1 00046 IF(MOVEP1.GE.7) GO TO 136 00047 DO 32758 I=MOVEP1,7 00048 IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN 00049 32758 CONTINUE 00050 136 MOVCHK=1 00051 RETURN 00052 110 CONTINUE 00053 MOVCHK=1 00054 RETURN 00055 END 00056 SUBROUTINE NXTMOV(BOARD,MOVE) 00001 INTEGER ROLL,POINT,BOARD(26),MOVE(2) 00002 POINT=MOVE(1) 00003 ROLL=MOVE(2) 00004 IF(POINT.EQ.0) GO TO 100 00005 IOURS=0 00006 IF(ROLL.LT.0) IOURS=1 00007 POINT=POINT+1 00008 DO 10 I=POINT,26 00009 IF(BOARD(I).EQ.0) GO TO 10 00010 IF(ISHFT(BOARD(I),-4).NE.IOURS) GO TO 10 00011 POINT=I 00012 GO TO 200 00013 10 CONTINUE 00014 POINT=-1 00015 GO TO 200 00016 100 CONTINUE 00017 IOURS=0 00018 IF(ROLL.LT.0) IOURS=1 00019 DO 110 I=1,26 00020 IF(BOARD(I).EQ.0) GO TO 110 00021 IF(ISHFT(BOARD(I),-4).NE.IOURS) GOTO 110 00022 POINT=I 00023 GO TO 200 00024 110 CONTINUE 00025 POINT=-1 00026 200 CONTINUE 00027 MOVE(1)=POINT 00028 MOVE(2)=ROLL 00029 RETURN 00030 END 00031 SUBROUTINE GETROL(ROLL,I1,I2) 00001 INTEGER ROLL(2) 00002 ROLL(1)=INT(6.0*RAN(I1,I2))+1 00003 ROLL(2)=INT(6.0*RAN(I1,I2))+1 00004 RETURN 00005 END 00006 SUBROUTINE MAKMOV(OLDBRD,NEWBRD,MOVE) 00001 INTEGER OLDBRD(26),NEWBRD(26),MOVE(2) 00002 DO 10 I=1,26 00003 10 NEWBRD(I)=OLDBRD(I) 00004 MOVEP=MOVE(1) 00005 MOVER=MOVE(2) 00006 MOVET=MOVEP+MOVER 00007 IBRDF=OLDBRD(MOVEP) 00008 IBRDT=OLDBRD(MOVET) 00009 IOURS=ISHFT(IBRDF,-4) 00010 IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100 00011 IF(ISHFT(IBRDF,-4).EQ.IOURS) GO TO 20 00012 WRITE(1,*)'ERROR, MOVING OPPS MAN' 00013 RETURN 00014 20 CONTINUE 00015 IF(ISHFT(IBRDT,-4).NE.IOURS.AND.IBRDT.NE.0) GO TO 200 00016 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00017 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00018 ITEMP=ISHFT(IOURS,4) 00019 NEWBRD(MOVET)=(ITEMP.OR.NEWBRD(MOVET)+1) 00020 RETURN 00021 200 CONTINUE 00022 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00023 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00024 NEWBRD(MOVET)=ISHFT(IOURS,4)+1 00025 OFFBRD=26-IOURS*25 00026 NEWBRD(OFFBRD)=(ISHFT(1-IOURS,4).OR.NEWBRD(OFFBRD)+1) 00027 RETURN 00028 100 CONTINUE 00029 NEWBRD(MOVEP)=NEWBRD(MOVEP)-1 00030 IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0 00031 RETURN 00032 END 00033 SUBROUTINE PRINTB(BOARD) 00001 INTEGER BOARD(26),PRNTBF(26) 00002 INTEGER ABLANK, AR, AW 00003 DATA ABLANK/' '/, AR/'R'/, AW/'W'/ 00004 DO 10 I=1,15 00005 COUNT=16-I 00006 PFLAG=0 00007 DO 20 J=1,26 00008 PRNTBF(J)=ABLANK 00009 IF(IAND(BOARD(J),15).LT.COUNT) GO TO 20 00010 PRNTBF(J)=AR 00011 IF(ISHFT(BOARD(J),-4).EQ.0) PRNTBF(J)=AW 00012 PFLAG=1 00013 20 CONTINUE 00014 IF(PFLAG.EQ.0) GO TO 10 00015 WRITE(1,30) PRNTBF 00016 30 FORMAT(2X,A1,2X,6A2,1X,6A2,2X,6A2,1X,6A2,1X,A1) 00017 10 CONTINUE 00018 WRITE(1,*) 00019 $'^ + + + + + + + + + + + + + + + + + + + + + + + + ^' 00020 WRITE(1,*) 00020 $'1 2 3 4 5 6 7 8 9 | 11| 13 | 15| 17| 19 | 21| 23| 25 |' 00021 WRITE(1,*) 00021 $' 10 12 14 16 18 20 22 24 26' 00022 RETURN 00022 END 00023 SUBROUTINE INIT(BOARD) 00001 INTEGER BOARD(26) 00002 RED=16 00003 WHITE=0 00004 DO 10 I=1,26 00005 10 BOARD(I)=0 00006 BOARD(2)=WHITE+2 00007 BOARD(7)=RED+5 00008 BOARD(9)= RED+3 00009 BOARD(13)=WHITE+5 00010 BOARD(14)=RED+5 00011 BOARD(18)=WHITE+3 00012 BOARD(20)=WHITE+5 00013 BOARD(25)=RED+2 00014 RETURN 00015 END 00016 SUBROUTINE INPMOV(BOARD,ROLL) 00001 INTEGER ROLL(2),MOVE(2,4),BOARD(26),BOARD1(26),BOARD2(26) 00002 INTEGER TEST(2) 00003 MOVSW=0 00004 WRITE(1,3) ROLL 00005 3 FORMAT(1X, 'YOU ROLL',2I2,'.') 00006 WRITE(1,300) 00007 300 FORMAT(' Your move?>',$) 00008 GO TO 4 00009 61 WRITE(1,1) 00010 1 FORMAT(1X, 'Try again>'$) 00011 4 READ(1,2,END=99,ERR=61) MOVE 00012 2 FORMAT(8I6) 00013 IF(BOARD(1).EQ.0) GO TO 67 00014 TEST(1)=1 00015 TEST(2)=ROLL(1) 00016 IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67 00017 TEST(2)=ROLL(2) 00018 IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67 00019 WRITE(1,*)'YOU HAVE NO MOVE' 00020 RETURN 00021 67 CONTINUE 00022 IF(MOVE(1,1).EQ.0) RETURN 00023 IF(MOVE(1,2).NE.0) GO TO 64 00024 IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61 00025 CALL MAKMOV(BOARD,BOARD,MOVE(1,1)) 00026 GOTO 68 00027 64 IF(MOVE(2,1).EQ.ROLL(1).AND.MOVE(2,2).EQ.ROLL(2)) GO TO 62 00028 IF(MOVE(2,1).EQ.ROLL(2).AND.MOVE(2,2).EQ.ROLL(1)) GO TO 62 00029 GO TO 61 00030 62 IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61 00031 CALL MAKMOV(BOARD,BOARD1,MOVE(1,1)) 00032 IF(MOVCHK(BOARD1,MOVE(1,2)).EQ.0) GO TO 61 00033 CALL MAKMOV(BOARD1,BOARD,MOVE(1,2)) 00034 68 IF(ROLL(1).EQ.ROLL(2).AND.MOVSW.EQ.0) GO TO 80 00035 RETURN 00036 80 CONTINUE 00037 WRITE(1,*)'INPUT NEXT MOVE' 00038 MOVSW=1 00039 GO TO 4 00040 99 WRITE(1,*)'Nice Playing With You.' 00041 STOP 00042 END 00043 SUBROUTINE MAKNXT(BOARD,NEWBRD,MOVE) 00001 INTEGER BOARD(26),NEWBRD(26),MOVE(2) 00002 10 CALL NXTMOV(BOARD,MOVE) 00003 IF(MOVE(1).EQ.-1) RETURN 00004 IF(MOVCHK(BOARD,MOVE).EQ.0) GO TO 10 00005 CALL MAKMOV(BOARD,NEWBRD,MOVE) 00006 RETURN 00007 END 00008 SUBROUTINE EVAL(BOARD,STATUS) 00001 INTEGER BOARD(26),STATUS(6) 00002 DATA LUTR /6/ 00003 DO 5 I=1,6 00004 5 STATUS(I)=0 00005 DO 10 I=1,25 00006 IF(BOARD(I).EQ.0) GO TO 10 00007 IF(ISHFT(BOARD(I),-4).NE.0) GO TO 10 00008 STATUS(1)=STATUS(1)+IAND(BOARD(I),15)*(26-I) 00009 10 CONTINUE 00010 DO 20 I=2,26 00011 IF(BOARD(I).EQ.0) GO TO 20 00012 IF(ISHFT(BOARD(I),-4).EQ.0) GO TO 20 00013 STATUS(2)=STATUS(2)+IAND(BOARD(I),15)*(I-1) 00014 20 CONTINUE 00015 DO 30 I=2,25 00016 IBRDP=BOARD(I) 00017 IF(IBRDP.EQ.0) GOTO 30 00018 IF(ISHFT(IBRDP,-4).NE.0) GO TO 30 00019 IF(IAND(IBRDP,15).NE.1) GO TO 30 00020 K=J+12 00021 IF(K.GT.25) K=25 00022 DO 35 J=I,K 00023 IF(ISHFT(BOARD(J),-4).NE.1) GO TO 35 00024 STATUS(3)=STATUS(3)+2-(J-I)/6 00025 35 CONTINUE 00026 30 CONTINUE 00027 VUN=0 00028 DO 40 I=1,25 00029 IBRDP=BOARD(I) 00030 IF(IBRDP.EQ.0) GOTO 40 00031 IF(ISHFT(IBRDP,-4).NE.1) GO TO 40 00032 IF(IAND(IBRDP,15).GT.1) GO TO 40 00033 ISW=0 00034 IF(I.GE.20) ISW=1 00035 K=I-12 00036 IF(K.LT.1) K=1 00037 VUN=0 00038 DO 45 J=K,I 00039 IF(BOARD(J).EQ.0) GOTO 45 00040 IF(ISHFT(BOARD(J),-4).NE.0) GO TO 45 00041 RANGE=I-J 00042 VUN=VUN+(2-(RANGE-1)/6) 00043 45 CONTINUE 00044 IF(VUN.GT.5) VUN=5 00045 ADV=(31-I)/6 00046 POCC=0 00047 DO 49 K=20,25 00048 IF(BOARD(K).EQ.0) GOTO 49 00049 IF(ISHFT(BOARD(K),-4).NE.0) GO TO 49 00050 IF(IAND(BOARD(K),15).LT.2) GO TO 49 00051 POCC=POCC+1 00052 49 CONTINUE 00053 POCC=POCC/3+1 00054 IF(ADV.EQ.1.AND.POCC.LE.2) VUN=VUN/2 00055 NETVUN=VUN*ADV*POCC 00056 STATUS(4)=STATUS(4)+NETVUN 00057 40 CONTINUE 00058 STATUS(5)=STATUS(1)-STATUS(2)+STATUS(3) 00059 STATUS(6)=STATUS(2)-STATUS(1)+STATUS(4) 00060 IOURS=1 00061 PCNT=0 00062 MCNT=0 00063 DO 50 I=1,26 00064 IBP=BOARD(I) 00065 CNT=IAND(IBP,15) 00066 IF(IBP.EQ.0) GO TO 50 00067 IF(ISHFT(IBP,-4).NE.IOURS) GOTO 50 00068 MCNT=MCNT+CNT 00069 IF(CNT.GT.3) STATUS(6)=STATUS(6)+CNT-3 00070 IF(CNT.LT.2) GO TO 50 00071 PCNT=PCNT+1 00072 50 CONTINUE 00073 STATUS(6)=STATUS(6)-PCNT+MCNT*3 00074 RETURN 00075 END 00076