SUBROUTINE OLOGIC C IMPLICIT INTEGER (A-Z) COMMON /BCNT/ BCOUNT (3) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /DESR/ DESIRE (128), MOVNUM COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /MOV1/ MOVCNT, MOVLEV(20) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /QUIT/ DONE, SAVE, OPERR, CLOERR, WRTERR, REDERR COMMON /VECT/ XVEC (8), YVEC (8) D COMMON /DEBG/ DML (20), DEBCNT D LOGICAL*1 DEBCNT LOGICAL*1 CYBORG, BCHR C C The following values are constants C DATA XVEC / 0, 1, 1, 1, 0,-1,-1,-1/ DATA YVEC / 1, 1, 0,-1,-1,-1, 0, 1/ DATA HUMAN, COMPTR /1,-1/ DATA BCHR /'W','-','B'/ DATA DONE, SAVE, OPERR, CLOERR, WRTERR, REDERR 1 /1, 2, 3, 4, 5, 6/ C DATA DESIRE /120, -2, 12, 12, 12, 12, -2,120, 2 -2,-50, 0, 0, 0, 0,-50, -2, 3 12, 0, 2, 1, 1, 2, 0, 12, 4 12, 0, 1, 2, 2, 1, 0, 12, 5 12, 0, 1, 2, 2, 1, 0, 12, 6 12, 0, 2, 1, 1, 2, 0, 12, 7 -2,-50, 0, 0, 0, 0,-50, -2, 8 120, -2, 12, 12, 12, 12, -2,120, 9 1 120, 0, 12, 12, 12, 12, 0,120, 2 0,-50, 1, 1, 1, 1,-50, 0, 3 12, 1, 2, 1, 1, 2, 1, 12, 4 12, 1, 1, 2, 2, 1, 1, 12, 5 12, 1, 1, 2, 2, 1, 1, 12, 6 12, 1, 2, 1, 1, 2, 1, 12, 7 0,-50, 1, 1, 1, 1,-50, 0, 8 120, 0, 12, 12, 12, 12, 0,120/ C CALL INIT ! Initialize the game 10 IF (.NOT. CYBORG .AND. (PLAYER .EQ. HUMAN)) GOTO 20 CALL COMOVE (I) ! Computer playing GOTO 30 ! Continue C 20 CALL HUMOVE (I) ! Input and verify the move IF (CYBORG) GOTO 10 IF (I .EQ. -1) GOTO 10 30 IF (I .EQ. 0) GOTO 40 ! Branch if no move MLIST (1,1) = 1 MLIST (2,1) = I CALL MAKMOV (1) MOVNUM = MOVNUM + 1 IF (MOVNUM .GE. 52) LOOK = 8 IF (MOVNUM .GE. 50 .AND. LOOK .GT. 3) LOOK = 10 CALL PBOARD ! Print the board 40 IF (NOMOVE .EQ. 2) CALL ITQUIT (DONE) PLAYER = -PLAYER ! Other player's turn GOTO 10 C END SUBROUTINE INIT C C C IMPLICIT INTEGER (A-Z) REAL PLTIME D LOGICAL*1 DEBCNT LOGICAL*1 CYBORG, BCHR C LOGICAL*1 RESPON,YES COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /DESR/ DESIRE (128), MOVNUM COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /TIME/ PLTIME (3) COMMON /VECT/ XVEC (8), YVEC (8) D COMMON /DEBG/ DML (20), DEBCNT DATA YES /'Y'/ C DO 1000 I = 1,8 DO 1000 J = 1,8 1000 BOARD (I,J) = 0 BOARD (5,5) = 1 BOARD (4,4) = 1 BOARD (5,4) = -1 BOARD (4,5) = -1 CYBORG = .FALSE. D DEBCNT = .FALSE. NOMOVE = 0 PLTIME(1)=0 PLTIME(2)=0 PLTIME(3)=0 MOVNUM = 1 C TYPE 1009,-101,91,63,50,108,-101,92 1009 FORMAT (1H+,7(A1)) CALL HOME CALL CLREOS TYPE 1 1 FORMAT (1H+,30X,'Othello V04.04',/////) C TYPE 3 C3 FORMAT (' Help needed (Y or N)? '$) C ACCEPT 1002,RESPON 1002 FORMAT (A1) C IF (RESPON .NE. YES) GOTO 1004 1004 TYPE 4 4 FORMAT (' Look ahead limit (0-10; suggest 3) ? '$) ACCEPT 1006,LOOK 1006 FORMAT (I5) IF (LOOK .GT. 10 .OR. LOOK .LT. 0) GOTO 1004 PLAYER = HUMAN TYPE 5 5 FORMAT (' Should I go first (Y or N) ? ',$) ACCEPT 1002,RESPON IF (RESPON .NE. YES) GOTO 1008 HUMAN = COMPTR COMPTR = PLAYER 1008 CONTINUE CALL INITSC RETURN END SUBROUTINE HUMOVE (T0) IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /QUIT/ DONE, SAVE, OPERR, CLOERR, WRTERR, REDERR LOGICAL*1 CYBORG, BCHR REAL ELTIME, SECNDS C LOGICAL*1 S1,S2,AEE,SEE,DEE,EEE,EFF,PEE,ARE,ESS DATA AEE,SEE,DEE,EEE,EFF,PEE,ARE,ESS 1 /'A','C','D','E','F','P','R','S'/ C ERROR = 20 C 5 CALL GEN (3) ! Generate the possible moves ELTIME=SECNDS(0) 6 T0 = MLIST (1,3) ! Get the number of moves I = T0 IF (I .NE. 0) GOTO 10 ! Branch if any CALL POINT (PLAYER+13,0) CALL CLREOL TYPE 1 1 FORMAT ('+You have no moves',/) NOMOVE = NOMOVE + 1 GOTO 45 C 10 NOMOVE = 0 CALL DSPMOV (3) ! Display the valid moves CALL POINT (PLAYER+13,0) CALL CLREOL TYPE 2 2 FORMAT ('+Your move: '$) ACCEPT 3,S1,S2 3 FORMAT (2A1) C IF (S1 .EQ. ESS .AND. S2 .EQ. AEE) GOTO 50 IF (S1 .EQ. ARE .AND. S2 .EQ. EEE) GOTO 60 D IF (S1 .EQ. DEE .AND. S2 .EQ. EEE) GOTO 70 IF (S1 .EQ. AEE .AND. S2 .EQ. PEE) GOTO 80 IF (S1 .EQ. PEE .AND. S2 .EQ. AEE) GOTO 90 IF (S1 .EQ. SEE .AND. S2 .EQ. ESS) GOTO 100 C 15 T1 = S1 T2 = S2 T1 = T1 - 64 T2 = T2 - 47 IF (T1 .LE. 0 .OR. T1 .GE. 9) GOTO 30 IF (T2 .LE. 0 .OR. T2 .GE. 9) GOTO 30 T0 = 10 * T1 + T2 20 IF (T0 .EQ. MLIST (I+1,3)) GOTO 40 I = I - 1 IF (I .NE. 0) GOTO 20 30 CALL POINT (ERROR,0) CALL CLREOS TYPE 4,7,7 4 FORMAT (1H+,A1,'Illegal move!',A1) DO 35 T1 = 1,600 DO 35 T2 = 1,300 35 CONTINUE CALL POINT (ERROR,0) CALL CLREOS GOTO 6 C 50 OPEN (UNIT=1,NAME='OTHELO.LOG',TYPE='NEW',ERR=59) WRITE (1,53,END=58,ERR=58)PLAYER,HUMAN,COMPTR 53 FORMAT (1X,3(I2)) DO 51 I = 8,1,-1 WRITE (1,52,ERR=58,END=58)(BOARD(J,I),J=1,8) 52 FORMAT (1X,8(I2)) 51 CONTINUE CLOSE (UNIT=1,DISP='SAVE',ERR=57) CALL ITQUIT (SAVE) C 57 CALL ITQUIT (CLOERR) C 58 CALL ITQUIT (WRTERR) C 59 CALL ITQUIT (OPERR) C 60 OPEN (UNIT=1,NAME='OTHELO.LOG',TYPE='OLD',ERR=59) READ (1,53,END=69,ERR=69)PLAYER,HUMAN,COMPTR DO 61 I = 8,1,-1 READ (1,52,END=69,ERR=69)(BOARD(J,I),J=1,8) 61 CONTINUE CLOSE (UNIT=1,DISP='SAVE',ERR=57) CALL PBOARD (3) GOTO 5 C 69 CALL ITQUIT (REDERR) C D70 CALL DEBUG D GOTO 5 C 80 CYBORG = .TRUE. GOTO 91 C 90 T0 = 0 91 CALL POINT (PLAYER+12,0) CALL CLREOL GOTO 45 C 100 TYPE 1009,-101,91,63,50,108,-101,92 1009 FORMAT (1H+,7(A1)) CALL INITSC GOTO 6 C 40 CONTINUE CALL DSPTIM ( SECNDS(ELTIME) ) 45 RETURN END SUBROUTINE COMOVE (I) C C C IMPLICIT INTEGER (A-Z) COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR LOGICAL*1 CYBORG, BCHR C REAL ELTIME, SECNDS LOGICAL*1 L1,L2 C CALL POINT (PLAYER+13,0) CALL CLREOL TYPE 1,BCHR (PLAYER+2) 1 FORMAT ('+',A1,' thinking...',/) ELTIME=SECNDS(0) CALL ALPBET (I,J) ELTIME=SECNDS(ELTIME) CALL POINT (PLAYER+13,0) CALL CLREOL IF (I .NE. 0) GOTO 10 TYPE 2,BCHR (PLAYER+2) 2 FORMAT ('+',A1,' has no moves',/) NOMOVE = NOMOVE + 1 GOTO 20 C 10 NOMOVE = 0 CALL CNVMOV (I,L1,L2) TYPE 3,BCHR (PLAYER+2),L1,L2 3 FORMAT ('+',A1,'''s move = ',2A1) 20 CONTINUE CALL DSPTIM (ELTIME) RETURN END SUBROUTINE CNVMOV (I,L1,L2) C C C IMPLICIT INTEGER (A-Z) LOGICAL*1 L1,L2 C I1 = 64 + I / 10 I2 = 47 + I - 10 * (I / 10) L1 = I1 L2 = I2 RETURN END SUBROUTINE ALPBET (IZ,JZ) C C This function returns the best move for the current player. It is an C alpha-beta prune based on Knuth and Moore's article "An Analysis of C Alpha-Beta Pruning." C IMPLICIT INTEGER (A-Z) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /MOV1/ MOVCNT, MOVLEV(20) C DIMENSION A (20), B(20), ML (20) C MINFIN = -32767 ! - infinity + 1 L = 3 ! Alpha-beta index A (L-2) = MINFIN ! Initialize alpha-beta array A (L-1) = MINFIN ! C 10 CONTINUE IF (L .GT. LOOK + 3) GOTO 50 ! Done if at end of lookahead CALL GEN (L) ! Generate all valid moves I = MAKMOV (L) ! Generate board for 1st one A (L) = A (L-2) ! Copy value of lower bound B (L) = I ! Copy move 20 PLAYER = -PLAYER L = L + 1 ! Bump level GOTO 10 C 30 IF (-A (L+1) .LE. A (L)) GOTO 40 ! Branch if move no better A (L) = -A (L+1) ! Copy new value ML (L) = B(L) ! and maybe new move IF (A (L+1) .LE. A (L-1)) GOTO 60 ! Branch if we can prune 40 I = MAKMOV (L) ! else get next branch IF (I .EQ. 0) GOTO 60 !Branch if there's no move B (L) = I PLAYER = -PLAYER L = L + 1 ! Bump level GOTO 10 C 50 A (L) = EVAL (L) ! Evaluate the move 60 L = L - 1 ! Decrement the level IF (L .LT. 3) GOTO 70 ! Branch if more to come CALL UNMAKE (L) PLAYER = -PLAYER GOTO 30 C 70 IZ = ML (3) JZ = A (3) ! Return the best value RETURN END SUBROUTINE GEN (L) C C This subroutine generates all the possible moves from a given C position. C IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /MOV1/ MOVCNT, MOVLEV(20) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /VECT/ XVEC (8), YVEC (8) DIMENSION XVEC1 (64), YVEC1 (64) C DATA XVEC1 /1,1,8,8,1,1,1,1,3,3,4,4,5,5,6,6,8,8,8,8, 1 3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6,2,2,2,2,3,3,4,4,5,5, 2 6,6,7,7,7,7,1,1,2,2,7,7,8,8,2,2,7,7/ DATA YVEC1 /1,8,1,8,3,4,5,6,1,8,1,8,1,8,1,8,3,4,5,6, 1 3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,3,4,5,6,2,7,2,7,2,7, 2 2,7,3,4,5,6,2,7,1,8,1,8,2,7,2,7,2,7/ C MOVCNT = 1 ! Initialize move list index DO 60 K = 64,1,-1 ! Check all possible positions I = XVEC1 (K) ! Check for moves in the an J = YVEC1 (K) ! optimal order for prune. IF (BOARD (I,J) .NE. 0) GOTO 60 ! No good if already occupied DO 30 T = 1,8 ! Check for valid move S1 = 0 ! Secondary move flag I1 = I J1 = J 10 I1 = I1 + XVEC (T) ! Look around the square J1 = J1 + YVEC (T) IF (I1 .LT. 1 .OR. I1 .GT. 8) GOTO 30 ! Boundary check IF (J1 .LT. 1 .OR. J1 .GT. 8) GOTO 30 M = BOARD (I1,J1) IF (M .EQ. 0) GOTO 30 IF (M .EQ. PLAYER) GOTO 20 ! Done S1 = 1 ! Set flag GOTO 10 ! Continue C 20 IF (S1 .EQ. 0) GOTO 30 ! Not a valid move so far MOVCNT = MOVCNT + 1 ! Bump the move counter MLIST (MOVCNT,L) = 10 * I + J ! Save the move GOTO 60 30 CONTINUE 60 CONTINUE 70 MLIST (1,L) = MOVCNT - 1 ! Save the number of moves MOVLEV (L) = MOVCNT - 1 RETURN END INTEGER FUNCTION MAKMOV (L) IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /VECT/ XVEC (8), YVEC (8) D COMMON /DEBG/ DML (20), DEBCNT D LOGICAL*1 DEBCNT C N = 0 MOVE = 0 I = MLIST (1,L) IF (I .EQ. 0) GOTO 60 MOVE = MLIST (I+1,L) MLIST (1,L) = MLIST (1,L) - 1 N = N + 1 UNMOVE (L,1,N) = MOVE UNMOVE (L,2,N) = 0 I = MOVE / 10 J = MOVE - 10 * (MOVE / 10) BOARD (I,J) = PLAYER DO 50 K = 1,8 I1 = I + XVEC (K) J1 = J + YVEC (K) IF (I1 .LT. 1 .OR. I1 .GT. 8) GOTO 50 IF (J1 .LT. 1 .OR. J1 .GT. 8) GOTO 50 IF (BOARD (I1,J1) .NE. -PLAYER) GOTO 50 COUNT = 0 10 I1 = I1 + XVEC (K) J1 = J1 + YVEC (K) IF (I1 .LT. 1 .OR. I1 .GT. 8) GOTO 20 IF (J1 .LT. 1 .OR. J1 .GT. 8) GOTO 20 COUNT = COUNT + 1 M = BOARD (I1,J1) IF (M .EQ. -PLAYER) GOTO 10 IF (M .EQ. PLAYER) GOTO 30 20 COUNT = 0 30 IF (COUNT .EQ. 0) GOTO 50 DO 40 M = 1,COUNT I1 = I1 - XVEC (K) J1 = J1 - YVEC (K) BOARD (I1,J1) = PLAYER N = N + 1 UNMOVE (L,1,N) = I1 * 10 + J1 UNMOVE (L,2,N) = -PLAYER 40 CONTINUE 50 CONTINUE 60 UNMOVE (L,1,N+1) = 0 CD IF (DEBCNT) CALL PBOARD MAKMOV = MOVE RETURN END SUBROUTINE UNMAKE (L) IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) C N = 1 10 I = UNMOVE (L,1,N) IF (I .EQ. 0) GOTO 20 J = I / 10 K = I - 10 * (I / 10) BOARD (J,K) = UNMOVE (L,2,N) N = N + 1 IF (N .LT. 15) GOTO 10 1 FORMAT (' L = ',I3,' N = ',I3) GOTO 10 C 20 RETURN END SUBROUTINE DSPMOV (L) C C C IMPLICIT INTEGER (A-Z) COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR LOGICAL*1 CYBORG, BCHR, SCOPE C LOGICAL*1 SLASH, S (132) C DATA SLASH /'/'/ C I = MLIST (1,L) J = 2 98 IF (J .GT. I) GOTO 100 IF (MLIST (J,L) .GT. MLIST (J+1,L)) GOTO 99 K = MLIST (J,L) MLIST (J,L) = MLIST (J+1,L) MLIST (J+1,L) = K J = 2 GOTO 98 C 99 J = J + 1 GOTO 98 C 100 CONTINUE K = 1 10 S (K) = SLASH K = K + 1 CALL CNVMOV (MLIST (I+1,L),S(K),S(K+1)) K = K + 2 I = I - 1 IF (I .NE. 0) GOTO 10 CALL POINT (PLAYER+12,0) CALL CLREOL TYPE 1, MLIST (1,L), BCHR (PLAYER+2), (S (I), I = 1,K-1) 1 FORMAT ('+ ',I2,' moves for ',A1,' ',80A1) RETURN END SUBROUTINE POINT (Y,X) C C C IMPLICIT INTEGER (A-Z) C TYPE 1,-101,89,Y+32,X+32 1 FORMAT (1X,4A1$) RETURN END SUBROUTINE CLREOL C C C IMPLICIT INTEGER (A-Z) C TYPE 1,-101,75 1 FORMAT (1H+,2(A1)) RETURN END SUBROUTINE CLREOS C C C IMPLICIT INTEGER (A-Z) C TYPE 1,-101,74 1 FORMAT (1H+,2(A1)) RETURN END SUBROUTINE HOME C C C IMPLICIT INTEGER (A-Z) C TYPE 1,-101,72 1 FORMAT ('+',2(A1)) RETURN END SUBROUTINE PBOARD C C This routine displays the board. C IMPLICIT INTEGER (A-Z) COMMON /BCNT/ T (3) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR LOGICAL*1 CYBORG, BCHR C LOGICAL*1 S(80), BLANK C DATA ESCAPE, POINT1 /-101,89/ DATA BLANK /' '/ C T(1) = 0 T(2) = 0 T(3) = 0 S(1) = ESCAPE S(2) = POINT1 DO 500 J=1,8 K=3 M=0 DO 300 I=1,8 T(BOARD(I,J)+2) = T(BOARD(I,J)+2)+1 IF (BOARD(I,J) .EQ. OBOARD(I,J)) GOTO 200 IF (K.EQ.3) GOTO 100 IF (K.EQ.M) GOTO 150 S(K) = ESCAPE K = K+1 S(K) = POINT1 K = K+1 100 S(K) = 32+(9-J) K = K+1 S(K) = 32+(I*2) K = K+1 150 OBOARD(I,J) = BOARD(I,J) S(K) = BCHR(BOARD(I,J)+2) K = K+1 S(K) = BLANK K = K+1 M = K GOTO 300 C 200 M = 0 300 CONTINUE TYPE 400,(S(L),L=1,K-1) 400 FORMAT ('+',80(A1),/) 500 CONTINUE CALL POINT (4,31) TYPE 710,T(3),T(1),T(2) 710 FORMAT ('+ ',I2,' B''es ',I2,' W''es ',I2,' empty ') IF (T(2).NE.0) GOTO 1000 CALL ITQUIT (DONE) 1000 RETURN END SUBROUTINE INITSC C C Initialize the screen C IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /LOGS/ CYBORG, BCHR (3), SCOPE COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR LOGICAL*1 CYBORG, BCHR C CALL HOME CALL CLREOS TYPE 3333,((I-1,I-1),I=8,1,-1) 3333 FORMAT ('+ a b c d e f g h',/,8(' ',I1,17X,I1,/), 1 ' a b c d e f g h',/) CALL POINT (2,39) !Position cursor TYPE 1300 !Heading 1300 FORMAT ('+*** Othello ***'/) DO 100 I=1,8 DO 100 J=1,8 100 OBOARD(I,J) = -2 CALL PBOARD RETURN END SUBROUTINE ITQUIT (I) C C C IMPLICIT INTEGER (A-Z) C ERROR = 20 C CALL POINT (ERROR,0) GOTO (1,2,3,4,5,6) I C 1 CALL EXIT C 2 TYPE 20 20 FORMAT ('+Game saved...') GOTO 1 C 3 TYPE 30 30 FORMAT ('+?OPEN error for file OTHELO.LOG') GOTO 1 C 4 TYPE 40 40 FORMAT ('+?CLOSE error for file OTHELO.LOG') GOTO 1 C 5 TYPE 50 50 FORMAT ('+?OUTPUT error for file OTHELO.LOG') GOTO 1 C 6 TYPE 60 60 FORMAT ('+?INPUT error for file OTHELO.LOG') GOTO 1 C END INTEGER FUNCTION EVAL (L) C C This function performs a static evaluation of the board. The current C implementation is only for debugging purposes. The final version C will be much more complete. C IMPLICIT INTEGER (A-Z) COMMON /BORD/ BOARD (8,8), OBOARD (8,8) COMMON /DESR/ DESIRE (128), MOVNUM COMMON /MOVE/ MLIST (50,20), NOMOVE, UNMOVE (20,2,21) COMMON /MOV1/ MOVCNT, MOVLEV(20) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR D COMMON /DEBG/ DML (20), DEBCNT D LOGICAL*1 DEBCNT DIMENSION ABOARD (64) EQUIVALENCE (ABOARD(1),BOARD(1,1)) INTEGER MOVADJ(10),MOVAD1(10) DATA MOVADJ/50,30,15,10,8,5,0,-5,-10,-15/ DATA MOVAD1/-50,-30,-15,-10,-8,-5,0,5,10,15/ J = -1 V = 0 Q = 0 R = 0 IF (MOVNUM + L - 3 .LT. 60 ) GOTO 10 DO 12 I = 1,64 V = V + ABOARD (I) 12 CONTINUE IF (PLAYER .LT. 0) V = -V GOTO 30 10 CONTINUE J = 0 IF (MOVNUM + L - 3 .GT. 17 ) J = 64 DO 20 I = 1,64 M = I + J K = ABOARD (I) IF (K .EQ. 0) GOTO 20 TEMP = DESIRE (M) IF (K .NE. PLAYER) TEMP = - TEMP V = V + TEMP 20 CONTINUE R = MOVADJ (MIN0( MOVLEV (L-1) , 9 )+1) IF (L .GT. 4) Q = MOVAD1( MIN0( MOVLEV (L-2) , 9 )+1) 30 EVAL = V + Q + R IF (DEBCNT .EQ. .FALSE.) RETURN CALL PBOARD CALL POINT(16,4) TYPE 99,-EVAL,-V,-Q,-R,J 99 FORMAT('+',5I6) ACCEPT 98 98 FORMAT(A1) RETURN END SUBROUTINE DSPTIM (ELTIME) IMPLICIT INTEGER (A-Z) REAL ELTIME, PLTIME LOGICAL*1 OUTTIM (8) COMMON /PLAY/ PLAYER, LOOK, HUMAN, COMPTR COMMON /TIME/ PLTIME (3) C PLTIME (PLAYER+2) = PLTIME (PLAYER+2) + ELTIME CALL POINT (6,-PLAYER*5+36) TYPE 1,ELTIME 1 FORMAT('+',F7.1) CALL POINT (7,-PLAYER*5+36) TYPE 1,PLTIME(PLAYER+2) RETURN END D SUBROUTINE DEBUG D IMPLICIT INTEGER (A-Z) D COMMON /BORD/ BOARD (8,8), OBOARD (8,8) D COMMON /DEBG/ DML (20), DEBCNT D LOGICAL*1 DEBCNT D LOGICAL*1 S1,S2,S3,S4,S5 D LOGICAL*1 BEE,SEE,DEE,EEE,EFF,ELL,EMM,ESS,EXS D DATA BEE,SEE,DEE,EFF,ELL,EMM,ESS /'B','C','D','F','L','M','S'/ D DATA EEE,EXS /'E','X'/ D ERROR = 20 D10 CALL POINT (ERROR,0) D CALL CLREOS D TYPE 3 D3 FORMAT ('+DEBUG>'$) D ACCEPT 1,S1,S2,S3,S4,S5 D1 FORMAT (5(A1)) D IF (S1 .EQ. DEE .AND. S2 .EQ. EMM) GOTO 50 D IF (S1 .EQ. ESS .AND. S2 .EQ. BEE) GOTO 60 D IF (S1 .EQ. EEE .AND. S2 .EQ. EXS) GOTO 100 D CALL POINT (ERROR,0) D TYPE 2,7,7 D2 FORMAT (1H+,A1,'Illegal command',A1$) D DO 35 T1 = 1,600 D DO 35 T2 = 1,300 D35 CONTINUE D CALL POINT (ERROR,0) D CALL CLREOS D GOTO 10 D50 DEBCNT = .NOT. DEBCNT D GOTO 10 D60 I = -1 D IF (S3 .EQ. BEE) I = 1 D J = S4 D K = S5 D J = J - 64 D K = K - 47 D BOARD (J,K) = I D CALL PBOARD D GOTO 10 D100 CALL POINT (ERROR,0) D CALL CLREOS D RETURN D END