PROGRAM CHESS IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR,FIRST EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(FIRST,I1(87)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) C C PROGRAMMERS: SID HEIDT,GLENN FADEN C CONTRIBUTOR: GLENN FADEN C MINOR CONTRIBUTOR: MICHAEL ELLIS C C THIS PROGRAM WAS FIRST WRITTEN FOR THE 86 IN C FALL, 1975. IT WAS UPGRADED FOR THE 32 IN FEBRUARY, 1977. C THE CURRENT VERSION WAS COMPLETED IN FEBRUARY, 1978. C C GLOBAL COMMON DATA LAYOUT C MOVENUM - CURRENT MOVE NUMBER C WGAME - WHITE MOVES(EACH MOVE OCCUPIES FOUR LOCATIONS) C BGAME - BLACK MOVES(EACH MOVE OCCUPIES FOUR LOCATIONS) C WKCASTLE- CHECKS FOR KING CASTLING FOR WHITE C WQCASTLE- CHECKS FOR QUEEN CASTLING FOR WHITE C BKCASTLE- CHECKS FOR KING CASTLING FOR BLACK C BQCASTLE- CHECKS FOR QUEEN CASTLING FOR BLACK C C MULTI-LEVEL COMMON DATA LAYOUT C BOARD(8,8) - CURRENT BOARD C WSQUARES(32,2,16) - WHITE POSSIBLE MOVES C BSQUARES(32,2,16) - BLACK POSSIBLE MOVES C ****B/WSSQUARES(2,1,-)= NUMBER OF POSSIBLE MOVES C (2,2,-)=PIECE TYPE(1=P,2=N,3=B,4=R,5=Q,6=K) C (1,1,-)=ZERO IF PIECE NOT ON BOARD C (1,2,-)= CURRENT POSITION C CONTROL(8,8,-16:16) - ATTACKERS FOR A SPECIFIC SQUARE C ****CONTROL(N,M,1)=NUMBER OF ATTACKERS ON BOARD SQUARE(N,M) C (N,M,-)=PIECE NUMBER OF ATTACKER C C PIECE BOARD ARRAY REPRESENTATION C WHITE BLACK C K 16 -16 C Q 15 -15 C KR 14 -14 C QR 13 -13 C KB 12 -12 C QB 11 -11 C KN 10 -10 C QN 9 - 9 C KRP 8 - 8 C KBP 7 - 7 C KNP 6 - 6 C KP 5 - 5 C QP 4 - 4 C QNP 3 - 3 C QBP 2 - 2 C QRP 1 - 1 C (VACANT) 0 0 C C 20 DO 30 I=1,88 30 I1(I) = 0 DO 40 I=1,4224 40 I2(I) = 0 100 CALL SETUP 199 CALL EVAL MNEXT=4 200 IF (MOVENUM.EQ.0)GOTO 303 IF(VAR)GOTO 302 301 CALL WMOVE1(*500,*600,*800) 302 CALL ENTERW(MNEXT) IF(MNEXT.EQ.4)GOTO 301 303 CALL ENTERW1(MNEXT,*400) 400 CALL READB(*199) 440 CALL ENTERB(*700,*450,T5) GO TO 200 450 CALL PROMOTE(T5) GOTO 199 500 CALL RESIGN 600 CALL STALE 700 CALL HONOR GOTO 400 800 CALL MATE 1000 CALL WINDUP2(*20,*400) END SUBROUTINE MATE IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER MESS1*20, MESS2*20, MESS3*8, MESS4*9 DATA MESS1/'YOU MUST HONOR CHECK'/ DATA MESS2/'THAT''S CHECKMATE ! '/ DATA MESS3/'I RESIGN'/ DATA MESS4/'STALEMATE'/ CALL ENTERW1(3,*100) ENTRY STALE CALL TELEW(MESS4,9) CALL WINDUP 100 CALL TELEW(MESS2,20) CALL WINDUP ENTRY RESIGN CALL TELEW(MESS3,8) CALL WINDUP ENTRY HONOR CALL TELEW(MESS1,20) RETURN END SUBROUTINE ENTERB(*,*,T6) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES INTEGER T6 COMMON/A/I1(88),I2(4224) COMMON/B/I4 DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) INTEGER*4 I4(1024),I8(1024) EQUIVALENCE (BSQUARES(1,1,1),I8(1)) DO 50 I=1,1024 I4(I)=I8(I) 50 CONTINUE INDEX=(MOVENUM*4)-3 T1=BGAME(INDEX) T2=BGAME(INDEX+1) T3=BGAME(INDEX+2) T4=BGAME(INDEX+3) T5=BOARD(T3,T4) IF(BOARD(T3,T4).EQ.0) GO TO 100 WSQUARES(1,1,BOARD(T3,T4))=0 WSQUARES(1,2,BOARD(T3,T4))=0 WSQUARES(2,1,BOARD(T3,T4))=0 100 BOARD(T3,T4)=BOARD(T1,T2) BOARD(T1,T2)=0 T6=-BOARD(T3,T4) BSQUARES(1,1,T6)=T3 BSQUARES(1,2,T6)=T4 CALL EVAL CALL ISAFE(BSQUARES(1,1,16),BSQUARES(1,2,16),HIS,MINE) IF(MINE.EQ.0)GOTO 300 BOARD(T1,T2)=-T6 BOARD(T3,T4)= T5 IF(T5.EQ.0)GOTO 160 WSQUARES(1,1,T5)=T3 WSQUARES(1,2,T5)=T4 160 DO 150 I=1,1024 I8(I)=I4(I) 150 CONTINUE RETURN 1 300 IF(BOARD(T3,T4).EQ.-16.OR.BOARD(T3,T4).EQ.-14) BKCASTLE=.FALSE. IF(BOARD(T3,T4).EQ.-16.OR.BOARD(T3,T4).EQ.-13) BQCASTLE=.FALSE. IF(MOVENUM.LT.5)MOVENUM=MOVENUM+1 IF(MOVENUM.EQ.5)VAR=.FALSE. IF(BSQUARES(2,2,T6).EQ.1.AND.T4.EQ.1)RETURN2 CALL ISAFE(WGAME(MOVENUM*4-1),WGAME(MOVENUM*4),HIS,MINE) IF(HIS.GT.0)VAR=.FALSE. LIM=BSQUARES(2,1,T6) IF(LIM.LT.3.OR..NOT.VAR)RETURN DO 400 I=3,LIM T1=BSQUARES(I,1,T6) T2=BSQUARES(I,2,T6) IF(BOARD(T1,T2).LE.0)GOTO 400 CALL ISAFE(T1,T2,HIS,MINE) IF(HIS.GT.MINE)VAR=.FALSE. 400 CONTINUE RETURN END SUBROUTINE EVAL IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) do 10 k=-16,16 do 10 j=1,8 do 10 i=1,8 10 CONTROL(i,j,k)=0 DO 1000 I=1,15 M=-I T1=BSQUARES(1,1,I) IF(T1.EQ.0) GO TO 1000 T2=BSQUARES(1,2,I) PIECE=BSQUARES(2,2,I) GO TO (100,200,300,400,500),PIECE 100 CALL BPGEN(T1,T2,BSQUARES(2,1,I),M) GO TO 1000 200 CALL NGEN(T1,T2,BSQUARES(2,1,I)) CALL SUPPRESS(BSQUARES(2,1,I)) 700 CALL BLDCNTL(M,BSQUARES(2,1,I)) 750 CALL BNOGOOD(BSQUARES(2,1,I)) GO TO 1000 300 CALL BGEN(T1,T2,BSQUARES(2,1,I),M) GO TO 1000 400 CALL RGEN(T1,T2,BSQUARES(2,1,I),M) GO TO 1000 500 CALL QGEN(T1,T2,BSQUARES(2,1,I),M) 1000 CONTINUE DO 2000 I=1,15 T1=WSQUARES(1,1,I) IF(T1.EQ.0) GO TO 2000 T2=WSQUARES(1,2,I) PIECE=WSQUARES(2,2,I) GO TO (1100,1200,1300,1400,1500),PIECE 1100 CALL WPGEN(T1,T2,WSQUARES(2,1,I),I) GO TO 2000 1200 CALL NGEN(T1,T2,WSQUARES(2,1,I)) CALL SUPPRESS(WSQUARES(2,1,I)) 1700 CALL BLDCNTL(I,WSQUARES(2,1,I)) 1750 CALL WNOGOOD(WSQUARES(2,1,I)) GO TO 2000 1300 CALL BGEN(T1,T2,WSQUARES(2,1,I),I) GO TO 2000 1400 CALL RGEN(T1,T2,WSQUARES(2,1,I),I) GO TO 2000 1500 CALL QGEN(T1,T2,WSQUARES(2,1,I),I) 2000 CONTINUE T1=BSQUARES(1,1,16) T2=BSQUARES(1,2,16) CALL KGEN(T1,T2,BSQUARES(2,1,16)) CALL SUPPRESS(BSQUARES(2,1,16)) CALL BLDCNTL( -16,BSQUARES(2,1,16)) CALL BCHECK(BSQUARES(2,1,16)) CALL BNOGOOD(BSQUARES(2,1,16)) 3100 CONTINUE T1=WSQUARES(1,1,16) T2=WSQUARES(1,2,16) CALL KGEN(T1,T2,WSQUARES(2,1,16)) CALL SUPPRESS(WSQUARES(2,1,16)) CALL WCHECK(WSQUARES(2,1,16)) CALL BLDCNTL( 16,WSQUARES(2,1,16)) CALL WNOGOOD(WSQUARES(2,1,16)) 2600 RETURN END C C NOTE : this is called from way up top and I just felt like C putting in a gap here and a comment. See? This is a comment. SUBROUTINE SETUP IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR,FIRST EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(FIRST,I1(87)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER S(11)*33 CHARACTER REPLY*3 DATA S/ X ' ', X ' I AM THE APOLLO CHESS PLAYER.', X ' ', X ' ENTER ''P'' TO PRINT THE BOARD ', X ' ENTER ''M'' TO LIST VALID MOVES ', X ' ENTER ''R'' TO RESIGN ', X ' ENTER ''K'' TO CASTLE KING''S SIDE ', X ' ENTER ''Q'' TO CASTLE QUEEN''S SIDE', X ' ENTER MOVES IN THE FORM ''E7E5''. ', X ' ', X ' WILL YOU MOVE FIRST (Y/N)? '/ DO 1 I=1,11 CALL TELEW(S(I),33) 1 CONTINUE DO 2 I=1,40 2 WGAME(I)=0 DO 3 I=-3,36 3 BGAME(I)=0 VAR=.TRUE. MOVENUM=1 FIRST=.FALSE. CALL TELER(REPLY,3) IF(REPLY.EQ.'Y'.OR.REPLY.EQ.'y')MOVENUM=0 IF(MOVENUM.EQ.0)FIRST=.TRUE. DO 4 J=1,8 DO 4 I=1,8 4 BOARD(i,j)=0 BOARD(1,1)=13 BOARD(2,1)= 9 BOARD(3,1)=11 BOARD(4,1)=15 BOARD(5,1)=16 BOARD(6,1)=12 BOARD(7,1)=10 BOARD(8,1)=14 DO 100 I=1,8 BOARD(I,2)=I BOARD(I,7)=-I BOARD(I,8)=-BOARD(I,1) BSQUARES(2,2,I)=1 WSQUARES(2,2,I)=1 BSQUARES(1,1,I)=I BSQUARES(1,2,I)=7 WSQUARES(1,1,I)=I WSQUARES(1,2,I)=2 BSQUARES( 1,2,I+8)=8 WSQUARES(1,2,I+8)=1 100 CONTINUE WSQUARES( 2,2,9)=2 WSQUARES(2,2,10)=2 WSQUARES(2,2,11)=3 WSQUARES(2,2,12)=3 WSQUARES(2,2,13)=4 WSQUARES(2,2,14)=4 WSQUARES(2,2,15)=5 WSQUARES(2,2,16)=6 BSQUARES( 2,2,9)=2 BSQUARES(2,2,10)=2 BSQUARES(2,2,11)=3 BSQUARES(2,2,12)=3 BSQUARES(2,2,13)=4 BSQUARES(2,2,14)=4 BSQUARES(2,2,15)=5 BSQUARES(2,2,16)=6 WSQUARES( 1,1,9)= 2 WSQUARES(1,1,10)= 7 WSQUARES(1,1,11)= 3 WSQUARES(1,1,12)= 6 WSQUARES(1,1,13)= 1 WSQUARES(1,1,14)= 8 WSQUARES(1,1,15)= 4 WSQUARES(1,1,16)= 5 BSQUARES( 1,1,9)= 2 BSQUARES(1,1,10)= 7 BSQUARES(1,1,11)=3 BSQUARES(1,1,12)= 6 BSQUARES(1,1,13)= 1 BSQUARES(1,1,14)= 8 BSQUARES(1,1,15)= 4 BSQUARES(1,1,16)= 5 BKCASTLE=.TRUE. WKCASTLE=.TRUE. BQCASTLE=.TRUE. WQCASTLE=.TRUE. WGAME(01)=5 WGAME(02)=2 WGAME(03)=5 WGAME(04)=4 WGAME(05)=7 WGAME(06)=1 WGAME(07)=6 WGAME(08)=3 WGAME(09)=6 WGAME(10)=1 WGAME(11)=3 WGAME(12)=4 WGAME(13)='K' WGAME(15)=5 WGAME(16)=1 WGAME(17)=4 WGAME(18)=2 WGAME(19)=4 WGAME(20)=3 RETURN END SUBROUTINE READB(* ) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER INBUF*8,MESS1*18,MESS2*24 DATA MESS1/'WHAT IS YOUR MOVE?'/ DATA MESS2/'INPUT WAS NOT LEGAL MOVE'/ 100 CONTINUE CALL TELEW(' ',1) CALL TELEW(MESS1,18) CALL TELER(INBUF,7) C write (0,*) 'In READB, TELER returned >', inbuf, '<' C write (0,9999) (inbuf(i:i),i=1,8) C9999 format (1x,8z3.2) IF(INBUF.NE.'M') GO TO 110 CALL LEGAL GO TO 100 110 IF(INBUF.NE.'P') GO TO 120 CALL PRINT GO TO 100 120 IF(INBUF(1:1).NE.'+') GO TO 130 CALL CREATE(BSQUARES,INBUF,*1000) GOTO 02120 130 IF(INBUF(1:1).NE.'-') GO TO 200 CALL CREATE(WSQUARES,INBUF,*1000) GOTO 02120 200 IF(INBUF.NE.'R') GO TO 300 CALL WINDUP 300 IF(INBUF.NE.'K') GO TO 400 CALL BKINGOO(*1000) RETURN 1 400 IF(INBUF.NE.'Q') GO TO 500 CALL BQUEENOO(*1000) RETURN 1 500 IF(lnblnk(INBUF).LT.4) GO TO 1000 IF(INBUF(1:1).LT.'A'.OR.INBUF(1:1).GT.'H') GO TO 1000 IF(INBUF(2:2).LT.'1'.OR.INBUF(2:2).GT.'8') GO TO 1000 IF(INBUF(3:3).LT.'A'.OR.INBUF(3:3).GT.'H') GO TO 1000 IF(INBUF(4:4).LT.'1'.OR.INBUF(4:4).GT.'8') GO TO 1000 T1=ichar(INBUF(1:1))-64 T2=ichar(INBUF(2:2))-48 T3=ichar(INBUF(3:3))-64 T4=ichar(INBUF(4:4))-48 T5=BOARD(T1,T2) IF(INBUF(5:5).EQ.'*') GO TO 2000 IF(T5.GE.0) GO TO 1000 T5=-T5 T6=BSQUARES(2,1,T5) IF(T6.LT.3) GO TO 1000 DO 600 I=3,T6 IF(BSQUARES(I,1,T5).EQ.T3.AND.BSQUARES(I,2,T5).EQ.T4) GO TO 700 600 CONTINUE GO TO 1000 700 INDEX=(MOVENUM*4)-3 BGAME(INDEX)=T1 BGAME(INDEX+1)=T2 BGAME(INDEX+2)=T3 BGAME(INDEX+3)=T4 RETURN 1000 CONTINUE CALL TELEW(MESS2,24) GO TO 100 ***** OVERRIDE NORMAL ERROR CHECKING LOGIC 02000 IF(T5.EQ.0) GO TO 2100 * CHANGE FORMER PIECE BOARD(T1,T2)=0 IF(T5.LT.0) BSQUARES(1,1,-T5) = T3 IF(T5.LT.0) BSQUARES(1,2,-T5) = T4 IF(T5.GT.0) WSQUARES(1,1,T5) = T3 IF(T5.GT.0) WSQUARES(1,2,T5) = T4 * CHANGE LATTER PIECE 02100 T6=BOARD(T3,T4) BOARD(T3,T4)=T5 IF(T6.GE.0) GO TO 2110 BSQUARES(1,1,-T6)=0 BSQUARES(1,2,-T6)=0 BSQUARES(2,1,-T6)=0 02110 IF(T6.LE.0) GOTO 02120 WSQUARES(1,1,T6)=0 WSQUARES(1,2,T6)=0 WSQUARES(2,1,T6)=0 02120 VAR=.FALSE. MOVENUM=0 RETURN 1 END SUBROUTINE CREATE(SQUARES,INBUF,*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) INTEGER SQUARES(32,2,16),P,X,Y CHARACTER INBUF*7,PP*1 ***** CONVERT BOARD ADDRESS X=ichar(INBUF(3:3))-ichar('@') Y=ichar(INBUF(4:4))-ichar('0') IF(X.LT.1 .OR.X.GT.8) RETURN 1 IF(Y.LT.1 .OR. Y.GT.8) RETURN 1 ***** CONVERT PIECE PP=INBUF(2:2) p = ichar(pp) IF(PP.EQ.'P') P=1 IF(PP.EQ.'N') P=2 IF(PP.EQ.'B') P=3 IF(PP.EQ.'R') P=4 IF(PP.EQ.'Q') P=5 IF(P.GT.5) RETURN 1 ***** FIND AVAILABLE SLOT DO 100 I=1,16 IF(SQUARES(1,1,I) .EQ. 0) GO TO 110 00100 CONTINUE RETURN 1 ***** DON'T CREATE A PIECE ON TOP OF ANOTHER 00110 IF(BOARD(X,Y) .NE. 0) RETURN 1 ***** AOK - CREATE IT SQUARES(2,2,I)=P SQUARES(1,1,I)=X SQUARES(1,2,I)=Y IF(INBUF(1:1).EQ.'+') I=-I BOARD(X,Y)=I RETURN END SUBROUTINE WINDUP IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER MESS1*22, MESS2*26, MESS3*19, REPLY*2 DATA MESS1/'YOU PLAYED A GOOD GAME'/ DATA MESS2/'DO YOU WANT TO PLAY AGAIN?'/ DATA MESS3/'IS THIS A NEW GAME?'/ CALL TELEW(MESS1,22) C CALL TELEW(MESS2,26) C CALL TELER(REPLY,2) 10 STOP ENTRY WINDUP2(*,*) CALL TELEW(MESS3,19) CALL TELER(REPLY,2) IF(REPLY.EQ.'Y')RETURN 1 RETURN 2 END SUBROUTINE PRINT IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR,FIRST EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(FIRST,I1(87)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER LINE*40 CHARACTER*4 REP(-6:7) CHARACTER TOP*37, SEP*38 CHARACTER*1 HOME DATA TOP/' |-A-|-B-|-C-|-D-|-E-|-F-|-G-|-H-| '/ DATA SEP/' --+---+---+---+---+---+---+---+---+--'/ DATA HOME/' '/ DATA REP/'|','|','|','|','|','

|',' |', X ' P |',' N |',' B |',' R |',' Q |',' K |',' : |'/ CALL TELEW(HOME,1) CALL TELEW(TOP,37) LINE=' 0 |' DO 200 Q=1,8 CALL TELEW(SEP,38) I=Q c PRINT BOARD UPSIDE DOWN IF(.NOT.FIRST)I=9-Q DO 100 L=1,8 J=9-L T1=BOARD(J,I) PIECE=0 ITEST=I+J IF(ITEST.NE.2*(ITEST/2)) PIECE=7 IF(T1.LT.0) PIECE=-BSQUARES(2,2,-T1) IF(T1.GT.0) PIECE= WSQUARES( 2,2,T1) LINE(4*J+1:4*J+4)=REP(PIECE) 100 CONTINUE LINE(2:2)=CHAR(ICHAR(LINE(2:2))+1) LINE(38:38)=LINE(2:2) CALL TELEW(LINE,38) 200 CONTINUE CALL TELEW(SEP,38) CALL TELEW(TOP,37) RETURN END SUBROUTINE PROMOTE(T5) IMPLICIT INTEGER (A-Z) INTEGER T5 INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR CHARACTER MESS1*25,MESS2*14,INBUF*2 EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DATA MESS1/'ENTER PROMOTED PAWN PIECE'/ DATA MESS2/'INVALID INPUT '/ PIECE=0 100 CALL TELEW(MESS1,25) CALL TELER(INBUF,2) IF(INBUF.EQ.'Q') PIECE=5 IF(INBUF.EQ.'R') PIECE=4 IF(INBUF.EQ.'B') PIECE=3 IF(INBUF.EQ.'N') PIECE=2 IF(PIECE.EQ.0) GO TO 200 BSQUARES(2,2,T5)=PIECE RETURN 200 CALL TELEW(MESS2,14) GO TO 100 END SUBROUTINE ENTERW(MNEXT) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) INTEGER T1 LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) INDEX=(MOVENUM*4)-3 T1=WGAME(INDEX) T2=WGAME(INDEX+1) T3=WGAME(INDEX+2) T4=WGAME(INDEX+3) IF(T1.NE.'K') GO TO 50 CALL WKINGOO(*300) MNEXT=1 GO TO 140 50 IF(T1.NE.'Q') GO TO 60 CALL WQUEENOO(*300) MNEXT=2 140 WKCASTLE=.FALSE. WQCASTLE=.FALSE. RETURN 60 CALL ENTERWT(T1,T2,T3,T4) MNEXT=3 RETURN 300 MNEXT=4 VAR=.FALSE. RETURN END SUBROUTINE ENTERW1(MNEXT,*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER MESS1*45, MESS2*8, WIPE*45 DATA MESS1/'MY MOVE IS - '/ DATA MESS2/'(CHECK) '/ DATA WIPE/' '/ GOTO(50,60,70,300),MNEXT 50 CONTINUE MESS1(13:15)='O-O' GO TO 150 60 CONTINUE MESS1(13:17)='O-O-O' GOTO 150 70 CONTINUE INDEX=(MOVENUM*4)-3 T1=WGAME(INDEX) T2=WGAME(INDEX+1) T3=WGAME(INDEX+2) T4=WGAME(INDEX+3) IF(BOARD(T3,T4).EQ.16.OR.BOARD(T3,T4).EQ.14) WKCASTLE=.FALSE. IF(BOARD(T3,T4).EQ.16.OR.BOARD(T3,T4).EQ.13) WQCASTLE=.FALSE. MESS1(13:13)=char(T1+64) MESS1(14:14)=char(T2+48) MESS1(15:15)='-' MESS1(16:16)=char(T3+64) MESS1(17:17)=char(T4+48) 150 CONTINUE CALL TELEW(WIPE,45) CALL TELEW(MESS1,45) CALL PRINT CALL ISAFE(BSQUARES(1,1,16),BSQUARES(1,2,16),HIS,MINE) IF(MINE.EQ.0)RETURN CALL TELEW(MESS2,8) RETURN 1 300 MESS1(13:17)='YOURS' GOTO 150 END SUBROUTINE BKINGOO(*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) IF(.NOT.BKCASTLE) RETURN 1 IF(BOARD(7,8).NE.0.OR.BOARD(6,8).NE.0) RETURN 1 DO 200 I=5,7 CALL ISAFE(I,8,HIS,MINE) IF(MINE.GT.0)RETURN 1 200 CONTINUE BOARD(5,8)=0 BOARD(6,8)=-14 BOARD(7,8)=-16 BOARD(8,8)=0 BSQUARES(1,1,16)=7 BSQUARES(1,2,16)=8 BSQUARES(1,1,14)=6 BSQUARES(1,2,14)=8 INDEX=(MOVENUM*4)-3 BGAME(INDEX)='K' BGAME(INDEX+1)=0 BGAME(INDEX+2)=0 BGAME(INDEX+3)=0 BKCASTLE=.FALSE. BQCASTLE=.FALSE. MOVENUM=MOVENUM+1 RETURN END SUBROUTINE BQUEENOO(*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) IF(.NOT.BQCASTLE) RETURN 1 IF(BOARD(2,8).NE.0.OR.BOARD(3,8).NE.0.OR.BOARD(4,8).NE.0)RETURN 1 DO 200 I=3,5 CALL ISAFE(I,8,HIS,MINE) IF(MINE.GT.0)RETURN 1 200 CONTINUE BOARD(5,8)=0 BOARD(1,8)=0 BOARD(3,8)=-16 BOARD(4,8)=-13 BSQUARES(1,1,13)=4 BSQUARES(1,2,13)=8 BSQUARES(1,1,16)=3 BSQUARES(1,2,16)=8 INDEX=(MOVENUM*4)-3 BGAME(INDEX)='Q' BGAME(INDEX+1)=0 BGAME(INDEX+2)=0 BGAME(INDEX+3)=0 BKCASTLE=.FALSE. BQCASTLE=.FALSE. MOVENUM=MOVENUM+1 RETURN END SUBROUTINE QGEN(T1,T2,LIST,M) IMPLICIT INTEGER (A-Z) INTEGER T1,T2,M INTEGER LIST INTEGER LISTA INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) COMMON /C/ LISTA(32,2) DIMENSION LIST(32,2) CALL BGEN(T1,T2,LISTA,M) CALL RGEN(T1,T2,LIST,M) L1=LISTA(1,1) IF(L1.LT.3) GO TO 200 L2=LIST(1,1) DO 100 I=3,L1 LIST(I+L2-3,1)=LISTA(I-1,1) LIST(I+L2-3,2)=LISTA(I-1,2) 100 CONTINUE LIST(1,1)=L1+L2-2 200 RETURN END SUBROUTINE BGEN(T1,T2,LIST,M) IMPLICIT INTEGER (A-Z) INTEGER T1,T2,M INTEGER LIST,PINLIST(32,2) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) LOGICAL * 1 LAST,NOUSE,PIN DIMENSION LIST(32,2) DIMENSION X(4),Y(4) X(1)=1 X(2)=1 Y(1)=1 Y(3)=1 X(3)=-1 X(4)=-1 Y(2)=-1 Y(4)=-1 MYPIECE=3 GO TO 50 ENTRY RGEN(T1,T2,LIST,M) X(1)=0 X(2)=0 Y(3)=0 Y(4)=0 X(3)=1 Y(1)=1 X(4)=-1 Y(2)=-1 MYPIECE=4 50 P1=2 PP1=2 DO 200 J=1,4 TX=T1 TY=T2 LAST=.FALSE. NOUSE=.FALSE. PIN=.FALSE. DO 100 I=1,7 CALL SLIDE(TX,TY,X(J),Y(J),LAST,NOUSE,PIN,M,MYPIECE) IF(NOUSE) GO TO 200 IF(PIN)GOTO 300 LIST(P1,1)=TX LIST(P1,2)=TY P1=P1+1 GOTO 150 300 PINLIST(PP1,1)=TX PINLIST(PP1,2)=TY PP1=PP1+1 150 IF(LAST)GOTO 200 100 CONTINUE 200 CONTINUE LIST(1,1)=P1-1 PINLIST(1,1)=PP1-1 CALL BLDCNTL(M,LIST) CALL BLDCNTL(M,PINLIST) LIST(1,1)=P1 RETURN END SUBROUTINE SLIDE(TX,TY,XINC,YINC,LAST,NOUSE,PIN,M,MYPIECE) IMPLICIT INTEGER (A-Z) INTEGER TX,TY,XINC,YINC,M INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) LOGICAL * 1 LAST,NOUSE,PIN TX=TX + XINC TY=TY + YINC IF(TX.LT.1.OR.TX.GT.8) GO TO 100 IF(TY.LT.1.OR.TY.GT.8) GO TO 100 T6=BOARD(TX,TY) IF(T6*M)200,50,300 300 PIN=.TRUE. IF(T6)310,200,320 310 PINPIECE=BSQUARES(2,2,-T6) GOTO 330 320 PINPIECE=WSQUARES(2,2,T6) 330 IF(PINPIECE.NE.MYPIECE.AND.PINPIECE.NE.5)GOTO 200 50 RETURN 100 NOUSE=.TRUE. 200 LAST=.TRUE. RETURN END SUBROUTINE NGEN(T1,T2,LIST) IMPLICIT INTEGER (A-Z) INTEGER T1,T2 INTEGER LIST INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) LIST(1,1)=9 LIST(2,1)=T1+2 LIST(2,2)=T2+1 LIST(3,1)=T1+2 LIST(3,2)=T2-1 LIST(4,1)=T1-2 LIST(4,2)=T2+1 LIST(5,1)=T1-2 LIST(5,2)=T2-1 LIST(6,1)=T1-1 LIST(6,2)=T2+2 LIST(7,1)=T1+1 LIST(7,2)=T2+2 LIST(8,1)=T1-1 LIST(8,2)=T2-2 LIST(9,1)=T1+1 LIST(9,2)=T2-2 RETURN END SUBROUTINE WPGEN(T1,T2,LIST,M) IMPLICIT INTEGER (A-Z) INTEGER LIST INTEGER LISTA INTEGER T1,T2,M INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) COMMON /C/ LISTA(32,2) NEXTSP=T2+1 FIRSTSP=2 BIGSP=4 COLOR=1 10 CONTINUE P1=2 P2=2 C C IF THE PAWN IS IN THE PROMOTION ROW, DON'T DO ANYTHING. C (ADDED BY MIKE PETERSON, U/TORONTO CHEMISTRY). C IF (NEXTSP.LE.0 .OR. NEXTSP.GT.8) GO TO 300 IF(BOARD(T1,NEXTSP).NE.0) GO TO 100 LIST(2,1)=T1 LIST(2,2)=NEXTSP P1=3 IF(T2.NE.FIRSTSP) GO TO 100 IF(BOARD(T1,BIGSP).NE.0) GO TO 100 LIST(P1,1)=T1 LIST(P1,2)=BIGSP P1=P1+1 100 IF(T1.EQ.1) GO TO 200 LISTA(P2,1)=T1-1 LISTA(P2,2)=NEXTSP P2=P2+1 IF(BOARD(T1-1,NEXTSP)*COLOR.GE.0) GO TO 200 LIST(P1,1)=T1-1 LIST(P1,2)=NEXTSP P1=P1+1 200 IF(T1.EQ.8) GO TO 300 LISTA(P2,1)=T1+1 LISTA(P2,2)=NEXTSP P2=P2+1 IF(BOARD(T1+1,NEXTSP)*COLOR.GE.0) GO TO 300 LIST(P1,1)=T1+1 LIST(P1,2)=NEXTSP P1=P1+1 300 LIST(1,1)=P1 LISTA(1,1)=P2-1 CALL BLDCNTL(M,LISTA) RETURN ENTRY BPGEN(T1,T2,LIST,M) NEXTSP=T2-1 FIRSTSP=7 BIGSP=5 COLOR=-1 GOTO 10 END SUBROUTINE SUPPRESS(LIST) IMPLICIT INTEGER (A-Z) INTEGER LIST INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) P1=2 L1=LIST(1,1) IF(L1.LT.2) GO TO 200 DO 100 I=2,L1 IF(LIST(I,1).LE.0.OR.LIST(I,1).GE.9) GO TO 100 IF(LIST(I,2).LE.0.OR.LIST(I,2).GE.9) GO TO 100 LIST(P1,1)=LIST(I,1) LIST(P1,2)=LIST(I,2) P1=P1+1 100 CONTINUE 200 LIST(1,1)=P1-1 RETURN END SUBROUTINE BNOGOOD(LIST) IMPLICIT INTEGER (A-Z) INTEGER LIST INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) COLOR=-1 GOTO 50 ENTRY WNOGOOD(LIST) COLOR=1 50 P1=2 L1=LIST(1,1) IF(L1.LT.2) GO TO 200 DO 100 I=2,L1 IF(BOARD(LIST(I,1),LIST(I,2))*COLOR.GT.0) GO TO 100 LIST(P1,1)=LIST(I,1) LIST(P1,2)=LIST(I,2) P1=P1+1 100 CONTINUE 200 LIST(1,1)=P1 RETURN END SUBROUTINE BCHECK(LIST) IMPLICIT INTEGER (A-Z) INTEGER LIST INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) COLOR=-1 GO TO 100 ENTRY WCHECK(LIST) COLOR=1 100 P1=2 L1=LIST(1,1) IF(L1.LT.2) GO TO 800 DO 700 J=2,L1 CALL ISAFE(LIST(J,1),LIST(J,2),HIS,MINE) IF(COLOR.EQ.-1)HIS=MINE IF(HIS.GT.0)GOTO 700 600 LIST(P1,1)=LIST(J,1) LIST(P1,2)=LIST(J,2) P1=P1+1 700 CONTINUE 800 LIST(1,1)=P1-1 RETURN END SUBROUTINE KGEN(T1,T2,LIST) IMPLICIT INTEGER (A-Z) INTEGER LIST INTEGER T1,T2 INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) DIMENSION LIST(32,2) P1=2 DO 200 I=1,3 DO 100 J=1,3 IF(I.EQ.2.AND.J.EQ.2) GO TO 100 LIST(P1,1)=I-2+T1 LIST(P1,2)=J-2+T2 P1=P1+1 100 CONTINUE 200 CONTINUE LIST(1,1)=9 RETURN END SUBROUTINE LEGAL IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) CHARACTER MESS1*4, MESS2*5, REP(6)*1, LINE*15 DATA MESS1/'O-O '/,MESS2/'O-O-O'/ DATA REP/'P','N','B','R','Q','K'/ COUNT=0 INDEX=(MOVENUM*4)-3 DO 200 I=1,16 IF(BSQUARES(2,1,I).LT.3) GO TO 200 L1=BSQUARES(2,1,I) DO 100 J=3,L1 COUNT=COUNT+1 IF(COUNT.LT.24)GOTO 50 COUNT=0 CALL TELER(LINE,1) 50 LINE=' ' LINE(1:1)=REP(BSQUARES(2,2,I)) LINE(3:4)='AT' LINE(6:6)=char(BSQUARES(1,1,I)+64) LINE(7:7)=char(BSQUARES(1,2,I)+48) LINE(9:10)='TO' LINE(12:12)=char(BSQUARES(J,1,I)+64) LINE(13:13)=char(BSQUARES(J,2,I)+48) IF(BSQUARES(1,1,I).EQ.BGAME(INDEX) X .AND.BSQUARES(1,2,I).EQ.BGAME(INDEX+1) X .AND.BSQUARES(J,1,I).EQ.BGAME(INDEX+2) X .AND.BSQUARES(J,2,I).EQ.BGAME(INDEX+3))LINE(15:15)='*' CALL TELEW(LINE,15) 100 CONTINUE 200 CONTINUE IF(.NOT.BKCASTLE) GO TO 300 CALL TELEW(MESS1,4) 300 IF(.NOT.BQCASTLE) GO TO 400 CALL TELEW(MESS2,5) 400 CONTINUE RETURN END SUBROUTINE ENTERBT(T1,T2,T3,T4,MYTPE) IMPLICIT INTEGER (A-Z) INTEGER T1,T2,T3,T4,MYTPE INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) MYTPE=0 IF(BOARD(T3,T4).EQ.0) GO TO 100 WSQUARES(1,1,BOARD(T3,T4))=0 WSQUARES(1,2,BOARD(T3,T4))=0 WSQUARES(2,1,BOARD(T3,T4))=0 MYTPE=WSQUARES(2,2,BOARD(T3,T4)) 100 BOARD(T3,T4)=BOARD(T1,T2) BOARD(T1,T2)=0 BSQUARES(1,1,-1*BOARD(T3,T4))=T3 BSQUARES(1,2,-1*BOARD(T3,T4))=T4 IF(BSQUARES(2,2,-1*BOARD(T3,T4)).EQ.1.AND.T4.EQ.1) X BSQUARES(2,2,-1*BOARD(T3,T4))=5 CALL EVAL RETURN END SUBROUTINE ENTERWT(T1,T2,T3,T4) IMPLICIT INTEGER (A-Z) INTEGER T1,T2,T3,T4 INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) IF(BOARD(T3,T4).EQ.0) GO TO 100 BSQUARES(1,1,-1*BOARD(T3,T4))=0 BSQUARES(1,2,-1*BOARD(T3,T4))=0 BSQUARES(2,1,-1*BOARD(T3,T4))=0 100 BOARD(T3,T4)=BOARD(T1,T2) BOARD(T1,T2)=0 WSQUARES(1,1,BOARD(T3,T4))=T3 WSQUARES(1,2,BOARD(T3,T4))=T4 IF(WSQUARES(2,2,BOARD(T3,T4)).EQ.1.AND.T4.EQ.8) X WSQUARES(2,2,BOARD(T3,T4))=5 CALL EVAL RETURN END SUBROUTINE WMOVE1(*,*,*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) COMMON/B/I4 DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) INTEGER*4 I4(1024),I8(1024) INTEGER WSQUAREZ(32,2,16) EQUIVALENCE (I8(1),WSQUARES(1,1,1)) EQUIVALENCE (I4(1),WSQUAREZ(1,1,1)) LOGICAL LEGAL,CHECK INTEGER VALUE(0:5) CHARACTER ITEN*2 DATA VALUE/0,20,60,61,100,180/ ITEN = ' ' CALL TELEW (ITEN, 1) MINIMAX=-1000 LEGAL=.FALSE. CHECK=.FALSE. INDEX=(MOVENUM*4)-3 DO 100 I=1,1024 I4(I)=I8(I) 100 CONTINUE CALL ISAFE(WSQUARES(1,1,16),WSQUARES(1,2,16),KSAFE,MINE) IF (KSAFE .GT. 0)CHECK=.TRUE. DO 1000 I=1,16 IF(MOVENUM.LT.4.AND.I.EQ.15)GOTO 1000 106 L1=WSQUAREZ(2,1,I) IF(L1.LT.3) GO TO 1000 ITEN(1:1)=char(I/10+48) ITEN(2:2)=char(MOD(I,10)+48) CALL TELEWB(ITEN,2) T1=WSQUAREZ(1,1,I) T2=WSQUAREZ(1,2,I) DO 900 J=3,L1 120 T3=WSQUAREZ(J,1,I) T4=WSQUAREZ(J,2,I) T5=BOARD(T3,T4) T6=WSQUAREZ(2,2,I) c ASSUME NO CAPTURE T7=0 c T7 = PIECE TYPE IF(T5.LT.0)T7=BSQUARES(2,2,-T5) CALL ENTERWT(T1,T2,T3,T4) CALL ISAFE(WSQUARES(1,1,16),WSQUARES(1,2,16),KSAFE,MINE) IF (KSAFE.GT.0)GOTO 800 LEGAL=.TRUE. IF(CHECK)GO TO 210 IF(WSQUARES(2,2,I).LE.T7)GOTO 210 209 CALL ISAFE(T3,T4,HIS,MINE) IF(HIS.GT.MINE)GOTO 800 IF(HIS.EQ.0)GOTO 210 DO 2090 IJ=-16,-1 IF(CONTROL(T3,T4,IJ).EQ.0)GOTO 2090 IF(CONTROL(T3,T4,IJ).LT.WSQUARES(2,2,I))GOTO 800 2090 CONTINUE 210 CALL BMOVE1(ADVANT,S1,S2,S3,S4) ADVANT=ADVANT+VALUE(T7) IF(WSQUARES(2,2,I).EQ.1)ADVANT=ADVANT+T4-2 IF(ADVANT.LE.MINIMAX) GO TO 800 MINIMAX=ADVANT WGAME(INDEX )=T1 WGAME(INDEX+1)=T2 WGAME(INDEX+2)=T3 WGAME(INDEX+3)=T4 BGAME(INDEX)=S1 BGAME(INDEX+1)=S2 BGAME(INDEX+2)=S3 BGAME(INDEX+3)=S4 IF(ADVANT.GE.1000)RETURN 3 800 BOARD(T1,T2)=I BOARD(T3,T4)=T5 IF(T5.EQ.0)GOTO 820 BSQUARES(1,1,-T5)=T3 BSQUARES(1,2,-T5)=T4 820 WSQUARES(1,1,I)=T1 WSQUARES(1,2,I)=T2 WSQUARES(2,2,I)=T6 900 CONTINUE 1000 CONTINUE IF(CHECK.AND..NOT.LEGAL)RETURN1 IF(.NOT.LEGAL) RETURN 2 IF(MINIMAX.LE.-1000)RETURN 1 CALL WKINGOO(*1100) CALL BMOVE1(ADVANT,S1,S2,S3,S4) ADVANT=ADVANT+6 BOARD(5,1)=16 BOARD(8,1)=14 BOARD(6,1)=0 BOARD(7,1)=0 WSQUARES(1,1,16)=5 WSQUARES(1,1,14)=8 IF(ADVANT.LT.MINIMAX)GO TO 1100 WGAME(INDEX)='K' MINIMAX=ADVANT 1100 CALL WQUEENOO(*1400) CALL BMOVE1(ADVANT,S1,S2,S3,S4) ADVANT=ADVANT+6 BOARD(5,1)=16 BOARD(1,1)=13 BOARD(3,1)=0 BOARD(4,1)=0 WSQUARES(1,1,16)=5 WSQUARES(1,1,13)=1 IF(ADVANT.LT.MINIMAX)GOTO 1400 WGAME(INDEX)='Q' 1400 RETURN END SUBROUTINE ISAFE(I,J,HIS,MINE) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES INTEGER HIS,MINE,MIN INTEGER LIST(32,2) COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) HIS=CONTROL(I,J,0)/16 MINE=MOD(CONTROL(I,J,0),16) RETURN ENTRY BLDCNTL(M,LIST) T0=LIST(1,1) IF (T0.LT.2)RETURN DO 100 IX=2,T0 T1=LIST(IX,1) T2=LIST(IX,2) IF(M.LT.0)GO TO 50 PIECE=WSQUARES(2,2,M) CONTROL(T1,T2,0)=CONTROL(T1,T2,0)+1 GO TO 100 50 PIECE=BSQUARES(2,2,-M) CONTROL(T1,T2,0)=CONTROL(T1,T2,0)+16 100 CONTROL(T1,T2,M)=PIECE RETURN END SUBROUTINE BMOVE1(ADVANT,S1,S2,S3,S4) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) INTEGER*4 I4(1024),I8(1024) INTEGER ADVANT,S1,S2,S3,S4 INTEGER BSQUAREZ(32,2,16) INTEGER VALUE(0:5) EQUIVALENCE(BSQUARES(1,1,1),I8(1)) EQUIVALENCE(BSQUAREZ(1,1,1),I4(1)) DATA VALUE/0,20,60,61,100,180/ ADVANT=1000 DO 100 I=1,1024 I4(I)=I8(I) 100 CONTINUE DO 1000 I=1,16 106 L1= BSQUAREZ(2,1,I) IF(L1.LT.3) GO TO 1000 T1=BSQUAREZ(1,1,I) T2=BSQUAREZ(1,2,I) DO 801 J=3,L1 T3=BSQUAREZ(J,1,I) T4=BSQUAREZ(J,2,I) T5=BOARD(T3,T4) T6=BSQUAREZ(2,2,I) CALL ENTERBT(T1,T2,T3,T4,MYTPE) CALL ISAFE(BSQUARES(1,1,16),BSQUARES(1,2,16),HIS,MINE) IF (MINE.GT.0)GOTO 800 160 HISTYPE=BSQUARES(2,2,I) CALL ISAFE(T3,T4,HIS,MINE) WQ=VALUE(MYTPE) IF(MINE.GT.HIS)WQ=WQ-VALUE(HISTYPE) IF(HISTYPE.EQ.1)WQ=WQ+7-T4 BTOT=0 DO 200 M=1,16 L3=BSQUARES(2,1,M) IF(L3.GE.3) BTOT=BTOT+L3-2 200 CONTINUE C SUBROUTINE WMOVE2 X1=WSQUARES(1,1,16) Y1=WSQUARES(1,2,16) CALL ISAFE(X1,Y1,HIS,MINE) NN=1 WTOT=0 C IF BLACK'S MOVE CHECKS WHITE, THEN ONLY COUNT KING MOVES C IF(HIS.GT.0)NN=16 DO 201 M=NN,16 L2=WSQUARES(2,1,M) IF(L2.GE.3) WTOT=WTOT+L2-2 201 CONTINUE C C WHITE'S KING CANNOT BE BLOCKED UNLESS IT IS IN CHECK C OR THE CHECKING PIECE IS GT A KNIGHT C IF(HIS.NE.1.OR.HISTYPE.LE.2)GOTO 202 C C HERE IS WHERE BLOCKING MOVES ARE ADDED TO WTOT C X=X1-T3 Y=Y1-T4 XPLUS=IABS(X) YPLUS=IABS(Y) IF(XPLUS.NE.YPLUS.AND.XPLUS*YPLUS.NE.0)GOTO 202 XDELTA=0 YDELTA=0 IF(X.NE.0)XDELTA=X/XPLUS IF(Y.NE.0)YDELTA=Y/YPLUS IF(XPLUS.LT.YPLUS)XPLUS=YPLUS DO 750 IX=1,XPLUS X1=X1-XDELTA Y1=Y1-YDELTA CALL ISAFE(X1,Y1,HIS,MINE) 750 WTOT=WTOT+MINE C RETURN c DON'T EVEN TAKE A QUEEN IF CMATE 202 IF(WTOT.EQ.0)WTOT=-1200 TOT=WTOT-BTOT-WQ IF(TOT.GE.ADVANT) GOTO 800 ADVANT=TOT S1=T1 S2=T2 S3=T3 S4=T4 800 BOARD(T1,T2)=-I BOARD(T3,T4)=T5 IF(T5.EQ.0)GOTO 720 WSQUARES(1,1,T5)=T3 WSQUARES(1,2,T5)=T4 720 BSQUARES(1,1,I)=T1 BSQUARES(1,2,I)=T2 BSQUARES(2,2,I)=T6 801 CONTINUE 1000 CONTINUE RETURN END SUBROUTINE WKINGOO(*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) IF(BOARD(8,1).NE.14)WKCASTLE=.FALSE. IF(.NOT.WKCASTLE) RETURN 1 IF(BOARD(7,1).NE.0.OR.BOARD(6,1).NE.0) RETURN 1 CALL EVAL DO 200 I=5,7 CALL ISAFE(I,1,HIS,MINE) IF(HIS.GT.0)RETURN 1 200 CONTINUE BOARD(5,1)=0 BOARD(6,1)=14 BOARD(7,1)=16 BOARD(8,1)=0 WSQUARES(1,1,16)=7 WSQUARES(1,1,14)=6 CALL EVAL RETURN END SUBROUTINE WQUEENOO(*) IMPLICIT INTEGER (A-Z) INTEGER I1,WGAME,BGAME,MOVENUM,WSQUARES COMMON/A/I1(88),I2(4224) DIMENSION WGAME(40),BGAME(-3:36),BOARD(8,8),WSQUARES(32,2,16) INTEGER BSQUARES(32,2,16),CONTROL(8,8,-16:16) LOGICAL WKCASTLE,WQCASTLE,BKCASTLE,BQCASTLE,VAR EQUIVALENCE(MOVENUM,I1(1)),(WGAME(1),I1(2)),(BGAME(-3),I1(42)), X (WKCASTLE,I1(82)),(WQCASTLE,I1(83)), X (BKCASTLE,I1(84)),(BQCASTLE,I1(85)),(VAR,I1(86)) EQUIVALENCE(BOARD(1,1),I2(1)),(WSQUARES(1,1,1),I2(65)), X (BSQUARES(1,1,1),I2(1089)),(CONTROL(1,1,-16),I2(2113)) IF(BOARD(1,1).NE.13)WQCASTLE=.FALSE. IF(.NOT.WQCASTLE) RETURN 1 IF(BOARD(2,1).NE.0.OR.BOARD(3,1).NE.0.OR.BOARD(4,1).NE.0)RETURN 1 CALL EVAL DO 200 I=3,5 CALL ISAFE(I,1,HIS,MINE) IF(HIS.GT.0)RETURN 1 200 CONTINUE BOARD(5,1)=0 BOARD(1,1)=0 BOARD(3,1)=16 BOARD(4,1)=13 WSQUARES(1,1,13)=4 WSQUARES(1,1,16)=3 CALL EVAL RETURN END subroutine teler (string, isize) c c Read a string of size 'isize' from the user. c Convert lower case to upper case. c character string*(*) c ll = len (string) C write (0,*) 'In teler, isize = ', isize, ', but ll = ', ll string = ' ' read (5,100) string(1:isize) 100 format (a) l = lnblnk(string) C write (0,*) 'Got string >', string, '< with lnblnk = ', l do 110 i=1,l 110 if (string(i:i).ge.'a' .and. string(i:i).le.'z') 1 string(i:i) = char(ichar(string(i:i))-32) C write (0,*) 'Returning string >', string, '<' return end subroutine telew (string, isize) c c Write a string of size 'isize' to the user. c character string*(*) c write (6,100) string(1:isize) 100 format (a) return end subroutine telewb (string, isize) c c Write a string of size 'isize' to the user without a trailing c carriage return. c character string*(*) c write (6,100) string(1:isize) 100 format (a,$) return end