      INTEGER BOARD(26),ROLL(2),MOVE(2,4),BOARD1(26)
      INTEGER BOARD2(26),SCORE(6),BOARD3(26),TEST(2)
      BYTE IBUF(20)
      REAL A
      T1=SECNDS(0.0)
      IF(.NOT.(T1.GT.46800.0.AND.T1.LT.59400.0)) GO TO 32758
      WRITE(5,*)
     1'Time wasted playing computer games can never be recovered!'
32758 IF(.NOT.(T1.LT.43200.0.AND.T1.GT.30600.0)) GO TO 32757
      WRITE(5,*)
     1'Time wasted playing computer games can never be recovered!'
32757 I1=INT(T1)
      I2=SQRT(T1)/10
c     DO 32756 I=1,(I1/10)+10
c     ID=RAN(I1)
32756 CONTINUE
9     CALL INIT(BOARD)
      CALL PRINTB(BOARD)
      WRITE(5,99930) 
99930 FORMAT('$Do you need instructions? ')
      READ(5,99)NCHRS,(IBUF(I),I=1,NCHRS)
99    FORMAT(Q,20A1)
      IF(IBUF(1).EQ.'N'.OR.IBUF(1).EQ.'n')GOTO 80
      WRITE(5,*)
     +'     This is the playing board, it looks much the'
      WRITE(5,*)
     +'same as a standard backgammon board.  The computer'
      WRITE(5,*)
     +'will play red (symbolized as -R-) and moves from '
      WRITE(5,*)
     +'the lower left corner around to the upper left'
      WRITE(5,*)
     +'corner.  You will play white (-W-) and will move'
      WRITE(5,*)
     +'from the upper left to the lower left.  Men which'
      WRITE(5,*)
     +'have been hit will be moved to the bar in the center'
      WRITE(5,*)
     +'of the board.  '
      WRITE(5,*)
     +'     The numbers on the points are used when moving'
      WRITE(5,*)
     +'your men.  The points are numbered from 1 to 24, the'
      WRITE(5,*)
     +'bar is refered to as 0 when bringing a man in. '
      WRITE(5,*)
     +'Moves are made by specifying the -from- point and the'
      WRITE(5,*)
     +'roll to use.  Numbers are separated by commas.  The '
      WRITE(5,*)
     +'input routine applies the rolls in the order in which'
      WRITE(5,*)
     +'the dice were listed.  For example, if the program'
      WRITE(5,*)
     +'says YOU ROLL 6 5, and you want to move from point 1'
      WRITE(5,*)
     +'to point 12, you could respond 1,11.  However, if '
      WRITE(5,*)
     +'the program had said YOU ROLL 5 6, that response '
      WRITE(5,*)
     +'would be an error.  You could say 1,6,7,5 to make'
      WRITE(5,*)
     +'the desired move.'
80    CONTINUE
      WRITE(5,*)' '
      CALL GETROL(ROLL,I1,I2)
      WRITE(5,89) ROLL(1)
89    FORMAT(1X, 'I rolled a', I2)
      WRITE(5,88) ROLL(2)
88    FORMAT(1X, 'You rolled a', I2)
      IF(ROLL(1)-ROLL(2)) 81,82,83
81    CONTINUE
      WRITE(5,*)'You go first.'
      CALL PRINTB(BOARD)
      GO TO 55
82    CONTINUE
      WRITE(5,*)'Doubles. Roll again.'
      GO TO 80
83    CONTINUE
      WRITE(5,*)'I go first.'
      GO TO 4
1     CALL GETROL(ROLL,I1,I2)
4     ISW=0
      JSW=0
      KSW=0
      ISCORE=1000
      WRITE(5,2) ROLL
2     FORMAT(1X, 'I roll',2I2,'.')
3     CONTINUE
      MOVE(1,1)=0
      MOVE(2,1)=-ROLL(1)
      MOVE(1,2)=0
      MOVE(2,2)=-ROLL(2)
10    CONTINUE
      CALL MAKNXT(BOARD,BOARD1,MOVE(1,1))
      IF(MOVE(1,1).EQ.-1) GO TO 100
20    CONTINUE
      CALL MAKNXT(BOARD1,BOARD2,MOVE(1,2))
      IF(MOVE(1,2).EQ.-1) GO TO 30
      CALL EVAL(BOARD2,SCORE)
      JSW=1
      IF(SCORE(6).GT.ISCORE) GO TO 20
      ISCORE=SCORE(6)
      DO 32755 I=1,26
      BOARD3(I)=BOARD2(I)
32755 CONTINUE
      GO TO 20
30    CONTINUE
      MOVE(1,2)=0
      GO TO 10
50    CONTINUE
      IF(JSW.NE.0) GO TO 52
      ISCORE=1000
      DO 70 J=2,26
      MOVE(1,1)=J
      MOVE(1,2)=J
      I=1
      IF(MOVCHK(BOARD,MOVE(1,I)).NE.0) GO TO 71
      I=2
      IF(MOVCHK(BOARD,MOVE(1,I)).EQ.0) GO TO 70
71    CONTINUE
      JSW=1
      CALL MAKMOV(BOARD,BOARD2,MOVE(1,I))
      CALL EVAL(BOARD2,SCORE)
      IF(SCORE(6).GT.ISCORE) GO TO 70
      ISCORE=SCORE(6)
      DO 32754 I=1,26
      BOARD3(I)=BOARD2(I)
32754 CONTINUE
70    CONTINUE
      IF(JSW.NE.0) GO TO 52
      WRITE(5,*)'I cannot move'
      GO TO 56
52    CONTINUE
      DO 32753 I=1,26
      BOARD(I)=BOARD3(I)
32753 CONTINUE
      IF(KSW.NE.0) GO TO 56
      KSW=1
      IF(ROLL(1).NE.ROLL(2)) GO TO 56
      JSW=0
      GO TO 3
56    CONTINUE
      KSW=0
      CALL PRINTB(BOARD)
      CALL EVAL(BOARD,SCORE)
      IF(SCORE(2).EQ.0) GO TO 54
      GO TO 53
54    WRITE(5,*)'I win. Thanks for the game.'
      CALL EXIT
      GO TO 9
53    CONTINUE
      CALL GETROL(ROLL,I1,I2)
55    CONTINUE
      CALL INPMOV(BOARD,ROLL)
c     CALL PRINTB(BOARD)
      CALL EVAL(BOARD,SCORE)
      IF(SCORE(1).EQ.0) GO TO 65
      GO TO 1
65    WRITE(5,*)'You win, thanks.'
      CALL EXIT
      GO TO 9
100   CONTINUE
      IF(ISW.EQ.1) GO TO 50
      MOVE(1,1)=0
      MOVE(2,1)=-ROLL(2)
      MOVE(1,2)=0
      MOVE(2,2)=-ROLL(1)
      ISW=1
      GO TO 10
      END
      INTEGER FUNCTION MOVCHK(BOARD,MOVE)
      INTEGER IOURS,OFFBRD
      INTEGER BOARD(26),MOVE(2),IBRDF,IBRDT
      MOVCHK=0
      MOVEP=MOVE(1)
      MOVER=MOVE(2)
      MOVET=MOVEP+MOVER
      IBRDF=BOARD(MOVEP)
      IBRDT=BOARD(MOVET)
      IOURS=0
      IF(MOVE(2).LT.0) IOURS=1
      OFFBRD=26
      IF(IOURS.EQ.0) OFFBRD=1
      IF(BOARD(OFFBRD).NE.0.AND.MOVEP.NE.OFFBRD) RETURN
      IF(IBRDF.EQ.0) RETURN
      IF(ISHFT(IBRDF,-4).NE.IOURS) RETURN
      IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100
      IF(IBRDT.EQ.0) GO TO 10
      IF(ISHFT(IBRDT,-4).EQ.IOURS) GOTO 10
      IF(IAND(IBRDT,15).LT.2) GOTO 10
      RETURN
10    CONTINUE
      MOVCHK=1
      RETURN
100   CONTINUE
      DO 105 I=1,19
      I1=I
      IF(IOURS.NE.0) I1=27-I
      IF(BOARD(I1).EQ.0) GOTO 105
      IF(ISHFT(BOARD(I1),-4).EQ.IOURS) RETURN
105   CONTINUE
      IF(MOVET.EQ.26.OR.MOVET.EQ.1) GO TO 110
      GO TO (120,130),IOURS+1
      WRITE(5,*)'IOURS - ILLEGAL VALUE'
      RETURN
120   CONTINUE
      MOVEP1=MOVEP-1
      IF(MOVEP1.LE.20) GO TO 126
      DO 125 I=20,MOVEP1
      IF(BOARD(I).EQ.0) GO TO 125
      IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN
125   CONTINUE
126   MOVCHK=1
      RETURN
130   CONTINUE
      MOVEP1=MOVEP+1
      IF(MOVEP1.GE.7) GO TO 136
      DO 32758 I=MOVEP1,7
      IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN
32758 CONTINUE
136   MOVCHK=1
      RETURN
110   CONTINUE
      MOVCHK=1
      RETURN
      END
      SUBROUTINE NXTMOV(BOARD,MOVE)
      INTEGER ROLL,POINT,BOARD(26),MOVE(2)
      POINT=MOVE(1)
      ROLL=MOVE(2)
      IF(POINT.EQ.0) GO TO 100
      IOURS=0
      IF(ROLL.LT.0) IOURS=1
      POINT=POINT+1
      DO 10 I=POINT,26
      IF(BOARD(I).EQ.0) GO TO 10
      IF(ISHFT(BOARD(I),-4).NE.IOURS) GO TO 10
      POINT=I
      GO TO 200
10    CONTINUE
      POINT=-1
      GO TO 200
100   CONTINUE
      IOURS=0
      IF(ROLL.LT.0) IOURS=1
      DO 110 I=1,26
      IF(BOARD(I).EQ.0) GO TO 110
      IF(ISHFT(BOARD(I),-4).NE.IOURS) GOTO 110
      POINT=I
      GO TO 200
110   CONTINUE
      POINT=-1
200   CONTINUE
      MOVE(1)=POINT
      MOVE(2)=ROLL
      RETURN
      END
      SUBROUTINE GETROL(ROLL,I1,I2)
      INTEGER ROLL(2)
      ROLL(1)=INT(6.0*RAN(I1))+1
      ROLL(2)=INT(6.0*RAN(I1))+1
      RETURN
      END
      SUBROUTINE MAKMOV(OLDBRD,NEWBRD,MOVE)
      INTEGER OLDBRD(26),NEWBRD(26),MOVE(2)
      DO 10 I=1,26
10    NEWBRD(I)=OLDBRD(I)
      MOVEP=MOVE(1)
      MOVER=MOVE(2)
      MOVET=MOVEP+MOVER
      IBRDF=OLDBRD(MOVEP)
      IBRDT=OLDBRD(MOVET)
      IOURS=ISHFT(IBRDF,-4)
      IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100
      IF(ISHFT(IBRDF,-4).EQ.IOURS) GO TO 20
      WRITE(5,*)'ERROR, MOVING OPPS MAN'
      RETURN
20    CONTINUE
      IF(ISHFT(IBRDT,-4).NE.IOURS.AND.IBRDT.NE.0) GO TO 200
      NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
      IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
      ITEMP=ISHFT(IOURS,4)
      NEWBRD(MOVET)=(ITEMP.OR.NEWBRD(MOVET)+1)
      RETURN
200   CONTINUE
      NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
      IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
      NEWBRD(MOVET)=ISHFT(IOURS,4)+1
      OFFBRD=26-IOURS*25
      NEWBRD(OFFBRD)=(ISHFT(1-IOURS,4).OR.NEWBRD(OFFBRD)+1)
      RETURN
100   CONTINUE
      NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
      IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
      RETURN
      END
      SUBROUTINE PRINTB(BOARD)
      INTEGER BOARD(26),PRNTBF(26), ONBAR(2)
      INTEGER ABLANK, AR, AW, AVERT
      INTEGER PFLAG
      DATA ABLANK/' '/, AR/'R'/, AW/'W'/, AVERT/'|'/
C      WRITE(5,930)
C930   FORMAT (1H1)
      WRITE(5,*)
     1'    1     2     3     4     5     6           7     8     9    10
     2    11    12'
      WRITE(5,*)
     1'|--++----++----++----++----++----++--|    |--++----++----++----++
     2----++----++--|'
      DO 10 I=1,7
      PFLAG=0
      ONBAR(1)=ABLANK
      ONBAR(2)=ABLANK
      IF(IAND(BOARD(1),15).GE.9-I) ONBAR(1)=AW
      IF(IAND(BOARD(26),15).GE.16-I) ONBAR(2)=AR
      IF((ONBAR(1).NE.ABLANK).OR.(ONBAR(2).NE.ABLANK))PFLAG=1
      DO 20 J=1,12
      COUNT = 1+J
      PRNTBF(2*(J-1)+1)=ABLANK
      PRNTBF(2*(J-1)+2)=ABLANK
      IF(IAND(BOARD(COUNT),15).LT.I) GO TO 20
      PFLAG=1
      PRNTBF(2*(J-1)+1)=AR
      IF(ISHFT(BOARD(COUNT),-4).EQ.0) PRNTBF(2*(J-1)+1)=AW
      IF(IAND(BOARD(COUNT),15).LT.I+7) GO TO 20
      PRNTBF(2*(J-1)+2)=AR
      IF(ISHFT(BOARD(COUNT),-4).EQ.0) PRNTBF(2*(J-1)+2)=AW
20    CONTINUE
      IF (PFLAG.EQ.0) GO TO 10
      WRITE(5,30) AVERT,(PRNTBF(K),K=1,12),AVERT,ONBAR,AVERT,
     1(PRNTBF(K),K=13,24),AVERT
30    FORMAT(1X,A1,2X,2A1,4X,2A1,4X,2A1,4X,2A1,4X,2A1,4X,2A1,2X,A1,
     1X,2A1,X,A1,2X,2A1,4X,2A1,4X,2A1,4X,2A1,4X,2A1,4X,2A1,2X,A1)
      GOTO 10
21    WRITE(5,*) ' '
10    CONTINUE
      PFLAG=1
      ONBAR(1)=ABLANK
      ONBAR(2)=ABLANK
      IF(IAND(BOARD(1),15).GE.1) ONBAR(1)=AW
      IF(IAND(BOARD(26),15).GE.1) ONBAR(2)=AR
      DO 40 I=1,12
      PRNTBF(2*(I-1)+1)=ABLANK
      PRNTBF(2*(I-1)+2)=ABLANK
      IF(IAND(BOARD(I+1),15).NE.15) GO TO 35
      PFLAG=1
      PRNTBF(2*(I-1)+1)=AR
      IF(ISHFT(BOARD(I+1),-4).EQ.0) PRNTBF(2*(I-1)+1)=AW
35    CONTINUE
      IF(IAND(BOARD(26-I),15).NE.15) GO TO 40
      PFLAG=1
      PRNTBF(2*(I-1)+2)=AR
      IF(ISHFT(BOARD(26-I),-4).EQ.0) PRNTBF(2*(I-1)+2)=AW
40    CONTINUE
      IF (PFLAG.EQ.0) GO TO 41
      WRITE(5,30) AVERT,(PRNTBF(K),K=1,12),AVERT,ONBAR,AVERT,
     1(PRNTBF(K),K=13,24),AVERT
      GO TO 42
41    WRITE(5,*) ' '
42    CONTINUE
      DO 50 I=1,7
      PFLAG=0
      COUNT=8-I
      ONBAR(1)=ABLANK
      ONBAR(2)=ABLANK
      IF(IAND(BOARD(1),15).GE.8+I) ONBAR(1)=AW
      IF(IAND(BOARD(26),15).GE.1+I) ONBAR(2)=AR
      IF((ONBAR(1).NE.ABLANK).OR.(ONBAR(2).NE.ABLANK))PFLAG=1
      DO 60 J=1,12
      CNT = 26-J
      PRNTBF(2*(J-1)+1)=ABLANK
      PRNTBF(2*(J-1)+2)=ABLANK
      IF(IAND(BOARD(CNT),15).LT.COUNT) GO TO 60
      PFLAG=1
      PRNTBF(2*(J-1)+1)=AR
      IF(ISHFT(BOARD(CNT),-4).EQ.0) PRNTBF(2*(J-1)+1)=AW
      IF(IAND(BOARD(CNT),15).LT.COUNT+7) GO TO 60
      PRNTBF(2*(J-1)+2)=AR
      IF(ISHFT(BOARD(CNT),-4).EQ.0) PRNTBF(2*(J-1)+2)=AW
60    CONTINUE
      IF (PFLAG.EQ.0) GO TO 50
      WRITE(5,30) AVERT,(PRNTBF(K),K=1,12),AVERT,ONBAR,AVERT,
     1(PRNTBF(K),K=13,24),AVERT
      GO TO 50
61    WRITE(5,*) ' '
50    CONTINUE
      WRITE(5,*)
     1'|--++----++----++----++----++----++--|    |--++----++----++----++
     2----++----++--|'
      WRITE(5,*)
     1'   24    23    22    21    20    19          18    17    16    15
     2    14    13'
      RETURN
      END
      SUBROUTINE INIT(BOARD)
      INTEGER BOARD(26)
      RED=16
      WHITE=0
      DO 10 I=1,26
10    BOARD(I)=0
      BOARD(2)=WHITE+2
      BOARD(7)=RED+5
      BOARD(9)= RED+3
      BOARD(13)=WHITE+5
      BOARD(14)=RED+5
      BOARD(18)=WHITE+3
      BOARD(20)=WHITE+5
      BOARD(25)=RED+2
      RETURN
      END
      SUBROUTINE INPMOV(BOARD,ROLL)
      INTEGER ROLL(2),MOVE(2,4),BOARD(26),BOARD1(26),BOARD2(26)
      INTEGER TEST(2)
      MOVSW=0
      WRITE(5,3) ROLL
3     FORMAT(1X, 'You roll',2I2,'.')
      IF(BOARD(1).EQ.0) GO TO 67
      TEST(1)=1
      TEST(2)=ROLL(1)
      IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67
      TEST(2)=ROLL(2)
      IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67
      WRITE(5,*)'You have no move.'
      RETURN
67    CONTINUE
      WRITE(5,300)
300   FORMAT(' Your move?>',$)
      GO TO 4
61    WRITE(5,1)
1     FORMAT(1X, 'Try again>'$)
4     READ(5,2,END=99,ERR=61) MOVE
2     FORMAT(8I6)
      DO 199 I = 1,4
      IF (MOVE(2,I) .NE. 0) MOVE(1,I) = MOVE(1,I) + 1
199   CONTINUE
      IF(MOVE(1,1).EQ.0) RETURN
      IF(MOVE(1,2).NE.0) GO TO 64
      IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61
      CALL MAKMOV(BOARD,BOARD,MOVE(1,1))
      GOTO 68
64    IF(MOVE(2,1).EQ.ROLL(1).AND.MOVE(2,2).EQ.ROLL(2)) GO TO 62
      IF(MOVE(2,1).EQ.ROLL(2).AND.MOVE(2,2).EQ.ROLL(1)) GO TO 62
      GO TO 61
62    IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61
      CALL MAKMOV(BOARD,BOARD1,MOVE(1,1))
      IF(MOVCHK(BOARD1,MOVE(1,2)).EQ.0) GO TO 61
      CALL MAKMOV(BOARD1,BOARD,MOVE(1,2))
68    IF(ROLL(1).EQ.ROLL(2).AND.MOVSW.EQ.0) GO TO 80
      RETURN
80    CONTINUE
      WRITE(5,*)'Input next move'
      MOVSW=1
      GO TO 4
99    WRITE(5,*)'Nice Playing With You.'
      STOP
      END
      SUBROUTINE MAKNXT(BOARD,NEWBRD,MOVE)
      INTEGER BOARD(26),NEWBRD(26),MOVE(2)
10    CALL NXTMOV(BOARD,MOVE)
      IF(MOVE(1).EQ.-1) RETURN
      IF(MOVCHK(BOARD,MOVE).EQ.0) GO TO 10
      CALL MAKMOV(BOARD,NEWBRD,MOVE)
      RETURN
      END
      SUBROUTINE EVAL(BOARD,STATUS)
      INTEGER BOARD(26),STATUS(6)
      DATA LUTR /6/
      DO 5 I=1,6
5     STATUS(I)=0
      DO 10 I=1,25
      IF(BOARD(I).EQ.0) GO TO 10
      IF(ISHFT(BOARD(I),-4).NE.0) GO TO 10
      STATUS(1)=STATUS(1)+IAND(BOARD(I),15)*(26-I)
10    CONTINUE
      DO 20 I=2,26
      IF(BOARD(I).EQ.0) GO TO 20
      IF(ISHFT(BOARD(I),-4).EQ.0) GO TO 20
      STATUS(2)=STATUS(2)+IAND(BOARD(I),15)*(I-1)
20    CONTINUE
      DO 30 I=2,25
      IBRDP=BOARD(I)
      IF(IBRDP.EQ.0) GOTO 30
      IF(ISHFT(IBRDP,-4).NE.0) GO TO 30
      IF(IAND(IBRDP,15).NE.1) GO TO 30
      K=I+12
      IF(K.GT.25) K=25
      DO 35 J=I,K
      IF(ISHFT(BOARD(J),-4).NE.1) GO TO 35
      STATUS(3)=STATUS(3)+2-(J-I)/6
35    CONTINUE
30    CONTINUE
      VUN=0
      DO 40 I=1,25
      IBRDP=BOARD(I)
      IF(IBRDP.EQ.0) GOTO 40
      IF(ISHFT(IBRDP,-4).NE.1) GO TO 40
      IF(IAND(IBRDP,15).GT.1) GO TO 40
      ISW=0
      IF(I.GE.20) ISW=1
      K=I-12
      IF(K.LT.1) K=1
      VUN=0
      DO 45 J=K,I
      IF(BOARD(J).EQ.0) GOTO 45
      IF(ISHFT(BOARD(J),-4).NE.0) GO TO 45
      RANGE=I-J
      VUN=VUN+(2-(RANGE-1)/6)
45    CONTINUE
      IF(VUN.GT.5) VUN=5
      ADV=(31-I)/6
      POCC=0
      DO 49 K=20,25
      IF(BOARD(K).EQ.0) GOTO 49
      IF(ISHFT(BOARD(K),-4).NE.0) GO TO 49
      IF(IAND(BOARD(K),15).LT.2) GO TO 49
      POCC=POCC+1
49    CONTINUE
      POCC=POCC/3+1
      IF(ADV.EQ.1.AND.POCC.LE.2) VUN=VUN/2
      NETVUN=VUN*ADV*POCC
      STATUS(4)=STATUS(4)+NETVUN
40    CONTINUE
      STATUS(5)=STATUS(1)-STATUS(2)+STATUS(3)
      STATUS(6)=STATUS(2)-STATUS(1)+STATUS(4)
      IOURS=1
      PCNT=0
      MCNT=0
      DO 50 I=1,26
      IBP=BOARD(I)
      CNT=IAND(IBP,15)
      IF(IBP.EQ.0) GO TO 50
      IF(ISHFT(IBP,-4).NE.IOURS) GOTO 50
      MCNT=MCNT+CNT
      IF(CNT.GT.3) STATUS(6)=STATUS(6)+CNT-3
      IF(CNT.LT.2) GO TO 50
      PCNT=PCNT+1
50    CONTINUE
      STATUS(6)=STATUS(6)-PCNT+MCNT*3
      RETURN
      END
