C  Author: John Fedak
C	   Computer Science Department
C	   University of Pennsylvania
C
C  Date:   Spring 1977
C
C  Submitted by:
C
C          Ira Winston
C	   200 South 33rd Street
C	   Philadelphia, PA  19104
C	   (215)-243-4707
C
C
C
      DIMENSION NRAY(8,8),INRAY(8,8),STR(8,8),NUMS(10)
      COMMON FR
	DATA NUMS/'0','1','2','3','4','5','6','7','8','9'/
      DATA LTA,LTB,LTC,LTD,LTE/'A','B','C','D','E'/
      DATA LTF,LTG,LTH,LTY,LTS/'F','G','H','Y','S'/
      DATA STR/200.,50.,60.,32.,32.,60.,50.,200.,
     250.,1.,2.,3.,3.,2.,1.,50.,60.,2.,18.,8.,8.,18.,2.,60.,
     448.,3.,8.,10.,10.,8.,3.,48.,
     448.,3.,8.,10.,10.,8.,3.,48.,
     660.,2.,18.,8.,8.,18.,2.,60.,
     750.,1.,2.,3.,3.,2.,1.,50.,200.,50.,60.,32.,32.,60.,50.,200./
      NFLAG=0
      IFLAG=0
      JLF=0
      JKF=0
      FR=1
      DO 1 I1=1,8
      DO 1 I2=1,8
      NRAY(I1,I2)=0
   1   NRAY(I1,I2)=0
      NRAY(4,4)=1
      NRAY(4,5)=2
      NRAY(5,4)=2
      NRAY(5,5)=1
      WRITE(5,2)
   2   FORMAT(//' Welcome to Othello')
      WRITE(5,90)
  90  FORMAT(/'$Do you wish instructions? ')
      READ(5,91,END=99999)JNS
  91  FORMAT(A1)
      CALL UPCASE(JNS)
      IF(JNS.NE.LTY)GOTO 25
  29  WRITE(5,92)
  92  FORMAT(/' Rules are the same as standard OTHELLO. ',
     2/' Black is represented as an "O" and white as an "X".',
     3/' A blank space is represented as a ":".')
      WRITE(5,93)
  93  FORMAT(//' When it is your move, you may issue any of ',
     2'the following commands:')
      WRITE(5,94)
  94  FORMAT(/' S1: Display current status of the board.')
      WRITE(5,95)
  95  FORMAT(' S2: Set flag to display relative values of ',
     2'The computers possible moves.',/3X,'  (the computer will',
     3' choose the move with the least value.)'/,
     4' S3: clear the S2 flag')
      WRITE(5,96)
  96  FORMAT(' S4: Set flag to display strategic "score" ',
     2'After your move.'/' S5: Clear the S4 flag.')
      WRITE(5,97)
  97  FORMAT(' S6: Enter board initialization mode where you ',
     2'may preset or change any',/3X,'  piece on the board.')
      WRITE(5,98)
  98  FORMAT(' S7: Write these instructions')
      WRITE(5,99)
  99  FORMAT(' S8: Stop the game')
      IF(IFLAG.EQ.1)GOTO 10
  25  WRITE(5,3)
   3   FORMAT(/'$Do you wish to be black? ')
      READ(5,4,END=99999)LNS
   4  FORMAT(A1)
      CALL UPCASE(LNS)
      IF(LNS.NE.LTY)GOTO 21
      NC=1
      NCM=2
   5   CALL BOARD(NRAY)
      DO 6 IT1=1,8
      DO 6 IT2=1,8
   6   INRAY(IT1,IT2)=NRAY(IT1,IT2)
      DO 7 IT1=1,8
      DO 7 IT2=1,8
      NLEG=0
      CALL MOVE(IT1,IT2,NC,INRAY,NLEG)
      IF(NLEG.EQ.1)GOTO 9
   7  CONTINUE
      WRITE(5,8)
   8  FORMAT(/' YOU CANNOT MOVE')
      NFLAG=NFLAG+1
      IF(NFLAG.EQ.2)GOTO 100
      GOTO 14
   9  NFLAG=0
  10  WRITE(5,11)
  11  FORMAT(//'$Your move (letter first)? ')
  12  READ(5,13,END=99999) L1,N2
  13  FORMAT(A1,A1)
      CALL UPCASE(L1)
      DO 7301 INDEX = 1,10
      IF (NUMS(INDEX) .EQ. N2) GO TO 7302
7301  CONTINUE
      GO TO 50
7302  CONTINUE
      N2 = INDEX - 1
      IF(L1.EQ.LTS)GOTO 70
      IF(N2.GT.8.OR.N2.LT.1)GOTO 50
      N1=0
      NLEG=0
      IF(L1.EQ.LTA)N1=1
      IF(L1.EQ.LTB)N1=2
      IF(L1.EQ.LTC)N1=3
      IF(L1.EQ.LTD)N1=4
      IF(L1.EQ.LTE)N1=5
      IF(L1.EQ.LTF)N1=6
      IF(L1.EQ.LTG)N1=7
      IF(L1.EQ.LTH)N1=8
      IF(N1.EQ.0)GOTO 50
      CALL MOVE(N1,N2,NC,NRAY,NLEG)
      IF(NLEG.EQ.0)GOTO 50
      CALL BOARD(NRAY)
      IF(JLF.EQ.0)GOTO 14
      JLV=NVALUE(NRAY,NC,STR)
      WRITE(5,135)JLV
  135 FORMAT(/' Current board value for you is ',i4)
  14  KVAL=1000
      LKT=0
      TP=0
      DO 27 I=1,8
      DO 27 J=1,8
  27  IF(NRAY(I,J).NE.0)TP=TP+1.
      IF(TP.GT.60.)TP=60.
      FR=1-(TP/60.)**2
      DO 18 JC1=1,8
      DO 17 JC2=1,8
      DO 15 J1=1,8
      DO 15 J2=1,8
  15  INRAY(J1,J2)=NRAY(J1,J2)
      NLEG=0
      CALL MOVE(JC1,JC2,NCM,INRAY,NLEG)
      IF(NLEG.EQ.0)GOTO 17
      LKT=1
      KFLAG=0
      IVAL=0
      INTVAL=0
      IF(JC1.EQ.2.OR.JC1.EQ.7.OR.JC2.EQ.2.OR.JC2.EQ.7)
     2INTVAL=MEVAL(JC1,JC2,INRAY,STR)/3
      CALL LOOK(INRAY,NC,NCM,KFLAG,IVAL,STR)
      IVAL=IVAL+INTVAL
      IF(KFLAG.EQ.1)IVAL=IVAL-100
      IF(JKF.EQ.1)CALL JVAL(JC1,JC2,IVAL,INTVAL)
      IF(KVAL.LT.IVAL)GOTO 17
      KVAL=IVAL
      M1=JC1
      M2=JC2
  17  CONTINUE
  18  CONTINUE
      IF(LKT.EQ.0)GOTO 19
      GOTO 22
  19  WRITE(5,20)
  20  FORMAT(/' I cannot move')
      NFLAG=NFLAG+1
      IF(NFLAG.EQ.2)GOTO 100
      GOTO 5
  21  NC=2
      NCM=1
      M1=4
      M2=6
  22  NFLAG=0
      WRITE(5,30)
      CALL WR(M1,M2)
  30  FORMAT(//' My move is ')
      NLEG=0
      CALL MOVE(M1,M2,NCM,NRAY,NLEG)
      GOTO 5
  50  WRITE(5,51)
  51  FORMAT(/'$Illegal move.  Your move? ')
      GOTO 12
  70  IF(N2.EQ.1)GOTO 80
      IF(N2.EQ.2)JKF=1
      IF(N2.EQ.3)JKF=0
      IF(N2.EQ.4)JLF=1
      IF(N2.EQ.5)JLF=0
      IF(N2.EQ.6)GOTO 75
      IF(N2.EQ.7)GOTO 87
      IF(N2.EQ.8)CALL EXIT
      IF(N2.GT.8)WRITE(5,71)
  71  FORMAT(/' Illegal command, try again.')
      GOTO 10
  75  WRITE(5,76)
  76  FORMAT(/' Enter board specs: row, column, ?')
      WRITE(5,77)
  77  FORMAT(' ?=1 for O, =2 for X, =0 for :.  Enter 9,9,9 to stop')
      READ(5,78,END=99999)JK1,JK2,JK3
  78  FORMAT(I1,1X,I1,1X,I1)
      IF(JK1.EQ.9)GOTO 80
      IF(JK1.LT.1.OR.JK2.LT.1.OR.JK2.GT.8)GOTO 85
      IF(JK3.GT.2)GOTO 85
      NRAY(JK1,JK2)=JK3
      GOTO 75
  80  CALL BOARD(NRAY)
      GOTO 10
  85  WRITE(5,86)
  86  FORMAT(/' Invalid spec, try again')
      GOTO 75
  87  IFLAG=1
      GOTO 29
 100  MKT=0
      JKT=0
      DO 101 JE=1,8
      DO 101 JF=1,8
      IF (NRAY(JE,JF).EQ.NCM)MKT=MKT+1
 101  IF(NRAY(JE,JF).EQ.NC)JKT=JKT+1
      WRITE(5,102)
 102  FORMAT(//' The game is over.')
      IF(JKT.GT.MKT)WRITE(5,103)JKT,MKT
      IF(MKT.GT.JKT)WRITE(5,104)MKT,JKT
      IF(MKT.EQ.JKT)WRITE(5,105)MKT,JKT
 103  FORMAT(/' You have won ',I2,' to ',I2///)
 104  FORMAT(/' You lost, chump! ',I2,' to ',I2///)
 105  FORMAT(/' Tie game: ',I2,' to ',I2///)
99999 CALL EXIT
      END
      SUBROUTINE BOARD(NAR)
      DIMENSION NAR(8,8),NW(8,8)
      DATA L/' :'/
      DATA M/' O'/
      DATA N/' X'/
      WRITE(5,1)
   1  FORMAT(//2X,' 1 2 3 4 5 6 7 8')
      DO 2 I=1,8
      DO 2 J=1,8
      IF(NAR(I,J).EQ.1)NW(I,J)=M
      IF(NAR(I,J).EQ.0)NW(I,J)=L
   2  IF(NAR(I,J).EQ.2)NW(I,J)=N
      DO 4 I=1,8
      IF(I.EQ.1)WRITE(5,10) (NW(I,J),J=1,8)
      IF(I.EQ.2)WRITE(5,11) (NW(I,J),J=1,8)
      IF(I.EQ.3)WRITE(5,12) (NW(I,J),J=1,8)
      IF(I.EQ.4)WRITE(5,13) (NW(I,J),J=1,8)
      IF(I.EQ.5)WRITE(5,14) (NW(I,J),J=1,8)
      IF(I.EQ.6)WRITE(5,15) (NW(I,J),J=1,8)
      IF(I.EQ.7)WRITE(5,16) (NW(I,J),J=1,8)
      IF(I.EQ.8)WRITE(5,17) (NW(I,J),J=1,8)
   4  CONTINUE
  10  FORMAT(' A',8A2)
  11  FORMAT(' B',8A2)
  12  FORMAT(' C',8A2)
  13  FORMAT(' D',8A2)
  14  FORMAT(' E',8A2)
  15  FORMAT(' F',8A2)
  16  FORMAT(' G',8A2)
  17  FORMAT(' H',8A2)
      RETURN
      END
      SUBROUTINE MOVE(N1,N2,NCOL,NA,NLEGAL)
      DIMENSION NA(8,8)
      IF(NCOL.EQ.1)MCOL=2
      IF(NCOL.EQ.2)MCOL=1
      NLEGAL=0
      IF(NA(N1,N2).NE.0)GOTO 7
      DO 6 JQ1=1,3
      DO 5 JQ2=1,3
      JM1=JQ1-2
      JM2=JQ2-2
      NT1=N1
      NT2=N2
      IF(NT1+JM1.EQ.0.OR.NT1+JM1.EQ.9)GOTO 5
      IF(NT2+JM2.EQ.0.OR.NT2+JM2.EQ.9)GOTO 5
      IF(NA(NT1+JM1,NT2+JM2).NE.MCOL)GOTO 5
      GOTO 3
   1  IF(NA(NT1+JM1,NT2+JM2).EQ.MCOL)GOTO 3
      IF(NA(NT1+JM1,NT2+JM2).EQ.NCOL)GOTO 4
   2  NA(NT1,NT2)=MCOL
      NT1=NT1-JM1
      NT2=NT2-JM2
      IF(NT1.EQ.N1.AND.NT2.EQ.N2)GOTO 5
      GOTO 2
   3  NT1=NT1+JM1
      NT2=NT2+JM2
      IF(NT1+JM1.EQ.0.OR.NT1+JM1.EQ.9)GOTO 2
      IF(NT2+JM2.EQ.0.OR.NT2+JM2.EQ.9)GOTO 2
      NA(NT1,NT2)=NCOL
      GOTO 1
   4  NA(N1,N2)=NCOL
      NLEGAL=1
   5  CONTINUE
   6  CONTINUE
   7  RETURN
      END
      SUBROUTINE LOOK(M1AR,LHIS,LMY,LFLAG,JVAL,STR)
      DIMENSION M1AR(8,8),M2AR(8,8),STR(8,8)
      LFLAG=0
      JVAL=-1000
      LK1=0
      DO 10 LC1=1,8
      DO 9 LC2=1,8
      DO 1 LE1=1,8
      DO 1 LE2=1,8
   1  M2AR(LE1,LE2)=M1AR(LE1,LE2)
      L2LEG=0
      CALL MOVE(LC1,LC2,LHIS,M2AR,L2LEG)
      IF(L2LEG.EQ.0)GOTO 9
      NVAL=NVALUE(M2AR,LHIS,STR)
      IF(NVAL.LE.JVAL)GOTO 9
      JVAL=NVAL
      K1=LC1
      K2=LC2
   9  CONTINUE
  10  CONTINUE
      IF(K1.EQ.0)JFLAG=1
      IF(K1.EQ.0)RETURN
      CALL MOVE(K1,K2,LMY,M1AR,L2LEG)
      RETURN
      END
      FUNCTION NVALUE(NVAR,MXCOL,STR)
      DIMENSION NVAR(8,8),NFVAL(8,8),STR(8,8)
      COMMON FR
      IF(MXCOL.EQ.1)MYCOL=2
      IF(MXCOL.EQ.2)MYCOL=1
      DO 1 I=1,8
      DO 1 J=1,8
   1  NFVAL(I,J)=0
      DO 50 I=1,8
      DO 45 J=1,8
      IF(NVAR(I,J).EQ.0)GOTO 45
      NFVAL(I,J)=NTOT(I,J,NVAR(I,J),NVAR,STR)
  45  CONTINUE
  50  CONTINUE
      DO 70 I=1,8
      DO 70 J=1,8
      NADD=STR(I,J)*FR+1
  70  NFVAL(I,J)=NFVAL(I,J)+NADD
      KMY=0
      KHIS=0
      DO 80 I=1,8
      DO 80 J=1,8
      IF(NVAR(I,J).EQ.MXCOL)KMY=KMY+NFVAL(I,J)
  80  IF(NVAR(I,J).EQ.MYCOL)KHIS=KHIS+NFVAL(I,J)
      NVALUE=KMY-KHIS
      IF(KHIS.EQ.0)NVALUE=NVALUE+500
      RETURN
      END
      FUNCTION NTOT(K1,K2,MXC,NLAR,STR)
      DIMENSION NLAR(8,8),STR(8,8)
      COMMON FR
      IF(MXC.EQ.1)MYC=2
      IF(MXC.EQ.2)MYC=1
      NTOT=0
      KNT=0
      DO 40 J1=1,3
      DO 35 J2=1,3
      L1=J1-2
      L2=J2-2
      KT1=K1
      KT2=K2
   5  IF(KT1+L1.EQ.0.OR.KT1+L1.EQ.9)GOTO 30
      IF(KT2+L2.EQ.0.OR.KT2+L2.EQ.9)GOTO 30
      IF(NLAR(KT1+L1,KT2+L2).NE.MYC)GOTO 10
      MADD=STR(KT1+L1,KT2+L2)*FR+1
      KNT=KNT+MADD/2
  10  IF(NLAR(KT1+L1,KT2+L2).EQ.0)GOTO 25
      IF(NLAR(KT1+L1,KT2+L2).EQ.MXC)GOTO 30
      KT1=KT1+L1
      KT2=KT2+L2
      GOTO 5
  25  IF(KNT.EQ.0)GOTO 35
      MADD=STR(KT1+L1,KT2+L2)*FR+1
      NTOT=NTOT+KNT+MADD/2
  30  KNT=0
  35  CONTINUE
  40  CONTINUE
      RETURN
      END
      SUBROUTINE JVAL(N1,N2,NVAL,INTVAL)
      CALL WR(N1,N2)
      WRITE(5,1)NVAL
   1  FORMAT(' Value: ',I4)
      RETURN
      END
      SUBROUTINE WR(M1,M2)
      IF(M1.EQ.1)WRITE(5,31)M2
      IF(M1.EQ.2)WRITE(5,32)M2
      IF(M1.EQ.3)WRITE(5,33)M2
      IF(M1.EQ.4)WRITE(5,34)M2
      IF(M1.EQ.5)WRITE(5,35)M2
      IF(M1.EQ.6)WRITE(5,36)M2
      IF(M1.EQ.7)WRITE(5,37)M2
      IF(M1.EQ.8)WRITE(5,38)M2
  31  FORMAT(' A',I1)
  32  FORMAT(' B',I1)
  33  FORMAT(' C',I1)
  34  FORMAT(' D',I1)
  35  FORMAT(' E',I1)
  36  FORMAT(' F',I1)
  37  FORMAT(' G',I1)
  38  FORMAT(' H',I1)
      RETURN
      END
      FUNCTION MEVAL(KS1,KS2,KAR,STR)
      DIMENSION KAR(8,8),STR(8,8)
      COMMON FR
      MEVAL=0
      KFLAG=0
      IF(KS1.EQ.1.OR.KS1.EQ.8.OR.KS2.EQ.1.OR.KS2.EQ.8)GOTO 8
      IF(KS1.NE.2.AND.KS1.NE.7)GOTO 5
      IF(KS2.EQ.2.OR.KS2.EQ.7)GOTO 7
      IF(KS1.EQ.2)L1=1
      IF(KS1.EQ.7)L1=8
      DO 4 J=1,3
      J2=J-2
   4  IF(KAR(L1,KS2+J2).EQ.0)MEVAL=MEVAL+STR(L1,KS2+J2)*FR+1
      RETURN
   5  IF(KS2.EQ.2)L2=1
      IF(KS2.EQ.7)L2=8
      DO 6 J=1,3
      J2=J-2
   6  IF(KAR(KS1+J2,L2).EQ.0)MEVAL=MEVAL+STR(KS1+J2,L2)*FR+1
      RETURN
   7  IF(KS1.EQ.2)L1=1
      IF(KS1.EQ.7)L1=8
      IF(KS2.EQ.2)L2=1
      IF(KS2.EQ.7)L2=8
      IF(KAR(L1,L2).EQ.0)MEVAL=MEVAL+300*FR+1
      RETURN
   8  L1=KS1
      L2=KS2
      IF(KS1.EQ.2)L1=1
      IF(KS1.EQ.7)L1=8
      IF(KS2.EQ.2)L2=1
      IF(KS2.EQ.7)L2=8
      IF(KAR(L1,L2).EQ.0)MEVAL=MEVAL+250*FR+1
      RETURN
      END
      SUBROUTINE UPCASE(I)
      IF (I .GE. 'a' .AND. I .LE. 'z') I = I - 32
      RETURN
      END
