C C C OTHELLO C C INTEGER OC INTEGER OCA INTEGER B(10,10),DIR(30,8),DRSPON(2) INTEGER IAA(8),JAA(8),MOVESI(30) INTEGER MOVESJ(30),LC(30),NFLIP(30) COMMON /TWO/ OC DATA DRSPON /'YE','NO'/ DATA IAA /-1,-1,-1,0,1,1,1,0/ DATA JAA /-1,0,1,1,1,0,-1,-1/ 22 DO 10 I=1,10 DO 10 J=1,10 B(I,J)=0 IF(I.EQ.1.OR.I.EQ.10) B(I,J)=100 10 IF(J.EQ.1.OR.J.EQ.10) B(I,J)=100 B(5,5)=1 B(5,6)=-1 B(6,5)=-1 B(6,6)=1 CALL BOARDP(B,0,0) WRITE(7,601) 601 FORMAT(//,1X,'WELCOME TO THE GAME OF OTHELLO. DO YOU WISH TO', 1 /, ' GO FIRST?? YOU ARE WHITE IF YOU ARE FIRST.',5X,$) READ(5,9999) IANS 9999 FORMAT(A2) OC=1 IF(IANS.EQ.DRSPON(2)) GO TO 11 CALL HANDIC(OC,B,DRSPON,NHD) NM=NHD 8 IF(NM.EQ.60) GO TO 15 CALL MOVEG(B,-OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA,IM,NOMVE,NFLIP) IF(IM.EQ.0) GO TO 12 WRITE(7,713) 713 FORMAT(//,1X,'WHAT IS YOUR MOVE (I,J) ??',5X,$) 14 READ(5,9998) MOVEI,MOVEJ 9998 FORMAT(2I5) MOVEJ=MOVEJ+1 MOVEI=MOVEI+1 DO 9 I=1,IM IF(MOVESI(I).EQ.MOVEI.AND.MOVESJ(I).EQ.MOVEJ) GO TO 13 9 CONTINUE WRITE(7,701) 701 FORMAT(' MOVE INVALID!!') GO TO 14 13 NM=NM+1 CALL BOARDC(MOVESI,MOVESJ,I,IAA,JAA,B,-OC,DIR,LC) CALL BOARDP(B,NM,NHD) GO TO 2 11 OC=-1 CALL HANDIC(OC,B,DRSPON,NHD) B(5,7)=1 B(5,6)=1 NM=NHD+1 CALL BOARDP(B,NM,NHD) GO TO 8 12 WRITE(7,756) 756 FORMAT(/,' I CAN SEE NO MOVE FOR YOU. I WILL ATTEMPT TO MOVE.') 2 IF(NM.EQ.60) GO TO 15 CALL MOVEG(B,OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA,IM,NOMVE, 1 NFLIP) IF(IM.EQ.0) GO TO 20 CALL MOVEE(B,OC,NM,MOVESI,MOVESJ,NFLIP,DIR,LC,IM,IF,IAA,JAA) MOVEI=MOVESI(IF)-1 MOVEJ=MOVESJ(IF)-1 WRITE(7,603) MOVEI,MOVEJ 603 FORMAT(/,' COMPUTER MOVES TO ',I1,',',I1) CALL BOARDC(MOVESI,MOVESJ,IF,IAA,JAA,B,OC,DIR,LC) NM=NM+1 CALL BOARDP(B,NM,NHD) GO TO 8 20 WRITE(7,602) 602 FORMAT(/,' DO YOU HAVE A MOVE??',5X,$) READ(5,9999) IANS IF(IANS.EQ.DRSPON(1)) GO TO 8 IF(IM.NE.0) GO TO 2 15 CALL COUNT(B,OC,NOC) CALL COUNT(B,-OC,NC) IF(NOC.GT.NC) WRITE(7,610) NOC,NC 610 FORMAT(//,' YOU WON!! THE SCORE WAS',I5,' TO',I5,'.') IF(NOC.LT.NC) WRITE(7,611) NC,NOC 611 FORMAT(//,' I WON!! THE SCORE WAS',I5,' TO',I5,'.') IF(NOC.EQ.NC) WRITE(7,612) NOC,NC 612 FORMAT(//,' TIE GAME. THE SCORE WAS',I5,' TO',I5,'.') STOP 'OTHELLO' END SUBROUTINE MOVEG(B,OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA,IM, 1 NOMVE,NFLIP) INTEGER OCA INTEGER OC INTEGER B(10,10),DIR(30,8) INTEGER MOVESI(30),MOVESJ(30),LC(30),NFLIP(30),IAA(8),JAA(8) COMMON /TWO/ OCA DO 1 I=1,30 LC(I)=0 1 NFLIP(I)=0 IM=0 DO 20 I=2,9 DO 20 J=2,9 IF(B(I,J)) 20,3,20 3 IC=0 DO 5 L=1,8 IA=IAA(L) JA=JAA(L) IF(B(I+IA,J+JA)-OC) 5,6,5 6 IV=1 4 IV=IV+1 MVI=I+IV*IA MVJ=J+IV*JA IF(B(MVI,MVJ))7,5,7 7 IF(B(MVI,MVJ)-100) 11,5,11 11 IF(B(MVI,MVJ)-OC) 8,4,8 8 IF(IC-1) 13,12,13 13 IM=IM+1 IC=1 12 NFLIP(IM)=NFLIP(IM)+IV LC(IM)=LC(IM)+1 LD=LC(IM) DIR(IM,LD)=L 5 CONTINUE IF(IC) 21,20,21 21 MOVESI(IM)=I MOVESJ(IM)=J 20 CONTINUE IF(IM) 31,31,30 31 IF(OCA.EQ.OC) WRITE(7,100) 100 FORMAT(/,' I HAVE NO MOVE AND MUST PASS') 30 RETURN END SUBROUTINE COUNT(B,OC,NOC) INTEGER OC INTEGER B(10,10) NOC=0 DO 10 I=2,9 DO 10 J=2,9 IF(B(I,J)-OC) 10,5,10 5 NOC=NOC+1 10 CONTINUE RETURN END SUBROUTINE BOARDP(B,NM,NHD) INTEGER IOUT(3),POUT(10,10) INTEGER B(10,10) DATA IOUT /'B','.','W'/ NMP=NM-NHD WRITE(7,100) NMP 100 FORMAT(/,6X,'BOARD POSITION AFTER ',I3,' MOVES',/) WRITE(7,101) 101 FORMAT(' J = 1 2 3 4 5 6 7 8') WRITE(7,102) 102 FORMAT(' I') WRITE(7,103) 103 FORMAT(' "') DO 9 I=2,9 DO 9 J=2,9 IS=B(I,J)+2 9 POUT(I,J)=IOUT(IS) DO 10 I=2,9 I1=I-1 10 WRITE(7,104) I1,(POUT(I,J),J=2,9) 104 FORMAT(1X,I1,3X,8(A1,2X)) RETURN END SUBROUTINE BOARDC(MOVESI,MOVESJ,IF,IAA,JAA,B,OC,DIR,LC) INTEGER OC INTEGER B(10,10),DIR(30,8) INTEGER MOVESI(30),MOVESJ(30),IAA(8),JAA(8),LC(30) MI=MOVESI(IF) MJ=MOVESJ(IF) B(MI,MJ)=-OC NDIR=LC(IF) DO 40 I=1,NDIR L=DIR(IF,I) IA=IAA(L) JA=JAA(L) IV=0 31 IV=IV+1 MVI=MI+IV*IA MVJ=MJ+IV*JA IF(B(MVI,MVJ)+OC) 39,40,39 39 B(MVI,MVJ)=-OC GO TO 31 40 CONTINUE RETURN END SUBROUTINE MOVEE(B,OC,NM,MOVESI,MOVESJ,NFLIP,DIR,LC, 1 IM,IF,IAA,JAA) INTEGER OC INTEGER B(10,10),DIR(30,8),BT(10,10),BTT(10,10),DIRB(20,8) INTEGER BTTS(9,9,20),DIRBB(20,8) INTEGER MOVESI(30),MOVESJ(30),LC(30),NFLIP(30),MBI(20),MBJ(20) INTEGER LCB(20),NFLIPB(30),IAA(8),JAA(8),IY(24),JY(24) INTEGER IMID(24),JMID(24),ID(24),JD(24),NCORNI(4),NCORNJ(4) INTEGER MBBI(20),MBBJ(20),LCBB(20),NFLIB(30) DATA NCORNI,NCORNJ /2,2,9,9,2,9,9,2/ DATA ID,JD /3,4,5,6,7,8,6*9,8,7,6,5,4,3,12*2,3,4,5,6,7,8, 1 6*9,8,7,6,5,4,3/ DATA IY,JY /5,1,3,8,1,6,9,1,9,9,1,9,6,1,8,3,1,5,2,1,2,2,1,2, 1 2,1,2,2,1,2,5,1,3,8,1,6,9,1,9,9,1,9,6,1,8,3,1,5/ DATA IMID,JMID /4,1,4,7,1,7,9,1,9,9,1,9,7,1,7,4,1,4,2,1,2,2, 1 1,2,2,1,2,2,1,2,4,1,4,7,1,7,9,1,9,9,1,9,7,1,7,4,1,4/ ICO=0 IF=1 IF(NM.EQ.59) GO TO 20 10 DO 12 I=1,IM MI=MOVESI(I) MJ=MOVESJ(I) IF(MI.NE.3.AND.MI.NE.8) GO TO 13 IF(MJ.NE.3.AND.MJ.NE.8) GO TO 13 IF(MI.EQ.3.AND.MJ.EQ.3) IC=1 IF(MI.EQ.3.AND.MJ.EQ.8) IC=2 IF(MI.EQ.8.AND.MJ.EQ.8) IC=3 IF(MI.EQ.8.AND.MJ.EQ.3) IC=4 IF(B(NCORNI(IC),NCORNJ(IC)).EQ.0) NFLIP(I)=NFLIP(I)-50 13 IF(MI.NE.2.AND.MI.NE.9) GO TO 11 IF(MJ.NE.2.AND.MJ.NE.9) GO TO 11 ICO=ICO+1 NFLIP(I)=NFLIP(I)+60 11 IF(MI.LE.3.OR.MI.GE.8) GO TO 2 IF(MJ.LE.2.OR.MJ.GE.8) GO TO 2 NFLIP(I)=NFLIP(I)+10 GO TO 12 2 ND=LC(I) DO 5 J=1,ND L=DIR(I,J) IA=IAA(L) JA=JAA(L) IV=1 4 IV=IV+1 MVI=MI+IV*IA MVJ=MJ+IV*JA IF(B(MVI,MVJ)-OC) 6,4,6 6 IV=IV+1 MVI=MI+IV*IA MVJ=MJ+IV*JA IF(B(MVI,MVJ)-OC) 7,8,7 7 IF(B(MVI,MVJ)+OC) 5,6,5 8 IF(B(MI-IA,MJ-JA)) 5,9,5 9 NFLIP(I)=NFLIP(I)-5 GO TO 12 5 CONTINUE 12 CONTINUE DO 32 I=1,IM NSUBO=0 MI=MOVESI(I) MJ=MOVESJ(I) IC=0 DO 33 K=1,10 DO 33 J=1,10 33 BT(K,J)=B(K,J) LL=0 DO 56 J=1,24 IPP=ID(J) JPP=JD(J) IF(MOVESI(I).NE.IPP.OR.MOVESJ(I).NE.JPP) GO TO 56 LL=J 56 CONTINUE CALL BOARDC(MOVESI,MOVESJ,I,IAA,JAA,BT,OC,DIR,LC) CALL MOVEG(BT,-OC,NM,MBI,MBJ,DIRB,LCB,JAA,IAA,IM1, 1 NOMVE,NFLIPB) IF(IM1.NE.0) GO TO 63 NFLIP(I)=NFLIP(I)+100 GO TO 32 63 DO 36 J=1,IM1 DO 34 K=1,10 DO 34 L=1,10 34 BTT(K,L)=BT(K,L) CALL BOARDC(MBI,MBJ,J,IAA,JAA,BTT,-OC,DIRB,LCB) IF(LL.EQ.0) GO TO 38 IC=1 IZ=IY(LL) JZ=JY(LL) IF(B(IZ,JZ)+OC) 41,40,41 40 MK=JMID(LL) ML=IMID(LL) IF(B(ML,MK).EQ.0) NSUBO=90 41 IF(BTT(MI,MJ).NE.OC) GO TO 38 NFLIP(I)=NFLIP(I)-40 IC=2 38 CONTINUE CALL COUNT(BTT,-OC,NOC) IF(NOC) 39,39,42 39 NFLIP(I)=NFLIP(I)-200 GO TO 32 42 DO 37 K1=2,9 DO 37 K2=2,9 37 BTTS(K1,K2,J)=BTT(K1,K2) DO 100 IL=2,9 DO 100 JL=2,9 IF(BTT(IL,JL)) 96,100,96 96 IF(BTT(IL,JL)-OC) 99,100,99 99 DO 90 IZ=1,8 IV=0 80 IV=IV+1 ILL=IL+IV*IAA(IZ) JLL=JL+IV*JAA(IZ) IF(BTT(ILL,JLL)) 98,36,98 98 IF(BTT(ILL,JLL)-100) 97,36,97 97 IF(BTT(ILL,JLL)-OC) 80,90,80 90 CONTINUE 100 CONTINUE 95 CALL MOVEG(BTT,OC,NM,MBBI,MBBJ,DIRBB,LCBB,JAA,IAA,IM2, 1 NOMVE,NFLIB) IF(IM2.EQ.0) GO TO 103 DO 102 IL=1,IM2 IF(MBBI(IL).NE.2.OR.MBBI(IL).NE.9) GO TO 102 IF(MBBJ(IL).NE.2.OR.MBBJ(IL).NE.9) GO TO 102 GO TO 36 102 CONTINUE 103 NFLIP(I)=NFLIP(I)-190 36 CONTINUE IF(IC.NE.1) GO TO 35 DO 50 K=1,24 IQ=ID(K) JQ=JD(K) IF(MI.EQ.IQ.AND.MJ.EQ.JQ) GO TO 50 52 IF(B(IQ,JQ)+OC) 50,53,50 53 DO 54 K1=1,IM1 54 IF(BTTS(IQ,JQ,K1).EQ.OC) NFLIP(I)=NFLIP(I)-8 50 CONTINUE NFLIP(I)=NFLIP(I)+25-NSUBO 35 DO 60 K=1,4 KC1=NCORNI(K) KC2=NCORNJ(K) IF(B(KC1,KC2)) 60,58,60 58 DO 61 K1 =1,IM1 61 IF(BTTS(KC1,KC2,K1).EQ.OC) NFLIP(I)=NFLIP(I)-55 IF(ICO.LE.1) GO TO 60 IF(MI.EQ.KC1.AND.MJ.EQ.KC2) GO TO 60 DO 62 K1=1,IM1 62 IF(BTTS(KC1,KC2,K1).EQ.OC) NFLIP(I)=NFLIP(I)-20 60 CONTINUE 32 CONTINUE NFLIPM=-800 DO 15 I=1,IM IF(NFLIP(I)-NFLIPM) 15,16,16 16 NFLIPM=NFLIP(I) IF=I 15 CONTINUE 20 RETURN END SUBROUTINE HANDIC(OC,B,DRSPON,NHD) INTEGER OC INTEGER DRSPON(2) INTEGER B(10,10) NHD=0 WRITE(7,608) 608 FORMAT(/,' DO YOU WISH TO BE GIVEN A HANDICAP??',5X,$) READ(5,9999) IANS 9999 FORMAT(A2) IF(IANS.EQ.DRSPON(1)) GO TO 7 WRITE(7,610) 610 FORMAT(/,' DO YOU WISH TO GIVE ME A HANDICAP??',5X,$) READ(5,9999) IANS IF(IANS.EQ.DRSPON(2)) GO TO 100 NAH=-OC 607 WRITE(7,609) 609 FORMAT(/,' HOW MANY CORNERS?? (1-4)',5X,$) READ(5,9998) NHD 9998 FORMAT(I1) IF(NHD.LT.1.OR.NHD.GT.4) GO TO 607 CALL HANDI(B,NHD,NAH,OC) CALL BOARDP(B,0,0) GO TO 100 7 NAH=OC 606 WRITE(7,609) READ(5,9998) NHD IF(NHD.LT.1.OR.NHD.GT.4) GO TO 606 CALL HANDI(B,NHD,NAH,OC) CALL BOARDP(B,0,0) 100 RETURN END SUBROUTINE HANDI(B,NHD,NAH,OC) INTEGER OC INTEGER B(10,10),NCORNI(4),NCORNJ(4) DATA NCORNI,NCORNJ /2,2,9,9,2,9,9,2/ SIGN=-1. IF(NAH.EQ.OC) SIGN=1. DO 10 I=1,NHD I1=NCORNI(I) I2=NCORNJ(I) 10 B(I1,I2)=IFIX(SIGN*OC) RETURN END