$INTEGER*4 $CONTROL FILE=1-10 C * THIS PROGRAM MODIFIED TO RUN ON HP3000 AND CONTRIBUTED * C * BY MEL BAILEY, HP-RICHARDSON,TEXAS.... THIS VERSION USES * C * ALL DOUBLE INTEGERS AND IS EXTREMELY INEFFICIENT.... * C * * C * * C **************************************************************** C * C * ***** * *** ***** ***** *** * * C * * * * * * * * * * C * * * * * * * * * * C * ***** * * * * * * * C * * * * * * * * * * C * * * * * * * * * * C * ***** ***** *** * ***** *** * C * C **************************************************************** C * C * BLITZ IV IS THE FOURTH MAJOR VERSION OF A CHESS C * PLAYING PROGRAM WRITTEN AT THE UNIVERSITY OF SOUTHERN C * MISSISSIPPI BY ROBERT HYATT. IT USES SHANNON'S TYPE C * 'A' ALPHA-BETA TREE SEARCHING STRATEGY WITH FORWARD C * PRUNING. ALL PARAMETERS CAN BE SET BY THE PLAYER (SEE C * COMMENTS IN EACH MODULE WITH A NAME ENDING IN 'CMND') C * TO CONTROL THE SPEED (AND QUALITY) OF PLAY. C * C * MAIN IS THE DRIVER OF THE PROGRAM. IT IS CONCERNED C * WITH READING INPUT, CALLING APPROPRIATE ROUTINES, AND C * OUTPUTTING THE COMPUTERS CHOSEN MOVE. IT ALSO KEEPS C * WITH MOVE TIMING TO MAINTAIN THE CHESS CLOCK TIMES FOR C * BOTH SIDES. C * C **************************************************************** C IMPLICIT INTEGER*4 (A-Z) SYSTEM INTRINSIC TIMER, PROCTIME, XCONTRAP, COMMAND COMMON /BUFFER/ TEXT(30) CHARACTER*5 WHITE,BLACK,CCOLOR,HCOLOR COMMON /BOARD/ BOARD(120) COMMON /PC CM/ CMNDS(10,3), NCMNDS, PCMODE, EXMODE COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 LOGICAL CHECK, DRAW, CQUERY COMMON /TRACE/ TRACE(20,10),TFLAG COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /DUP/ PACK(8),POINT,BDSAVE(30,8) INTEGER*4 BELL INTEGER*2 OFF, DMY, IERR, IPARM COMMON /NAME CM/ NAME(5) COMMON /TRCE CM/ STRACE(20), TSCORE COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT LOGICAL IN BOOK LOGICAL CLOCK COMMON /BOOK CM/ KEY ,IN BOOK COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR COMMON /HIST CM/ NMOVES, ANNOTE COMMON /BRK CM/ CSEC1, CSEC2, HSEC1, HSEC2 COMMON /SAVE CM/ SBOARD(100) COMMON /V CM/ VCMOVE COMMON /MOV TIM/ MELAP, MSEC1, MSEC2 LOGICAL PCMODE, EXMODE, AUTO COMMON /INIT/ INITIM COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)),(G,ALPHA(7)),(O,ALPHA(15)) EQUIVALENCE (Y,ALPHA(25)) COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /P V MOVE/ PVMOVE, OVMOVE CHARACTER*32 BFFR DATA ZERO /0J/,WHITE/'WHITE'/,BLACK/'BLACK'/,BELL/%"^G^G"J/ DATA OFF / 0 /, AUTO / .FALSE./ C------------------------------< DETERMINE COLOR DESIRED AND C------------------------------< INITIALIZE DATA AREA BFFR="FILE FTN10;DEV=LP" BFFR[18:1]=%15C CALL COMMAND(BFFR,IERR,IPARM) INITIM=TIMER/1000 888 WRITE(6,1) 1 FORMAT(1X,'BLITZ IV HERE'/1X,'WHAT IS YOUR NAME?') READ(5,2)NAME 2 FORMAT(5A4) CALL SETIO(AUTO,$888) WRITE(6,3) 3 FORMAT(1X,'SHOULD I PLAY WHITE?') 4 READ(5,5)ANS 5 FORMAT(R1) IF(ANS.NE.Y) GOTO 7 HCOLOR=BLACK CCOLOR=WHITE COLOR=1 7 IF(.NOT.AUTO)CALL SETGB CALL SAVE GB 91 CALL CTIME(CSEC1) IF(.NOT. AUTO .AND. NMOVES.GT.0) GO TO 911 C C------------------------------< IF RE-STARTING A GAME, CHECK TO SEE C------------------------------< IF IT'S THE PROGRAM'S TURN TO MOVE. C------------------------------< IF SO, CALCULATE MOVE. C I=1-MOD(NMOVES,2) IF(I.EQ.COLOR) GO TO 20 911 CALL ETIME(HSEC1) C C------------------------------< MAIN LOOP C C C------------------------------< IF THE CLOCK QUERY FLAG IS SET C------------------------------< (CQUERY), THEN THE PROGRAM WILL C------------------------------< ASK HOW MUCH TIME IT HAS ON THE C------------------------------< CLOCK EVERY SO OFTEN. C 9 IF(CQUERY) CALL QUERY WRITE(6,10)BELL 10 FORMAT(1X,A4) 918 CALL SAVE GM WRITE(6,12)NAME 12 FORMAT(1X,'YOUR MOVE, ',5A4) C C------------------------------< IF IN THINK-AHEAD MODE, MAKE C------------------------------< THE PREDICTED HUMAN RESPONSE C------------------------------< AND THINK ON HIS TIME C CALL THINK($184,$182) C C------------------------------< INPUT COMMAND OR MOVE C 171 MOVE=(NCMOVS+NHMOVS)/2+1 READ(5,18)TEXT IF(TEXT(1).EQ.G.AND.TEXT(2).EQ.O) GO TO 20 18 FORMAT(30R1) 182 CALL OPTION($918) CALL INMOVE(0,$918) NHMOVS=NHMOVS+1 MOVE=(NCMOVS+NHMOVS)/2+1 CALL ETIME(HSEC2) CALL CTIME(CSEC1) GO TO 184 184 ELAPH=HSEC2-HSEC1-OPTIME IF(ELAPH.LT.0) ELAPH=0 NMOVES=NMOVES+1 WRITE(1@NMOVES)TEXT,ELAPH,ZERO HELAP=HELAP+ELAPH IF(.NOT. CLOCK) GO TO 19 WRITE(6,5579)ELAPH 5579 FORMAT(1X,'YOU TOOK',I4,' SECONDS TO MOVE') IF(HELAP.GT.GELAP) WRITE(6,4499)NAME 4499 FORMAT(1X,'YOU HAVE EXCEEDED TIME LIMIT, ',5A4) CALL SETCLK 19 HTO8=TO8 HFROM8=FROM8 HTYPE8=TYPE8 PLY=20 IF(TYPE8.NE.PROMOTE) GO TO 1977 BOARD(FROM8)=VALUE8 TYPE8=1 1977 CALL PMOVER CALL SAVE GB CALL SAVE GM 20 CALL PREANL ON CONTROLY CALL BRK ON C C------------------------------< EITHER: A) CALL BOOK TO FIND C------------------------------< THE MOVE, C------------------------------< B) CALL LOOK TO CALCULATE C------------------------------< THE MOVE, OR C------------------------------< C) IF THINK-AHEAD HAS C------------------------------< FOUND THE RESPONSE, C------------------------------< USE THE TREE FOUND. C CALL MATCH($6300) IF(IN BOOK) CALL BOOK IF(IN BOOK) PRIGHT=PRIGHT+1 IF(IN BOOK) GO TO 6300 6200 CALL CTIME(MSEC1) CALL LOOK CALL CTIME(MSEC2) MELAP=MSEC2-MSEC1 6300 TFLAG=0 CALL XCONTRAP(OFF,DMY) DO 162 I=1,20 STRACE(I)=TRACE(I,1) 162 CONTINUE TSCORE=BACKUP(1) OVMOVE=PVMOVE P V MOVE = STRACE(3) IF(DEPTH.LT.3) PVMOVE=0 PLY=1 IF(CMOVE+SMOVE.EQ.0) GO TO 47 IF(CMOVE.NE.0) GO TO 126 CMOVE=SMOVE GO TO 207 126 IF(SMOVE.EQ.0) GO TO 207 C C------------------------------< CHECK TO ACCEPT/AVOID C------------------------------< STALEMATE OR DRAWING MOVES C IF(.NOT. DRAW(SCORE)) GO TO 207 WRITE(6,55332)SCORE 55332 FORMAT(1X,'DRAWING SCORE = ',I6) 210 CMOVE=SMOVE SMOVE=-1 C C------------------------------< OUTPUT PROGRAM'S SELECTED MOVE C 207 FROM8=CMOVE CALL EXTRCT CALL PMOVER MTYPE=0 IF(CHECK(.TRUE.)) MTYPE=1 IF(CMOVE.LT.0) MTYPE=2 IF(BACKUP(1).EQ.9998) MTYPE=3 CALL OUTMOV(FROM8,TO8,TYPE8,MTYPE,1,SBOARD) 4321 FORMAT(30R1) WRITE(6,282)TEXT 282 FORMAT(/1X,'MY MOVE IS ',30R1/) CALL SAVE GB NCMOVS=NCMOVS+1 VCMOVE=CMOVE CALL CTIME(CSEC2) ELAPC=CSEC2-CSEC1 IF(.NOT. CLOCK) GO TO 4479 WRITE(6,3759)ELAPC 3759 FORMAT(1X,'I TOOK',I4,' SECONDS TO MOVE') CALL SETCLK IF(CELAP.GT.GELAP) WRITE(6,4488)NAME 4488 FORMAT(1X,'I HAVE EXCEEDED THE TIME LIMIT, ',5A4) 4479 NMOVES=NMOVES+1 WRITE(1@NMOVES)TEXT,ELAPC,ZERO CELAP=CELAP+ELAPC CALL COMPRS POINT=POINT+1 IF(POINT.GT.30) POINT=1 DO 220 I=1,8 BDSAVE(POINT,I)=PACK(I) 220 CONTINUE CALL ETIME(HSEC1) IF(PCMODE) CALL EXEC PC CALL ETIME(HSEC1) IF(SMOVE.EQ.-1) GO TO 47 GO TO 9 C C------------------------------< GAME OVER, PRINT BOARD AND STOP C 45 WRITE(6,46)HCOLOR 46 FORMAT(1X,A5,' RESIGNS ') GO TO 9 47 IF(CHECK(.FALSE.)) GO TO 49 IF(MTYPE.EQ.2) WRITE(6,221)NAME 221 FORMAT(1X,'I CLAIM A DRAW BY THE REPITITION OF'/ *1X,' POSITIONS RULE, ',5A4) IF(MTYPE.NE.2) WRITE(6,48)NAME 48 FORMAT(1X,'GAME IS A STALEMATE, ',5A4) GO TO 9 49 WRITE(6,99)NAME 99 FORMAT(1X,'CHECKMATE! CONGRATULATIONS, ',5A4) GO TO 9 END $CONTROL SEGMENT=CMND SUBROUTINE ACMND C C ************************************************************ C * * C * ACMND IS USED TO ANNOTATE THE GAME HISTORY FILE. * C * THIS IS DONE TO COMMENT PARTICULAR MOVES FOR LATER * C * REFERENCE WHEN EVALUATING THE GAME. IF THE MACHINE * C * MAKES SOME STRANGE LOOKING MOVE, A COMMENT CAN BE EN- * C * TERED WITH THAT MOVE AS A REMINDER TO LATER CHECK OUT * C * THAT MOVE TO SEE WHY IT WAS MADE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /HIST CM/ NMOVES, ANNOTE COMMON /TREE/ DUMMY(480), PLY COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)) INTEGER*4 DATA(32),TEXT(31) EQUIVALENCE (DUMMY(1),DATA(1)),(DUMMY(33),TEXT(1)) DATA ZERO /0J/ C C------------------------------< DETERMINE WHICH MOVE TO ANNOTATE C------------------------------< AND LOCATE IT. C WRITE(6,100) 100 FORMAT(1X,'ANNOTATE WHICH MOVE?') CALL INPUT(MOVE) MOVE=MOVE*2 IF(MOVE.GT.NMOVES.OR.MOVE.LE.0) GO TO 998 C C------------------------------< READ THE COMMENT C WRITE(6,300) 300 FORMAT(1X,'ENTER COMMENT') 400 READ(5,200,END=999)TEXT 200 FORMAT(31R1) READ(1@MOVE)DATA DO 500 I=1,31 IF(TEXT(I).NE.BLANK) GO TO 600 500 CONTINUE GO TO 999 C C------------------------------< SET THE MOVE'S POINTER TO THE COMMENT C 600 DATA(32)=ANNOTE WRITE(1@MOVE)DATA C C------------------------------< WRITE THE COMMENT OUT C WRITE(1@ANNOTE)TEXT,ZERO MOVE=ANNOTE ANNOTE=ANNOTE+1 GO TO 400 998 WRITE(6,900) 900 FORMAT(1X,"MOVE NOT MADE YET") 999 RETURN END $CONTROL SEGMENT=ADJ SUBROUTINE ADJUST C C ************************************************************ C * * C * ADJUST IS USED TO ADJUST THE CONSTRAINTS WHICH CON- * C * TROL THE TIME USED TO CALCULATE MOVES. THERE ARE THREE * C * BASIC CONTROL FUNCTIONS SET BY THIS SUBROUTINE: * C * * C * 1) A VARIABLE 'TIMLIM' IS SET TO 2.5 TIMES THE * C * AVERAGE TIME THE MACHINE MUST USE TO STAY WITHIN * C * THE LIMITS SET. THIS IS USED IN SUBROUTINE * C * 'LOOK'; WHEN THIS LIMIT IS REACHED, NO FURTHER * C * MOVES WILL BE EXAMINED. * C * * C * 2) IF THE AVERAGE TIME/MOVE IS FASTER THAN RE- * C * QUIRED, THE FORWARD PRUNING WIDTHS WILL BE IN- * C * CREASED TO SLOW MOVE CALCUALTION DOWN. IF THE * C * AVERAGE IS TOO SLOW, THE WIDTHS WILL BE REDUCED * C * TO SPEED MOVE CALCULATION UP. * C * * C * 3) IF THE WIDTHS ARE INCREASED UP TO THE THRESHOLD, * C * THEY ARE RESET TO THEIR ORIGINAL VALUE AND THE * C * SEARCH DEPTH IS INCREASED BY ONE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /BOOK CM/ KEY ,IN BOOK LOGICAL IN BOOK, CLOCK, CQUERY COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /PRED CM/ PTEXT(30) COMMON /MOV TIM/ MELAP, MSEC1, MSEC2 COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /BUFFER/ TEXT(30) COMMON /CHR SET/ ALPHA(44) EQUIVALENCE (ALPHAD,ALPHA(4)),(ALPHAL,ALPHA(12)), * (ALPHAS,ALPHA(19)),(ALPHAW,ALPHA(23)) COMMON /TIME CM/ TIMLIM, MAXTIM COMMON /DEBUG/ DEBUG LOGICAL DEBUG INTEGER*4 TIME(3) DATA TIME /180J,180J,180J/,COUNT /0J/,AVGTIM /0J/ DATA MVTIME / 180J/ C C------------------------------< CALCULATE AVERAGE TIME PER MOVE C CALL CTIME(END) TIMLIM=360 IF(.NOT. CLOCK) RETURN IF(MELAP.EQ.0) GO TO 5 TIME(3)=TIME(2) TIME(2)=TIME(1) TIME(1)=MELAP 5 AVGTIM=(TIME(1)+TIME(2)+TIME(3))/3 LEFT=GELAP-CELAP-(MOVES-NCMOVS)*15 C C------------------------------< CALCULATE THE MAX TIME EVER TO C------------------------------< TRY TO AVERAGE TO PREVENT THINK-AHEAD C------------------------------< MATCHES FROM ADVANCING DEPTH TOO FAR. C ABSMAX=1.5*SELAP/SMOVES C C------------------------------< CALCULATE TIME PROGRAM MUST AVERAGE C OMTIME=MVTIME MVTIME=LEFT/(MOVES-NCMOVS) IF(MVTIME.GT.ABSMAX) MVTIME=ABSMAX IF(MVTIME.GT.OMTIME+30) MVTIME=OMTIME+30 OTLIM=TIMLIM TIMLIM=2*MVTIME C C------------------------------< IF LESS THAN 60 SECONDS REMAIN, PANIC C------------------------------< AND SET THE LOOKAHEAD TO 3. C IF(LEFT.LT.60) GO TO 2000 TIMLIM=MIN0(LEFT-45,TIMLIM) IF(TIM LIM .LT. 30) TIM LIM = 30 C C------------------------------< IF THE LAST MOVE TOOK AN ABNORMALLY LON C------------------------------< TIME, REDUCE THE LOOK-AHEAD EVEN C------------------------------< IF THE AVERAGE IS OK. IT CAN TAKE C------------------------------< SEVERAL MOVES BEFORE THE AVERAGE C------------------------------< INDICATES TIME PROBLEMS. C IF(TIME(1).GE.OTLIM.AND.COUNT.EQ.0) GO TO 80 COUNT=COUNT+1 IF(COUNT.LT.3) RETURN C C------------------------------< COMPUTE THE DIFFERENCE. IF THE C------------------------------< PROGRAM IS WITHIN 15 SECONDS OF C------------------------------< THE FORCED AVERAGE, NO ADJUSTMENT C------------------------------< IS NECESSARY. C SURPLS=MVTIME-AVGTIM IF(IABS(SURPLS).LE.20) GO TO 50 C C------------------------------< ADJUSTMENT OF MOVE TIME IS NEEDED. C------------------------------< IT SHOULD BE NOTED THAT THE LAST C------------------------------< THREE (3) MOVES ARE USED TO COMPUTE C------------------------------< THE AVERAGE TIME PER MOVE. THIS C------------------------------< ALLOWS THE PROGRAM TO RESPOND TO C------------------------------< TIME PROBLEMS WITHOUT ADJUSTING THE C------------------------------< TUNING AFTER EACH MOVE (USUALLY C------------------------------< GOES UP AND DOWN). C C------------------------------< TO PREVENT VIOLENT TAMPERING WITH C------------------------------< PRUNING WIDTHS DURING THE FIRST 30 C------------------------------< MOVES, THE WIDTHS ARE ADJUSTED BY C------------------------------< INCREMENTS OF 1 UNTIL LESS THAN 30 C------------------------------< MINUTES REMAIN ON THE CLOCK. THEN C------------------------------< THE WIDTHS ARE CHANGED MORE DRASTICALLY ADD=1 IF(GELAP-CELAP.LE.30*60) ADD=IABS(SURPLS)/15 IF(SURPLS.LT.0) ADD=-ADD C C------------------------------< IF THE LAST MOVE TOOK NO TIME, THEN C------------------------------< DO NOT REDUCE LOOKAHEAD FURTHER C------------------------------< UNTILL WE FIND OUT HOW IT IS NOW. C IF(MELAP.LE.1 .AND. ADD.LT.0) GO TO 50 DO 10 I=1,10 WIDTH(I)=WIDTH(I)+ADD 10 CONTINUE IF(WIDTH(1).GT.MAX(1)) GO TO 60 IF(WIDTH(1).LT.MIN(1)) GO TO 80 C C------------------------------< IF THE DEBUG FLAG IS SET, OUTPUT THE C------------------------------< ADJUSTED PARAMETERS AS THEY CHANGE. C 50 IF(.NOT. DEBUG) GO TO 30 LEFT1=LEFT/60 LEFT=MOD(LEFT,60) WRITE(6,40)AVGTIM, LEFT1, LEFT, MVTIME, TIMLIM, SURPLS 40 FORMAT(1X,'AVG TIME/MOVE ',I5, ' SECS'/ * 1X,'TIME LEFT ON CLOCK ',I5,' MINS ',I2,' SECS'/ * 1X,'MUST AVERAGE ',I5,' SECS/MOVE'/ * 1X,'MAXIMUM MOVE TIME IS ',I5,' SECS'/ * 1X,'DEVIATION FROM AVERAGE IS ',I5,' SECS'/) TEXT(1)=ALPHAS TEXT(2)=ALPHAL TEXT(3)=ALPHAD CALL SCMND($20) 20 TEXT(2)=ALPHAW CALL SCMND($30) 30 RETURN C C------------------------------< MOVES ARE BEING COMPUTED TOO FAST C------------------------------< AND THE WIDTHS ARE AT A REASONABLE C------------------------------< UPPER LIMIT, CHECK TO SEE IF THE C------------------------------< SEARCH DEPTH CAN BE INCREASED. C 60 IF(AVGTIM*3.GT.MVTIME) GO TO 75 IF(DEPTH.GE.10) GO TO 75 DO 70 I=1,10 WIDTH(I)=MIN(I) 70 CONTINUE DEPTH=DEPTH+1 COUNT=0 GO TO 50 75 DO 78 I=1,10 WIDTH(I)=MAX(I) 78 CONTINUE GO TO 50 C C------------------------------< MOVES ARE BEING COMPUTED TOO SLOWLY C------------------------------< AND THE WIDTHS ARE AT A REASONABLE C------------------------------< LOWER LIMIT, RESET THEM TO A HIGHER C------------------------------< VALUE AND DECREASE THE SEARCH DEPTH. C 80 IF(GELAP-CELAP.GT.30*60) GO TO 200 85 DO 90 I=1,10 WIDTH(I)=MAX(I) 90 CONTINUE IF(DEPTH.GT.2) DEPTH=DEPTH-1 COUNT=0 GO TO 50 C C------------------------------< DON'T LOWER LOOK-AHEAD UNLESS WE C------------------------------< ARE WITHIN 30 MINUTES OF THE UPPER C------------------------------< TIME LIMIT. THE MINIMUM SHOULD C------------------------------< NEVER DROP BELOW 5. C 200 IF(DEPTH.GT.5) GO TO 85 DO 110 I=1,10 WIDTH(I)=MIN(I) 110 CONTINUE GO TO 50 C C------------------------------< IF THE PROGRAM EVER COMES HERE, IT C------------------------------< IT COULD BEST BE DESCRIBED AS A C------------------------------< PANIC SITUATION. SOMEHOW, THE PROGRAM C------------------------------< HAS LESS THAN A MINUTE TO MAKE A C------------------------------< MOVE. THE LOOKAHEAD IS SET TO 3, C------------------------------< THE WIDTHS ARE SET TO 8 AND A RAPID C------------------------------< EXIT IS MADE. C 2000 DO 2001 I=1,10 WIDTH(I)=MIN(I) 2001 CONTINUE DEPTH=3 TIMLIM=15 GO TO 50 END BLOCK DATA IMPLICIT INTEGER*4 (A-Z) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /BOARD/ BOARD(120) COMMON /CAST SM/ CAST SC, UB CAST COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO COMMON /K SM/ EKMOVE, KSAFE COMMON /Q SM/ EQMOVE, Q EDGE COMMON /R SM/ ERMOVE, RANK78, ROPEN, RHALF, DROOKS, CROOKS, * RPASS, R EDGE COMMON /B SM/ EBMOVE, LDIAG, BPAIR COMMON /N SM/ ENMOVE, OUTPST, N EDGE COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /SAFE CM/ MPAWN, ANPAWN, ABPAWN COMMON /CHRSET/ ALPHA(44) COMMON /HIST CM/ NMOVES, ANNOTE COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /TRACE/ TRACE(20,10), TFLAG COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME LOGICAL CLOCK, CQUERY COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL THNK AH, LOOK AH, PTHAHM, FOUND M, MTCHED, BRKFLG COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /V CM/ VCMOVE COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /DUP/ PACK(8),POINT,BDSAVE(30,8) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /BOOK CM/ KEY, IN BOOK LOGICAL IN BOOK COMMON /PC CM/ COMMANDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL PCMODE, EXMODE COMMON /RATE CM/ CRATE, HRATE COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /DEBUG/ DEBUG INTEGER*4 GELAP LOGICAL DEBUG COMMON /MOV TIM/ MELAP, MSEC1, MSEC2 COMMON /TRCE CM/ STRACE(20), TSCORE COMMON /OPEN CM/ MVNUMB DATA RK /+10J,-10J,+1J,-1J/ DATA BP /+11J,-11J,+9J,-9J/ DATA KT /+8J,+12J,+19J,+21J,-8J,-12J,-19J,-21J/ DATA KG /+1J,+9J,+10J,+11J,-1J,-9J,-10J,-11J/ DATA BOARD / 120*14J/ C C------------------------------< TUNING PARAMETERS C DATA CAST SC, UB CAST / 180J,-50J/ DATA ATAK SC, BPAWN, BLKSC, TEMPO /30J,75J,50J,45J/ C C--------------------< KING C DATA EKMOVE, KSAFE / 62J,36J/ C C--------------------< QUEEN C DATA EQMOVE, Q EDGE / 108J,12J/ C C--------------------< ROOK C DATA ERMOVE, RANK78, ROPEN, RHALF, DROOKS, CROOKS, RPASS */ 48J, 100J, 60J, 30J, 48J, 24J, 72J / DATA R EDGE / 12J/ C C--------------------< BISHOP C DATA EBMOVE, LDIAG, BPAIR / -24J,24J,75J / C C--------------------< KNIGHT C DATA ENMOVE, OUTPST, N EDGE / -36J,40J,30J / C C--------------------< PAWN C DATA PADVNC, IPAWN, DPAWN, TPAWN / 12J,60J,30J,100J / DATA PPAWN, CPAWN, ABREST, PPSHSC / 20J,36J,16J,40J / C C--------------------< COMPROMISED KING-SIDE C DATA MPAWN, ANPAWN, ABPAWN / 60J,25J,40J / C C C------------------------------< END OF PARAMETERS C DATA ALPHA /%"A"J,%"B"J,%"C"J,%"D"J,%"E"J,%"F"J,%"G"J,%"H"J, *%"I"J,%"J"J,%"K"J,%"L"J,%"M"J,%"N"J,%"O"J,%"P"J,%"Q"J, *%"R"J,%"S"J,%"T"J,%"U"J,%"V"J,%"W"J,%"X"J,%"Y"J,%"Z"J,%"0"J, *%"1"J,%"2"J,%"3"J,%"4"J,%"5"J,%"6"J,%"7"J,%"8"J,%"9"J,%"+"J, *%"-"J,%"/"J,%"*"J,%"="J,%"."J,%"?"J,%" "J/ DATA NMOVES, ANNOTE / 0J,400J / DATA PRIGHT /0J/ DATA CCOLOR, HCOLOR, COLOR / 'BLACK', 'WHITE', 0J/ DATA TFLAG /0J/ DATA CLOCK /.FALSE./, GELAP, CELAP, HELAP /99999999J,0J,0J/ DATA CQUERY /.FALSE./, OPTIME / 0J/ DATA CTYPE, MOVES, SMOVES, SELAP /1J,200J,200J,200J/ DATA CTOTAL, HTOTAL / 0J,0J/ DATA THNK AH, LOOK AH, FOUNDM, MTCHED * / .FALSE., .FALSE., .FALSE., .FALSE. / DATA START(1)/1J/ DATA HFROM8,HTO8,HTYPE8,CMOVE,SMOVE,MOVE/1J,1J,1J,0J,0J,0J/ DATA VCMOVE /0J/ DATA DEPTH, ORDER1, ORDER2 / 5J,4J,4J / DATA WIDTH, MIN, MAX / 10*6J, 10*6J, 10*13J / DATA NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE */ 1J, 2J, 3J, 4J, 5J/ DATA POINT,BDSAVE/241*0J/ DATA PINIT / 400J,1200J,1200J,2000J,3600J,8000J,0J, * 400J,1200J,1200J,2000J,3600J,8000J / DATA KEY, IN BOOK / 1J,.FALSE. / DATA PCMODE, EXMODE / .FALSE., .FALSE. / DATA CRATE, HRATE / 1400J,1400J / DATA NCMOVS, NHMOVS / 0J,0J / DATA DEBUG / .FALSE. / DATA MELAP / 0J / DATA STRACE / 20*0J / DATA TRACE / 200*0J / DATA MVNUMB /1J/ END $CONTROL SEGMENT=PC SUBROUTINE BISHOP C C ************************************************************ C * * C * BISHOP GENERATES ALL BISHOP MOVES AND DIAGONAL * C * MOVES FOR THE QUEEN. SUBROUTINE SCORE IS CALLED TO * C * COMPUTE THE PLAUSIBILITY SCORE FOR THE MOVE, AFTER * C * WHICH THE MOVE IS ENTERED IN THE MOVE LIST. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE LOGICAL SIDE, CHECK 1000 DO 1030 I=1,4 TO8=FROM8 DIREC=BP(I) 1010 TO8=TO8+DIREC TYPE8=NORMAL TOSQ=BOARD(TO8) IF(SIDE.AND.TOSQ.LT.7) GO TO 1030 IF(.NOT.SIDE.AND.TOSQ.GT.7) GO TO 1030 IF(TOSQ.EQ.14) GO TO 1030 BOARD(TO8)=FROMSQ IF(CHECK(SIDE)) GO TO 1020 CALL SCORE CALL ENTER 1020 BOARD(TO8)=TOSQ IF(TOSQ.EQ.7) GO TO 1010 1030 CONTINUE RETURN END INTEGER FUNCTION BLOCK(SQUARE,SIDE) C C ************************************************************ C * * C * BLOCK IS USED TO DETERMINE IF A PIECE IS BLOCKADING * C * A PASSED PAWN, AND IF SO HOW EFFECTIVE IT IS. THE * C * SQUARE IN FRONT OF THE PIECE IS EXAMINED TO SEE IF IT * C * CONTAINS A PASSED PAWN. IF SO, THE PIECE IS GIVEN * C * CREDIT FOR BLOCKING IT WHERE KNIGHTS, BISHOPS AND THE * C * KING ARE THE BEST BLOCKADERS, THE QUEEN IS NEXT, AND * C * ROOK IS LAST. THE SCORE RETURNED IS A MEASURE OF HOW * C * EFFECTIVE THE BLOCKADER IS...THE BIGGER THE SCORE, THE *^] C * MORE EFFECTIVE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO COMMON /BOARD/ BOARD(120) LOGICAL SIDE INTEGER*4 DENOM(6) DATA DENOM/1J,2J,2J,4J,3J,2J/ BLOCK=0 IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 PAWN=1 DIR=1 GO TO 300 C C==============================< HUMAN SCORING C 200 PAWN=8 DIR=-1 C C------------------------------< IF THE SQUARE IN FRONT OF THE PIECE C------------------------------< DOESN'T HAVE A PAWN ON IT, RETURN. C 300 SQ=SQUARE+10*DIR IF(BOARD(SQ).NE.PAWN) GO TO 999 C C------------------------------< IF THE PAWN ISN'T PASSED, RETURN C TEMP=PASSED(SQ,.NOT.SIDE) IF(TEMP.EQ.0) GO TO 999 C C------------------------------< DETERMINE WHAT TYPE OF PIECE THE C------------------------------< BLOCKADER IS TO ADJUST THE SCORE C PIECE=MOD(BOARD(SQUARE),7) BLOCK=BLOCK+BLKSC+TEMP/DENOM(PIECE) 999 RETURN END $CONTROL SEGMENT=DSP SUBROUTINE BOOK C C ************************************************************ C * * C * BOOK SEARCHES THE BOOK MOVE DATABASE FOR A RESPONSE * C * TO THE HUMAN'S LAST MOVE. IN MOST CASES THERE WILL BE * C * SEVERAL POSSIBLE REPLIES, THE COMPUTER ALWAYS TAKES THE * C * FIRST ONE. THIS COULD BE CHANGED TO A RANDOM NUMBER * C * CHOICE IF CARE IS TAKEN TO INSURE THAT ONLY 'GOOD' * C * LINES ARE PUT INTO THE DATABASE. IF NO RESPONSE IS * C * FOUND, 'IN BOOK' IS SET TO FALSE SO THAT THE MOVE WILL * C * BE CALCULATED. IF THE MOVE IS FOUND, OUR RESPONSE IS * C * CHOSEN AND THE POINTER TO THE HUMAN'S POSSIBLE REPLIES * C * IS SAVED FOR THE NEXT CALL. NO MORE THAN TWO (2) I/O * C * OPERATIONS ARE REQUIRED FOR THIS (ONLY ONE IF THE * C * HUMAN'S RESPONSE IS NOT IN THE DATABASE), SO THE MORE * C * COMPREHENSIVE THE BOOK DATABASE IS, THE MORE TIME WILL * C * BE SAVED FOR LATER COMPUTED SEARCHING. * C * A SEPARATE PROGRAM IS USED TO BUILD THE DATABASE * C * TO KEEP UNNEEDED CODE OUT OF THE MAIN CHESS PLAYING * C * PROGRAM. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) C DEFINE FILE 3(1000,40,U,KEY) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /TREE/ TREE(400),DMY(81) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /BOOK CM/ KEY, IN BOOK LOGICAL IN BOOK COMMON /OPEN CM/ MVNUMB INTEGER*4 MAXW DATA MAXW/20J/ C C------------------------------< IF IT IS THE FIRST MOVE AND THE C------------------------------< COMPUTER IS WHITE, CHOOSE THE FIRST C------------------------------< MOVE IN THE BOOK FILE. C IF(MOVE.EQ.0) GO TO 5 C C------------------------------< READ IN THE RECORD WITH THE HUMAN'S C------------------------------< POSSIBLE RESPONSES. THEN MATCH THE C------------------------------< HUMAN'S MOVE AGAINST THE LIST TO C------------------------------< GET THE POINTER TO THE RECORD WITH C------------------------------< THE COMPUTER'S POSSIBLE REPLIES. C IF(KEY.EQ.0) GO TO 3 LIM=MAXW*2 READ(3@KEY)(TREE(I),I=1,LIM) C C------------------------------< MATCH THE OPPONENT'S MOVE C DO 2 I=1,MAXW FROM8=TREE(I) CALL EXTRCT IF(COLOR.EQ.1) GO TO 1 FROM8=121-FROM8 TO8=121-TO8 1 IF(TYPE8.NE.HTYPE8) GO TO 2 IF(TYPE8.EQ.CASTRT.OR.TYPE8.EQ.CASTLF) GO TO 4 IF(HTO8.EQ.TO8.AND.HFROM8.EQ.FROM8) GO TO 4 2 CONTINUE 3 IN BOOK = .FALSE. RETURN 4 KEY=TREE(I+MAXW) IF(KEY.EQ.0) GO TO 3 C C------------------------------< READ IN THE RECORD WITH THE COMPUTER'S C------------------------------< POSSIBLE REPLIES TO THE LAST HUMAN C------------------------------< MOVE AND CHOOSE ONE OF THEM (FIRST C------------------------------< MOVE NOW, BUT COULD BE RANDOM). C 5 LIM=MAXW*2 READ(3@KEY)(TREE(I),I=1,LIM) C C------------------------------< CHECK TO MAKE SURE REQUESTED MOVE C------------------------------< ACTUALLY EXISTS C IF(MVNUMB.GT.MAXW) GO TO 300 IF(TREE(MVNUMB).NE.0) GO TO 100 300 WRITE(6,200)MVNUMB 200 FORMAT(1X,'MOVE ',I2,' DOESN''T EXIST. I AM USING THE FIRST') MVNUMB=1 100 CONTINUE FROM8=TREE(MVNUMB) CALL EXTRCT IF(COLOR.EQ.1) GO TO 6 FROM8=121-FROM8 TO8=121-TO8 6 CALL ENTERD(CMOVE) KEY=TREE(MAXW+MVNUMB) MVNUMB=1 RETURN END SUBROUTINE BREAK C C ************************************************************ C * * C * BREAK CONTROLS USE OF THE 'BREAK' BUTTON OR 'ATTN' * C * KEY ON TERMINALS. THERE ARE TWO (2) ENTRY POINTS AND * C * TWO (2) ACTIONS TAKEN AS A RESULT OF A 'BREAK' OR 'ATTN'* C * SIGNAL. THE ENTRY POINTS ARE 'BRK ON' TO SET BREAK * C * CONTROL AND 'BRK OFF' TO RESET BREAK CONTROL. 'BRK ON' * C * REQUIRES 1 ARGUMENT IF THINK-AHEAD IS TO BE USED. THIS * C * IS THE STATEMENT NUMBER TO RETURN TO IF THE PROGRAM IS * C * THINKING ON THE OPPONENT'S TIME AND THE BREAK KEY IS * C * HIT INDICATING THAT IT IS TIME TO ACCEPT INPUT FROM THE * C * PERSON PLAYING THE GAME. * C * THE TWO ACTIONS TAKEN ARE (1) IF THE MACHINE IS * C * IN THE PROCESS OF CALCULATING A MOVE ON IT'S OWN TIME, * C * THE BEST MOVE FOUND SO FAR, THE CURRENT MOVE, AND THE * C * NUMBER OF MOVES REMAINING TO BE CHECKED ARE PRINTED. * C * (2) IF THE PROGRAM IS IN THINK-AHEAD MODE, THAT IS, IT * C * IS THINKING WHILE THE OPPONENT IS THINKING, THEN A * C * RETURN IS MADE TO THE INPUT ROUTINE TO ACCEPT THE MOVE * C * THE OPPONENT WISHES TO TYPE IN. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) SYSTEM INTRINSIC XCONTRAP COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL THNK AH, LOOK AH, PTHAHM, FOUND M, MTCHED, BRKFLG COMMON /SAVE CM/ SBOARD(100) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /BUFFER/ TEXT(30) COMMON /TRACE/ TRACE(20,10),TFLAG COMMON /HIST CM/ NMOVES, ANNOTE COMMON /BRK CM/ CSEC1, CSEC2, HSEC1, HSEC2 COMMON /PRED CM/ PTEXT(30) COMMON /TIME CM/ TIM LIM, MAX TIM COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)) INTEGER*2 OFF, DMY C------------------------------< GET BREAK CONTROL DATA OFF / 0 / ENTRY BRK ON C C------------------------------< BREAK ROUTINE PRINTS CURRENT/BEST C------------------------------< MOVES, VALUES, ETC. C 39 CONTINUE IF(LOOKAH.AND..NOT.MTCHED) GO TO 442 CALL CTIME(CSEC2) T1=TO8 F1=FROM8 T2=TYPE8 V1=VALUE8 E=CSEC2-CSEC1 TERM=0 LIM=DEPTH-1 DO 555 I=1,LIM TERM=TERM+NODES(I) 555 CONTINUE WRITE(6,40)E,TERM 40 FORMAT(/1X,'TIME:',I4,1X,'SECS',2X,'POSITIONS:',I6) FROM8=TREE(WHICH(1)) CALL EXTRCT CALL OUTMOV(FROM8,TO8,TYPE8,ETYPE8,1,SBOARD) WRITE(6,43)TEXT 43 FORMAT(1X,'CURRENT MOVE: ',30R1) IF(BACKUP(1).EQ.-9999) GO TO 441 FROM8=CMOVE CALL EXTRCT CALL OUTMOV(FROM8,TO8,TYPE8,ETYPE8,1,SBOARD) WRITE(6,44)BACKUP(1),TEXT 44 FORMAT(1X,'BEST: ',I6,2X,30R1) 441 REMAIN=STOP(1)-WHICH(1)+1 TOTAL=STOP(1)-START(1)+1 WRITE(6,443)REMAIN,TOTAL 443 FORMAT(1X,I2,' OF ',I2,' MOVES REMAINING'/) TO8=T1 FROM8=F1 TYPE8=T2 VALUE8=V1 TFLAG=0 RETURN C C------------------------------< 'BREAK' HIT, ABORT LOOK-AHEAD ENTRY BRK ON2 442 CONTINUE READ(5,543)TEXT 543 FORMAT(30R1) IF(TEXT(1).EQ.BLANK) GO TO 446 DO 444 I=1,30 IF(TEXT(I).EQ.BLANK.AND.PTEXT(I).EQ.BLANK) GO TO 445 IF(TEXT(I).NE.PTEXT(I)) GO TO 450 444 CONTINUE 445 MTCHED=.TRUE. CALL XCONTRAP(OFF,DMY) ON CONTROLY CALL BRK ON CALL ETIME(HSEC2) CALL CTIME(CSEC1) MAX TIM = TIM LIM + CSEC1 446 CONTINUE RETURN 450 CONTINUE BRKFLG=.TRUE. CALL XCONTRAP(OFF,DMY) RETURN END INTEGER FUNCTION BSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * BSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR BISHOP MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE BISHOP CONTROL BOARD FOR THE SIDE TO MOVE. (CBSCOR, * C * HBSCOR IN COMMON BLOCK 'B BD SM'). * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /B BD SM/ CBSCOR(100), HBSCOR(100) LOGICAL SIDE IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 BSCORE=CBSCOR(SQUARE) RETURN C C==============================< HUMAN SCORING C 200 BSCORE=HBSCOR(SQUARE) RETURN END $CONTROL SEGMENT=PC SUBROUTINE CASTLE C C ************************************************************ C * * C * CASTLE GENERATES ALL CASTLING MOVES. CASTLING TO * C * EITHER SIDE IS CONSIDERED EQUALLY PLAUSIBLE (BOTH GET * C * A FAIRLY HIGH SCORE TO ENSURE CHECKING THE MOVE). * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) LOGICAL CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /MOVE CM/ INDEX, PIECE, SIDE LOGICAL SIDE, CHECK COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /K LOC CM/ CKINGL, HKINGL COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /CAST SM/ CAST SC, UB CAST IF(PLY.GT.2) GO TO 9999 TO8=0 FROM8=0 IF(SIDE) GO TO 2000 C C------------------------------< COMPUTER CASTLING MOVES C 1000 IF(CKINGM) GO TO 9999 CKINGM=.TRUE. 1010 IF(CHECK(.FALSE.)) GO TO 9997 TEMP=CKINGL IF(COLOR)1080,1020,1080 1020 IF(CROOKR) GO TO 1050 1030 IF(BOARD(23).NE.7.OR.BOARD(24).NE.7 *.OR.BOARD(25).NE.7) GO TO 1050 CKINGL=24 IF(CHECK(.FALSE.)) GO TO 1040 CKINGL=25 IF(CHECK(.FALSE.)) GO TO 1040 TYPE8=CASTRT VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 1040 CKINGL=TEMP 1050 IF(CROOKL) GO TO 9997 1060 IF(BOARD(27).NE.7.OR.BOARD(28).NE.7) GO TO 9997 CKINGL=27 IF(CHECK(.FALSE.)) GO TO 1070 CKINGL=28 IF(CHECK(.FALSE.)) GO TO 1070 TYPE8=CASTLF VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 1070 CKINGL=TEMP GO TO 9997 1080 IF(CROOKR) GO TO 1110 1090 IF(BOARD(23).NE.7.OR.BOARD(24).NE.7) GO TO 1110 CKINGL=23 IF(CHECK(.FALSE.)) GO TO 1100 CKINGL=24 IF(CHECK(.FALSE.)) GO TO 1100 TYPE8=CASTRT VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 1100 CKINGL=TEMP 1110 IF(CROOKL) GO TO 9997 1120 IF(BOARD(26).NE.7.OR.BOARD(27).NE.7 *.OR.BOARD(28).NE.7) GO TO 9997 CKINGL=26 IF(CHECK(.FALSE.)) GO TO 1130 CKINGL=27 IF(CHECK(.FALSE.)) GO TO 1130 TYPE8=CASTLF VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 1130 CKINGL=TEMP 9997 CKINGM=.FALSE. GO TO 9999 C C------------------------------< HUMAN CASTLING MOVES C 2000 IF(HKINGM) GO TO 9999 HKINGM=.TRUE. 2010 IF(CHECK(.TRUE.)) GO TO 9998 TEMP=HKINGL IF(COLOR)2080,2020,2080 2020 IF(HROOKL) GO TO 2050 2030 IF(BOARD(93).NE.7.OR.BOARD(94).NE.7 *.OR.BOARD(95).NE.7) GO TO 2050 HKINGL=94 IF(CHECK(.TRUE.)) GO TO 2040 HKINGL=95 IF(CHECK(.TRUE.)) GO TO 2040 TYPE8=CASTLF VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 2040 HKINGL=TEMP 2050 IF(HROOKR) GO TO 9998 2060 IF(BOARD(97).NE.7.OR.BOARD(98).NE.7) GO TO 9998 HKINGL=97 IF(CHECK(.TRUE.)) GO TO 2070 HKINGL=98 IF(CHECK(.TRUE.)) GO TO 2070 TYPE8=CASTRT VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 2070 HKINGL=TEMP GO TO 9998 2080 IF(HROOKL) GO TO 2110 2090 IF(BOARD(93).NE.7.OR.BOARD(94).NE.7) GO TO 2110 HKINGL=93 IF(CHECK(.TRUE.)) GO TO 2100 HKINGL=94 IF(CHECK(.TRUE.)) GO TO 2100 TYPE8=CASTLF VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 2100 HKINGL=TEMP 2110 IF(HROOKR) GO TO 9998 2120 IF(BOARD(96).NE.7.OR.BOARD(97).NE.7 *.OR.BOARD(98).NE.7) GO TO 9998 HKINGL=96 IF(CHECK(.TRUE.)) GO TO 2130 HKINGL=97 IF(CHECK(.TRUE.)) GO TO 2130 TYPE8=CASTRT VALUE8 = CAST SC + EXPOSE(SIDE) CALL ENTER 2130 HKINGL=TEMP 9998 HKINGM=.FALSE. 9999 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE CCMND(DEVICE) C C ************************************************************ C * * C * CCMND HANDLES ALL 'CHESS CLOCK' COMMANDS. THERE * C * ARE FIVE BASIC OPERATIONS THAT CAN BE PERFORMED BY THIS * C * ROUTINE: * C * 1) THE CHESS CLOCK CAN BE TURNED ON OR OFF. IF IT * C * IS ON, THE PROGRAM WILL PRINT OUT THE TIME BOTH * C * IT AND THE HUMAN TAKES IN CHOOSING A MOVE AFTER * C * EACH MAKES A MOVE. * C * 2) THE CHESS CLOCK CAN BE SET TO SOME SPECIFIC * C * VALUE ALONG WITH A MOVE COUNTER TO FORCE THE * C * PROGRAM AND HUMAN TO MAKE A CERTAIN NUMBER OF * C * MOVES IN A SPECIFIED TIME PERIOD, FOR EXAMPLE * C * 40 MOVES IN 10 MINUTES FOR HIGH-SPEED CHESS. * C * 3) THE CHESS CLOCK CAN BE DISPLAYED, TELLING HOW * C * MUCH TIME EACH SIDE HAS ON IT'S CLOCK TO SEE * C * HOW EACH SIDE IS DOING WITH RESPECT TO TIME. * C * 4) THE COMPUTER'S TIME PER MOVE IS USUALLY IN * C * COMPUTER TIME WHICH MAY BE MUCH SLOWER THAN * C * REAL OR WALL CLOCK TIME. THE COMPUTER MAY BE * C * FORCED TO USE ELAPSED TIME JUST AS THE HUMAN * C * ALWAYS DOES IF DESIRED. THIS MAY GET THE PROG- * C * RAM INTO TIME TROUBLE, BUT MAY BE REQUIRED FOR * C * TOURNAMENT PLAY WHERE COMPUTER TIME IS NOT * C * UNDERSTOOD BY EVERYONE. * C * 5) THE PROGRAM CAN BE INSTRUCTED TO PERIODICALLY * C * ASK THE TERMINAL OPERATOR WHO MUCH TIME IS * C * LEFT ON IT'S CLOCK SINCE COMPUTER TIMING MAY * C * NOT EXACTLY AGREE WITH THE CHESS CLOCK. SEE * C * MODULE 'QUERY' FOR FURTHER DETAILS. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON / BUFFER / TEXT(30) COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /BRK CM/ CSEC1, CSEC2, HSEC1, HSEC2 LOGICAL CLOCK, CQUERY COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (D,ALPHA(4)),(L,ALPHA(12)),(T,ALPHA(20)), *(C,ALPHA(3)),(BLANK,ALPHA(44)),(QUEST,ALPHA(43)), *(O,ALPHA(15)),(Q,ALPHA(17)) IF(TEXT(2).EQ.C) GO TO 200 IF(TEXT(2).EQ.D) GO TO 70 IF(TEXT(2).EQ.QUEST) GO TO 90 IF(TEXT(2).EQ.T) GO TO 110 IF(TEXT(2).EQ.BLANK) GO TO 40 IF(TEXT(2).EQ.O) GO TO 650 IF(TEXT(2).EQ.Q) GO TO 400 IF(TEXT(2).NE.L) RETURN C C------------------------------< CL : TOGGLE CHESS CLOCK ON/OFF C CLOCK=.FALSE. WRITE(6,10) RETURN 10 FORMAT(1X,'CLOCK TURNED OFF') C C------------------------------< C : SET CHESS CLOCK C 40 WRITE(6,41) 41 FORMAT(1X,'HOW MANY MOVES?') CALL INPUT(TEMP) IF(TEMP.EQ.0) RETURN MOVES=TEMP WRITE(6,42) 42 FORMAT(1X,'IN HOW MANY MINUTES?') CALL INPUT(GELAP) GELAP=GELAP*60 WRITE(6,43) 43 FORMAT(1X,'THEN HOW MANY MOVES?') CALL INPUT(SMOVES) WRITE(6,44) 44 FORMAT(1X,'IN HOW MANY MINUTES?') CALL INPUT(SELAP) SELAP=SELAP*60 CLOCK=.TRUE. AVG=GELAP/MOVES IF(AVG.LT.120) DEPTH=4 IF(AVG.LT.30) DEPTH=3 IF(AVG.LE.10) DEPTH=2 IF(DEPTH.LT.5) OPTIME=0 RETURN C C------------------------------< CC : CORRECT CHESS CLOCK C 200 IF(TEXT(3).NE.C.AND.TEXT(3).NE.BLANK) GO TO 220 WRITE(6,210) 210 FORMAT(1X,'TIME LEFT ON MY CLOCK?') CALL INPUT(TIME) IF(TIME.EQ.0) GO TO 220 CELAP=GELAP-TIME*60 220 IF(TEXT(3).NE.O.AND.TEXT(3).NE.BLANK) GO TO 240 WRITE(6,230) 230 FORMAT(1X,'TIME LEFT ON OPPONENT''S CLOCK?') CALL INPUT(TIME) IF(TIME.EQ.0) GO TO 240 CALL ETIME(HSEC2) HELAP=GELAP-TIME*60-(HSEC1-HSEC2) 240 RETURN C C------------------------------< CD : DISPLAY CHESS CLOCK 70 CALL ETIME(HSEC2) D1=GELAP-CELAP D2=GELAP-HELAP-(HSEC2-HSEC1) IF(D1.LT.0) D1=0 IF(D2.LT.0) D2=0 H1=D1/60 H2=D2/60 M1=MOD(D1,60) M2=MOD(D2,60) WRITE(DEVICE,80) H1,M1,H2,M2 80 FORMAT(7X,'BLITZ',12X,'OPPONENT'/ *1X,I3,' MINS ',I2,' SECS',2X,I3,' MINS ',I2,' SECS') RETURN C C------------------------------< CO : SET OPERATOR WASTE TIME C 650 IF(TEXT(3).EQ.D) GO TO 652 WRITE(6,651) 651 FORMAT(1X,'ENTER TIME PER MOVE WASTED BY OPERATOR') CALL INPUT(OPTIME) IF(OPTIME.LT.0) GO TO 650 RETURN 652 WRITE(6,653)OPTIME 653 FORMAT(1X,'OPERATOR WASTES',I3,' SECONDS PER MOVE') RETURN C C------------------------------< CQ : SET CLOCK QUERY FLAG C 400 CQUERY=.NOT. CQUERY IF(CQUERY) WRITE(6,410) IF(.NOT. CQUERY) WRITE(6,420) RETURN 410 FORMAT(1X,'I WILL ASK ABOUT THE CHESS CLOCK TIME') 420 FORMAT(1X,'I WILL NOT ASK ABOUT THE CHESS CLOCK TIME') C C------------------------------< CT : SET CLOCK TYPE (ELAPSED/CPU) C 110 IF(CTYPE.EQ.1) WRITE(6,120) IF(CTYPE.EQ.2) WRITE(6,130) IF(TEXT(3).EQ.D) GO TO 170 160 WRITE(6,140) CALL INPUT(TYPE) IF(TYPE.EQ.0) GO TO 170 IF(TYPE.NE.1.AND.TYPE.NE.2) GO TO 160 CTYPE=TYPE 170 RETURN 120 FORMAT(1X,'CLOCK IS USING CPU TIME') 130 FORMAT(1X,'CLOCK IS USING ELAPSED TIME') 140 FORMAT(1X,'ENTER CLOCK TYPE (1=CPU, 2=ELAPSED)') C C------------------------------< C? : CHESS CLOCK HELP C 90 WRITE(6,100) 100 FORMAT( *1X,'C : SET THE CHESS CLOCK'/ *1X,'CC : CORRECT THE CHESS CLOCK'/ *1X,'CCC: CORRECT THE PROGRAM''S CLOCK'/ *1X,'CCO: CORRECT THE OPPONENT''S CLOCK'/ *1X,'CD : DISPLAY THE CHESS CLOCK'/ *1X,'CL : TURN THE CHESS CLOCK OFF'/ *1X,'CO : SET OPERATOR MOVE TIME'/ *1X,'CQ : MAKE PROGRAM QUERY OPERATOR ABOUT CLOCK TIME'/ *1X,'CT : RE-SPECIFY THE TYPE OF TIMING FOR COMPUTER MOVES'/ *) RETURN END LOGICAL FUNCTION CHECK(SIDE) C C ************************************************************ C * * C * CHECK DETERMINES IF THE SIDE TO MOVE IS IN CHECK * C * OR IF THE MOVE IS A CHECKING MOVE FOR THE OPPONENT. * C * THE ARGUMENT, 'SIDE' INDICATES WHICH SIDE TO CHECK FOR * C * AS FOLLOWS: * C * A) IF SIDE IS TRUE, DETERMINE IF THE HUMAN IS IN * C * CHECK. * C * B) IF SIDE IS FALSE, DETERMINE IF THE COMPUTER IS * C * IN CHECK. * C * CHECK IS A LOGICAL FUNCTION WHICH RETURNS TRUE IF * C * THE SIDE REQUESTED IS IN CHECK AND FALSE IF NOT. * C * CHECK PRETENDS IT IS VARIOUS PIECES SITTING ON * C * THE SAME SQUARE AS THE KING. IT THEN GENERATES MOVES * C * FOR THESE FAKE PIECES AND FOLLOWS THE MOVES. IF, FOR * C * EXAMPLE, IT GENERATES BISHOP MOVES AND LOOKS DOWN THE * C * DIAGONAL AND SEES AN OPPONENT BISHOP OR QUEEN WITH NO * C * INTERPOSING PIECES OR PAWNS, THEN CHECK IS SET TO TRUE * C * AND A RETURN IS TAKEN. THIS IS DONE FOR ALL PIECES AND * C * PAWNS BEFORE CHECK IS SET TO FALSE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) LOGICAL SIDE COMMON /K LOC CM/ CKINGL, HKINGL COMMON/MOVES/RK(4),BP(4),KT(8),KG(8) COMMON/BOARD/BOARD(120) CHECK=.FALSE. IF(SIDE) GO TO 9 TKINGL=CKINGL BIAS=0 DIR=1 GO TO 10 9 TKINGL=HKINGL BIAS=7 DIR=-1 10 PAWN=1+BIAS KNIGHT=2+BIAS BISHOP=3+BIAS ROOK=4+BIAS QUEEN=5+BIAS KING=6+BIAS C C------------------------------< KING IS A PAWN, SEE IF IT CAN C------------------------------< CAPTURE AN OPPONENT'S PAWN. C IF(BOARD(TKINGL+9*DIR).EQ.PAWN) GO TO 7 IF(BOARD(TKINGL+11*DIR).EQ.PAWN) GO TO 7 C C------------------------------< KING IS A KNIGHT/KING, SEE IF IT C------------------------------< CAN CAPTURE A KNIGHT/KING. C 8 DO 1 I=1,8 IF(BOARD(TKINGL+KT(I)).EQ.KNIGHT) GO TO 7 IF(BOARD(TKINGL+KG(I)).EQ.KING) GO TO 7 1 CONTINUE C C------------------------------< KING IS A BISHOP, SEE IF IT CAN C------------------------------< CAPTURE A BISHOP OR QUEEN. C DO 3 I=1,4 LOC=TKINGL DIREC=BP(I) 2 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(TEMP.EQ.7) GO TO 2 IF(TEMP.EQ.BISHOP) GO TO 7 IF(TEMP.EQ.QUEEN) GO TO 7 3 CONTINUE C C------------------------------< KING IS A ROOK, SEE IF IT CAN C------------------------------< CAPTURE A ROOK OR QUEEN. C DO 5 I=1,4 LOC=TKINGL DIREC=RK(I) 4 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(TEMP.EQ.7) GO TO 4 IF(TEMP.EQ.ROOK) GO TO 7 IF(TEMP.EQ.QUEEN) GO TO 7 5 CONTINUE RETURN C C------------------------------< BY PRETENDING TO BE A PIECE, IT WAS C------------------------------< THAT THE KING COULD CAPTURE THE C------------------------------< PIECE IT WAS PRETENDING TO BE. BY C------------------------------< THE SAME REASONING, THAT PIECE COULD C------------------------------< CAPTURE THE KING -- IT IS IN CHECK. C 7 CHECK=.TRUE. RETURN END SUBROUTINE COMPRS C C ************************************************************ C * * C * COMPRS IS USED TO COMPRESS THE 64 SIGNIFICANT WORDS * C * OF THE CHESS BOARD INTO 8 WORDS BY USING 4 BITS PER * C * SQUARE. THIS COMPRESSED POSITION IS SAVED TO DETECT * C * DRAW BY REPITITION OF MOVES. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /DUP/ PACK(8),POINT,BDSAVE(30,8) ON INTEGER*4 OVERFLOW CALL OVTRAP SQ=21 DO 200 I=1,8 PACK(I)=0 DO 100 J=1,8 SQ=SQ+1 PACK(I)=PACK(I)*2**4+BOARD(SQ) 100 CONTINUE SQ=SQ+2 200 CONTINUE ON INTEGER*4 OVERFLOW ABORT RETURN END SUBROUTINE OVTRAP(ITG) IMPLICIT INTEGER*4 (A-Z) INTEGER*4 OVNM, ITG DATA OVNM / 0 / OVNM=OVNM+1 RETURN END $CONTROL SEGMENT=DSP SUBROUTINE DISPLY(DEVICE) C C ************************************************************ C * * C * DISPLAY IS USED TO DISPLAY THE GAME BOARD (CALLED * C * BY THE 'D' COMMAND). IN ADDITION TO THE BOARD, THE * C * PIECES CAPTURED BY BOTH SIDES ARE DISPLAYED TO THE * C * RIGHT FOR INFORMATION. COLONS (: :) SURROUND THE HUMAN * C * PIECES AND BRACKETS ( ) SURROUND THE COMPUTER PIECES. * C * WHITE EMPTY SQUARES ARE INDICATED BY AN ASTERISK (*), * C * BLACK EMPTY SQUARES ARE INDICATED BY A DASH (-). * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) INTEGER*4 CHAR(13),BDCHAR(64),HPC(16),CPC(16),WSQ COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR,HCOLOR COMMON /BUFFER/ TEXT(30) COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME LOGICAL CLOCK, CQUERY COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (D,ALPHA(4)) DATA CHAR/%":P:"J,%":N:"J,%":B:"J,%":R:"J,%":Q:"J,%":K:"J, *%" - "J,%"(P)"J,%"(N)"J,%"(B)"J,%"(R)"J,%"(Q)"J, *%"(K)"J/,WSQ/%" * "J/ DATA CPC/16*%" "J/,HPC/16*%" "J/ IF(TEXT(2).EQ.D) GO TO 1000 C C------------------------------< SET UP THE DISPLAY BOARD C SQ=21 DO 443 I=1,8 DO 442 J=1,8 SQ=SQ+1 BDCHAR((I-1)*8+J)=CHAR(BOARD(SQ)) 442 CONTINUE SQ=SQ+2 443 CONTINUE FUDGE=0 DO 3 I=1,8 DO 2 J=1,7,2 IF(BDCHAR((I-1)*8+J+FUDGE).EQ.CHAR(7)) * BDCHAR((I-1)*8+J+FUDGE)=WSQ 2 CONTINUE FUDGE=MOD(FUDGE+1,2) 3 CONTINUE C C------------------------------< DETERMINE WHICH PIECES HAVE BEEN C------------------------------< CAPTURED AND DISPLAY THEM ON THE SIDE. C DO 386 I=1,7 CPC(I)=(25-I)/2 HPC(I)=(11-I)/2 386 CONTINUE DO 100 I=8,15 CPC(I)=8 100 HPC(I)=1 388 SQ=21 DO 223 I=1,8 DO 222 I1=1,8 SQ=SQ+1 DO 201 J=1,15 IF(CPC(J).EQ.BOARD(SQ)) GO TO 202 201 CONTINUE GO TO 203 202 CPC(J)=7 203 DO 250 J=1,15 IF(HPC(J).EQ.BOARD(SQ)) GO TO 251 250 CONTINUE GO TO 222 251 HPC(J)=7 222 CONTINUE SQ=SQ+2 223 CONTINUE DO 302 I=1,15 DO 300 J=1,14 IF(CPC(J).NE.7) GO TO 301 CPC(J)=CPC(J+1) CPC(J+1)=7 301 IF(HPC(J).NE.7) GO TO 300 HPC(J)=HPC(J+1) HPC(J+1)=7 300 CONTINUE 302 CONTINUE DO 400 I=1,15 CPC(I)=CHAR(CPC(I)) IF(CPC(I).EQ.CHAR(7)) CPC(I)=%' ' HPC(I)=CHAR(HPC(I)) IF(HPC(I).EQ.CHAR(7)) HPC(I)=%' ' 400 CONTINUE C C------------------------------< OUTPUT BOARD AND CAPTURED PIECES C WRITE(DEVICE,4) CCOLOR 4 FORMAT(/16X,A5,T45,'CAPTURED PIECES'/) DO 900 I=1,8 J=(I-1)*8+1 K=J+7 J1=(I-1)*2+1 K1=J1+1 WRITE(DEVICE,5)(BDCHAR(L),L=J,K),(CPC(L),HPC(L),L=J1,K1) 5 FORMAT(3X,8(R3,1X),12X,R3,4X,R3/47X,R3,4X,R3) 900 CONTINUE WRITE(DEVICE,6) HCOLOR 6 FORMAT(16X,A5/) C C------------------------------< IF THE CHESS CLOCK IS BEING USED, C------------------------------< DISPLAY IT UNDER THE BOARD. C IF(.NOT. CLOCK) RETURN TEXT(2)=D CALL CCMND(DEVICE) 7 RETURN 1000 CALL OUTPUT(DEVICE,BOARD) GO TO 7 END LOGICAL FUNCTION DRAW(SCORE) C C ************************************************************ C * * C * DRAW IS USED TO DETERMINE IF THE COMPUTER SHOULD * C * ACCEPT A DRAW/STALEMATE IF ONE IS OFFERED/FOUND. THE * C * MATERIAL BALANCE IS EXAMINED AS WELL AS THE VALUE * C * OF SQUARES PIECES/PAWNS ARE POSTED ON. A VALUE OF * C * 'TRUE' IS RETURNED IF THE PROGRAM IS BEHIND. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /RATE CM/ CRATE, HRATE COMMON /DRAW CM/ STAT BD(100) LOGICAL SIDE, ISOLAT DRAW=.FALSE. CALL PREANL SCORE=0 C C------------------------------< SCAN THE BOARD TO DETERMINE THE C------------------------------< VALUE OF ALL PIECES/PAWNS. C DO 200 SQUARE=22,99 SC=0 TEMP=BOARD(SQUARE) IF(TEMP.EQ.7.OR.TEMP.EQ.14) GO TO 100 SIDE=TEMP.LT.7 SIGN=1 IF(SIDE) SIGN=-1 SC=WORTH(SQUARE,SIDE) 100 SCORE=SCORE+SIGN*SC STAT BD(SQUARE)=SC 200 CONTINUE C C------------------------------< ANALYZE THE KING SAFETY C SCORE=SCORE+EXPOSE(.FALSE.)-EXPOSE(.TRUE.) C C------------------------------< IF THE OPPONENT IS A MUCH HIGHER C------------------------------< RATED PLAYER THAN THE PROGRAM, ALWAYS C------------------------------< ACCEPT A DRAW. IF HE IS A CLASS C------------------------------< BETTER, ACCEPT A DRAW IF NOT 1 1/2 C------------------------------< PAWNS OR MORE AHEAD. OTHERWISE, ACCEPT C------------------------------< A DRAW WHEN BEHIND ONLY. C RATE=HRATE-CRATE C C------------------------------< IF THE OPPONENT IS 2 CLASSES BETTER, C------------------------------< WE SHOULD COUNT OUR BLESSINGS AND C------------------------------< ACCEPT THE DRAW UNLESS A ROOK AHEAD. C IF(RATE.GT.400.AND.SCORE.LT.2000) GO TO 200 C C------------------------------< WE MUST BE AT LEAST 1 1/2 PAWNS C------------------------------< AHEAD TO REFUSE A DRAW WITH A C------------------------------< PLAYER 1 CLASS BETTER. C IF(RATE.GT.200.AND.SCORE.LT.600) GO TO 300 C C------------------------------< WE MUST ALWAYS BE AHEAD OR EVEN C------------------------------< TO REFUSE A DRAW. C IF(SCORE.GE.0.AND.RATE.LT.200) GO TO 400 300 DRAW=.TRUE. 400 RETURN END INTEGER FUNCTION ENPRIS(SQUARE,SIDE) C C ************************************************************ C * * C * ENPRIS IS USED IN MOVE ORDERING TO DETERMINE THE * C * CONDITION OF PIECES ON THE BOARD. IT RETURNS A VALUE * C * CORRESPONDING TO THE EXPECTED LOSS OF MATERIAL ON A * C * SQUARE. IT MAKES THE FOLLOWING CHECKS: * C * * C * 1) IF THE PIECE IS NOT UNDER ATTACK, LOSS=0 * C * * C * 2) IF THE PIECE IS UNDER ATTACK AND NOT DEFENDED, * C * LOSS=VALUE OF PIECE * C * * C * 3) IF THE PIECE IS ATTACKED BY A MORE VALUABLE * C * PIECE AND IS DEFENDED, LOSS=0 * C * * C * 4) IF THE PIECE IS ATTACKED BY A LESS VALUABLE * C * PIECE AND IS DEFENDED, LOSS=VALUE OF ATTACKED * C * PIECE LESS THE VALUE OF THE ATTACKING PIECE * C * (ASSUME THE PIECES WILL BE EXCHANGED) * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) LOGICAL SIDE COMMON /BOARD/ BOARD(120) COMMON /PIEC CM/ PVALUE(13), PINIT(13) ENPRIS=0 MVG PC=MOD(BOARD(SQUARE),7) C C------------------------------< GET LEAST VALUABLE PIECE ATTACKING C------------------------------< THE INDICATED SQUARE C 1000 ATKG PC=MINATK(SQUARE,SIDE,NUMATK) C C------------------------------< IF SQUARE IS NOT ATTACKED, RETURN C IF(ATKG PC.EQ.0) GO TO 3000 C C------------------------------< GET LEAST VALUABLE PIECE PROTECTING C------------------------------< THE INDICATED SQUARE C PROT PC=MINATK(SQUARE,.NOT.SIDE,NUMPRT) C C------------------------------< IF SQUARE IS PROTECTED, CHECK FURTHER C IF(PROT PC.GT.0) GO TO 1100 C C------------------------------< SQUARE IS ATTACKED, BUT NOT PROTECTED - C------------------------------< CONSIDER THE PIECE LOST C 5000 ENPRIS=PINIT(MVG PC) GO TO 3000 C C------------------------------< IF THE DEFENDING PIECE IS A KING, C------------------------------< FURTHER CHECKS ARE NECESSARY. C 1100 IF(PROT PC.EQ.6) GO TO 4000 C C------------------------------< IF THE ATTACKING PIECE IS MORE C------------------------------< VALUABLE THAN THE PIECE ON 'SQUARE' C------------------------------< WHICH IS PROTECTED - PIECE IS SAFE. C 6000 IF(ATKG PC.GT.MVG PC) GO TO 3000 IF(ATKG PC.LT.MVG PC) GO TO 2000 C C------------------------------< THE ATTACKING PIECE IS WORTH THE C------------------------------< SAME AS THE ATTACKED PIECE, SET C------------------------------< THE SCORE TO 1 TO INDICATE EVENESS. C ENPRIS=1 GO TO 3000 C C------------------------------< THE ATTACKING PIECE IS LESS C------------------------------< VALUABLE THAN THE PIECE ON 'SQUARE' - C------------------------------< ASSUME THE OTHER SIDE WOULD EXCHANGE. C 2000 ENPRIS=PINIT(MVG PC)-PINIT(ATKG PC) 3000 RETURN C C------------------------------< THE ONLY PROTECTING PIECE IS THE C------------------------------< KING, IF TWO PIECES ARE ATTACKING C------------------------------< THE PIECE IN QUESTION, THEN IT IS C------------------------------< SUBJECT TO CAPTURE SINCE THE KING C------------------------------< CANNOT BE EXCHANGED. C 4000 IF(NUMATK.GT.1) GO TO 5000 GO TO 6000 END SUBROUTINE ENTER C C ************************************************************ C * * C * ENTER/ENTERD IS USED TO COMPRESS THE MOVE INFOR- * C * MATION INTO 1 WORD TO CONSERVE MEMORY. ENTER ENTERS * C * THE MOVE INTO THE NEXT EMPTY SLOT IN THE MOVE LIST * C * WHILE ENTERD ENTERS THE MOVE INTO THE PARAMETER PASSED * C * IN THE ARGUMENT LIST. * C * * C * COMPRESSED DATA FORMAT : * C * * C * SMMM VVVV VVVV VVVV VVTT TTTT TFFF FFFF * C * * C * M => MOVE TYPE (DESCRIBED IN MVMKER) * C * V => PLAUSIBILITY SCORE OF MOVE * C * T => 'TO' OR DESTINATION SQUARE * C * F => 'FROM' OR SOURCE SQUARE * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY STOP(PLY)=STOP(PLY)+1 TREE(STOP(PLY))=FROM8+TO8*2**7+(VALUE8+8000)*2**14+TYPE8*2**28 RETURN ENTRY ENTERD(WORD) WORD=FROM8+TO8*2**7+(VALUE8+8000)*2**14+TYPE8*2**28 RETURN END INTEGER FUNCTION EXCHNG(SQUARE,SIDE) C C ************************************************************ C * * C * EXCHNG IS AN UNLIMITED LOOK-AHEAD ROUTINE TO CHECK * C * ALL CAPTURES ON A PARTICULAR SQUARE. IT DETERMINES ALL * C * PIECES BEARING ON THE SQUARE FOR BOTH SIDES AND THEN * C * PLAYS THE EXCHANGE SEQUENCES OUT. THE SCORE IS AD- * C * JUSTED BASED ON THE LOSS OR GAIN OF MATERIAL FOUND. * C * THIS ROUTINE IS USED BY THE TERMINAL SCORING SUB- * C * ROUTINE TO EXAMINE THE LAST MOVE OF A SEQUENCE. * C * THIS IS DONE TO PREVENT A PIECE FROM BEING LEFT DANG- * C * LING BECAUSE THE SEARCH WAS CUT OFF AT SOME FIXED PLY. * C * IT IS ALSO USED BY THE PLAUSIBILITY RE-ORDERING SUB- * C * ROUTINE AT EARLY LEVELS IN THE TREE TO MAKE SURE THAT * C * AFTER EACH MOVE GENERATED, NO PIECES ARE LEFT DANGLING * C * SUBJECT TO CAPTURE. * C * IN CARRYING OUT EXCHANGE SEQUENCES, THIS ROUTINE * C * DOES NOT ALWAYS MAKE EVERY CAPTURE POSSIBLE BECAUSE * C * THIS COULD RESULT IN BLUNDERS ALSO. FOR EXAMPLE, THE * C * SEQUENCE NXB, BXN, RXB, QXN, RXQ WOULD BE EXAMINED, * C * BUT THE EXCHANGE SCORE WOULD BE BASED ON THE FIRST * C * THREE (3) MOVES ONLY AS NO ONE WOULD GIVE UP A QUEEN * C * FOR A KNIGHT UNLESS IN A CHECKMATE SEQUENCE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /BOARD/ BOARD(120) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT INTEGER*4 MOVESC(16),MOVESH(16),LIST(32) LOGICAL SIDE, PLAYER EXCHNG=0 C=0 H=0 C C------------------------------< PAWN CAPTURES C IF(BOARD(SQUARE-9).NE.8) GO TO 1 C=C+1 MOVESC(C)=PVALUE(8)+PSCORE(SQUARE,.FALSE.) 1 IF(BOARD(SQUARE-11).NE.8) GO TO 2 C=C+1 MOVESC(C)=PVALUE(8)+PSCORE(SQUARE,.FALSE.) 2 IF(BOARD(SQUARE+9).NE.1) GO TO 3 H=H+1 MOVESH(H)=PVALUE(1)+PSCORE(SQUARE,.TRUE.) 3 IF(BOARD(SQUARE+11).NE.1) GO TO 4 H=H+1 MOVESH(H)=PVALUE(1)+PSCORE(SQUARE,.TRUE.) C C------------------------------< KNIGHT CAPTURES C 4 DO 7 I=1,8 LOC=SQUARE+KT(I) IF(BOARD(LOC).EQ.9) GO TO 5 IF(BOARD(LOC).EQ.2) GO TO 6 GO TO 7 5 C=C+1 MOVESC(C)=PVALUE(9)+NSCORE(SQUARE,.FALSE.) GO TO 7 6 H=H+1 MOVESH(H)=PVALUE(2)+NSCORE(SQUARE,.TRUE.) 7 CONTINUE C C------------------------------< BISHOP/QUEEN CAPTURES C DO 12 I=1,4 DIREC=BP(I) LOC=SQUARE 9 LOC=LOC+DIREC TEMP3=BOARD(LOC) GO TO(12,12,10,12,101,12,9,12,12,11,12,111,12,12),TEMP3 10 H=H+1 MOVESH(H)=PVALUE(TEMP3)+BSCORE(SQUARE,.TRUE.) GO TO 9 101 H=H+1 MOVESH(H)=PVALUE(TEMP3)+QSCORE(SQUARE,.TRUE.) GO TO 9 11 C=C+1 MOVESC(C)=PVALUE(TEMP3)+BSCORE(SQUARE,.FALSE.) GO TO 9 111 C=C+1 MOVESC(C)=PVALUE(TEMP3)+QSCORE(SQUARE,.FALSE.) GO TO 9 12 CONTINUE C C------------------------------< ROOK/QUEEN CAPTURES C DO 16 I=1,4 DIREC=RK(I) LOC=SQUARE 13 LOC=LOC+DIREC TEMP3=BOARD(LOC) GO TO(16,16,16,14,141,16,13,16,16,16,15,151,16,16),TEMP3 14 H=H+1 MOVESH(H)=PVALUE(TEMP3)+RSCORE(SQUARE,.TRUE.) GO TO 13 141 H=H+1 MOVESH(H)=PVALUE(TEMP3)+QSCORE(SQUARE,.TRUE.) GO TO 13 15 C=C+1 MOVESC(C)=PVALUE(TEMP3)+RSCORE(SQUARE,.FALSE.) GO TO 13 151 C=C+1 MOVESC(C)=PVALUE(TEMP3)+QSCORE(SQUARE,.FALSE.) GO TO 13 16 CONTINUE C C------------------------------< KING CAPTURES C DO 44 I=1,8 LOC=SQUARE+KG(I) IF(BOARD(LOC).EQ.6) GO TO 42 IF(BOARD(LOC).EQ.13) GO TO 43 GO TO 44 42 H=H+1 MOVESH(H)=PVALUE(6) GO TO 44 43 C=C+1 MOVESC(C)=PVALUE(13) 44 CONTINUE C C------------------------------< NOW THAT ALL CAPTURES ON THE IN- C------------------------------< DICATED SQUARE ARE IN THE BUFFER, C------------------------------< ANALYZE THE CAPTURING POSSIBILITIES C------------------------------< FOR PLAUSIBILITY AND ADJUST THE C------------------------------< SCORE ACCORDINGLY C CI=1 HI=1 LIST(1)=0 SIGN=1 DEPTH=1 PIECE=WORTH(SQUARE,SIDE) PLAYER=SIDE C C------------------------------< CHANGE SIDES C 100 PLAYER=.NOT.PLAYER IF(PLAYER) GO TO 200 C C------------------------------< IT IS THE MACHINES TURN TO CAPTURE, C------------------------------< IF IT DOESN'T HAVE ANY MORE PIECES C------------------------------< BEARING ON THE SQUARE, TIME TO QUIT. C IF(CI.GT.C) GO TO 400 TPIECE=MOVESC(CI) CI=CI+1 GO TO 300 C C------------------------------< IT IS THE HUMANS TURN TO CAPTURE, C------------------------------< IF HE DOESN'T HAVE ANY MORE PIECES C------------------------------< BEARING ON THE SQUARE, TIME TO QUIT. C 200 IF(HI.GT.H) GO TO 400 TPIECE=MOVESH(HI) HI=HI+1 C C------------------------------< PERFORM ALL INDICATED CAPTURES,BY C------------------------------< MINIMAXING THE SCORES. C 300 DEPTH=DEPTH+1 LIST(DEPTH)=LIST(DEPTH-1)+SIGN*PIECE PIECE=TPIECE SIGN=-SIGN GO TO 100 C C------------------------------< NOW THAT SCORING IS COMPLETE, SCAN C------------------------------< THE EXCHANGE LIST TO DETERMINE WHEN C------------------------------< THE SEQUENCE OF EXCHANGES WOULD C------------------------------< STOP. C 400 LIMIT=DEPTH IF(DEPTH.EQ.1) GO TO 999 T=MOD(DEPTH,2) IF(T.EQ.0) GO TO 600 500 IF(LIST(LIMIT).LT.LIST(LIMIT-1)) LIST(LIMIT-1)=LIST(LIMIT) LIMIT=LIMIT-1 IF(LIMIT.LT.3) GO TO 700 600 IF(LIST(LIMIT).GT.LIST(LIMIT-1)) LIST(LIMIT-1)=LIST(LIMIT) LIMIT=LIMIT-1 IF(LIMIT.GE.3) GO TO 500 700 TEMP=PLY+DEPTH IF(TEMP.GT.MAXPLY) MAXPLY=TEMP IF(LIST(2).LE.0) RETURN EXCHNG=LIST(2) 999 RETURN END SUBROUTINE EXECPC C C ************************************************************ C * * C * EXECPC IS USED TO EXECUTE PROGRAMMED COMMANDS THAT * C * HAVE BEEN ENTERED PREVIOUSLY. THIS ROUTINE IS CALLED * C * AFTER EVERY MOVE MADE BY THE COMPUTER. FOR A DESCRIP- * C * TION OF PROGRAMMED COMMAND MODE, LOOK AT THE PCCMND * C * ROUTINE COMMENTS. TO OPERATE, THIS ROUTINE MOVES THE * C * COMMANDS FROM THE PROGRAMMED COMMAND BUFFER INTO THE * C * REGULAR BUFFER (TEXT) AND CALLS OPTION JUST AS THOUGH * C * THE COMMANDS ARE BEING TYPED IN RATHER THAT GOTTEN * C * FROM AN ARRAY. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BUFFER/ TEXT(30) COMMON /PC CM/ CMNDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL PCMODE, EXMODE COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (P,ALPHA(16)),(BLANK,ALPHA(44)) EXMODE=.TRUE. DO 20 I=1,NCMNDS WRITE(6,30)(CMNDS(I,J),J=1,3) DO 5 J=1,3 IF(CMNDS(I,4-J).NE.BLANK) GO TO 8 5 CONTINUE 8 IF(CMNDS(I,4-J).EQ.P.AND.J.NE.3) WRITE(6,31) (CMNDS(I,J),J=1,3) TEXT(1)=CMNDS(I,1) TEXT(2)=CMNDS(I,2) TEXT(3)=CMNDS(I,3) DO 10 J=4,30 TEXT(J)=BLANK 10 CONTINUE CALL OPTION($20) 20 CONTINUE EXMODE=.FALSE. RETURN 30 FORMAT('?',3R1) 31 FORMAT(1X,'?',3R1) END INTEGER FUNCTION EXPOSE(SIDE) C C ************************************************************ C * * C * THIS SUBROUTINE IS USED TO DETERMINE IF THE KING'S * C * SECTOR HAS BEEN COMPROMISED BY MOVING OR CAPTURING * C * PAWNS IN FRONT OF THE KING. THERE ARE THREE DEGREES OF * C * SAFETY DISCOVERED: * C * 1) A MISSING BISHOP, KNIGHT, OR ROOK PAWN IS THE * C * MOST IMPORTANT. * C * 2) AN ADVANCED BISHOP PAWN IS NEXT. * C * 3) FINALLY, AN ADVANCED KNIGHT PAWN IS LAST. * C * IF ANY OF THESE ARE FOUND, THE SCORE RETURNED IS PENA- * C * LIZED TO REFLECT THE LACK OF SAFETY. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /Q LOC CM/ CQUEEN, HQUEEN COMMON /SAFE CM/ MPAWN, ANPAWN, ABPAWN LOGICAL SIDE, CQUEEN, CKINGM, CROOKR, CROOKL, * HQUEEN, HKINGM, HROOKR, HROOKL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL C C------------------------------< INITIALIZE C EXPOSE=0 IF(SIDE) GO TO 200 100 IF(.NOT. CKINGM) GO TO 9999 IF(CKINGL.GT.30.OR..NOT.HQUEEN) GO TO 9999 PAWN=8 DIR=1 CENTER=33 IF(CKINGL.GT.25) CENTER=38 GO TO 300 200 IF(.NOT. HKINGM) GO TO 9999 IF(HKINGL.LT.90.OR..NOT.CQUEEN) GO TO 9999 PAWN=1 DIR=-1 CENTER=83 IF(HKINGL.GT.95) CENTER=88 C C------------------------------< DETERMINE IF ANY PAWNS ARE MISSING C------------------------------< IN FRONT OF THE CASTLED KING. C 300 START=CENTER-1 END=CENTER+1 DO 400 SQ=START,END IF(BOARD(SQ).EQ.PAWN.OR.BOARD(SQ+DIR*10).EQ.PAWN * .OR.BOARD(SQ+DIR*20).EQ.PAWN) GO TO 400 EXPOSE=EXPOSE-MPAWN 400 CONTINUE CENT=CENTER-1 C C------------------------------< DETERMINE IF THE BISHOP'S OR KNIGHT'S C------------------------------< PAWNS HAVE BEEN ADVANCED IN FRONT C------------------------------< OF THE CASTLED KING. C IF(MOD(CENTER,10).LT.5) CENT=CENTER+1 IF(BOARD(CENTER).NE.PAWN) EXPOSE=EXPOSE-ANPAWN IF(BOARD(CENT).NE.PAWN) EXPOSE=EXPOSE-ABPAWN 9999 RETURN END SUBROUTINE EXTRCT C C ************************************************************ C * * C * EXTRCT TAKES THE COMPRESSED WORD (BUILT BY ENTER) * C * IN 'FROM8' AND BREAKS IT BACK DOWN INTO SEPARATE MOVE * C * PARAMETERS. * C * * C * COMPRESSED DATA FORMAT : * C * * C * SMMM VVVV VVVV VVVV VVTT TTTT TFFF FFFF * C * * C * M => MOVE TYPE (DESCRIBED IN MVMKER) * C * V => PLAUSIBILITY SCORE OF MOVE * C * T => 'TO' OR DESTINATION SQUARE * C * F => 'FROM' OR SOURCE SQUARE * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 IF(FROM8.LT.0) FROM8=FROM8*(-1) TYPE8=FROM8 FROM8=MOD(TYPE8,2**7) TYPE8=TYPE8/2**7 TO8=MOD(TYPE8,2**7) TYPE8=TYPE8/2**7 VALUE8=MOD(TYPE8,2**14)-8000 TYPE8=TYPE8/2**14 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE FCMND C C ************************************************************ C * * C * FCMND PROCESSES THE 'F' COMMAND. THIS IS USED TO * C * FORCE THE COMPUTER TO MAKE THE MOVE ENTERED ON THE NEXT * C * LINE. IF A MOVE HAS ALREADY BEEN MADE BY THE COMPUTER, * C * THAT MOVE WILL BE UNMADE AND THE NEW ONE MADE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BUFFER/ TEXT(30) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /V CM/ VCMOVE COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /NAME CM/ NAME(5) COMMON /HIST CM/ NMOVES, ANNOTE COMMON /TREE/ DUMMY(480),PLY LOGICAL CHECK, SIDE COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)) DATA ZERO /0J/ C C------------------------------< INPUT NEW MOVE TO MAKE C 10 DO 20 I=1,30 TEXT(1)=BLANK 20 CONTINUE WRITE(6,30) 30 FORMAT(1X,'ENTER MY MOVE') READ(5,100)TEXT IF(TEXT(1).EQ.BLANK) RETURN C C------------------------------< IF PROGRAM HAS ALREADY MADE A MOVE, C------------------------------< IT MUST BE 'UNMADE' C PLY=1 FROM8=VCMOVE IF(FROM8.EQ.0) GO TO 50 CALL EXTRCT CALL PUMVER VCMOVE=0 C C------------------------------< CONVERT AND MAKE THE NEW MOVE C 50 CALL INMOVE(1,$10) CALL ENTERD(VCMOVE) CALL PMOVER IF( .NOT. CHECK(SIDE))GOTO 80 WRITE(1@NMOVES) TEXT,ZERO,ZERO RETURN C C------------------------------< CAN'T MAKE A MOVE THAT LEAVES C------------------------------< THE KING IN CHECK C 80 WRITE(6,90)NAME 90 FORMAT(1X,'MY KING IS IN CHECK, ',5A4) GO TO 10 100 FORMAT(30R1) END $CONTROL SEGMENT=PC INTEGER FUNCTION FORK(SQUARE,SIDE) C C ************************************************************ C * * C * FORK IS USED TO DETERMINE IF A MOVE IS A FORKING * C * TYPE OF MOVE (INCLUDES X-RAYS, PINS, ETC.). THIS SUB- * C * ROUTINE LISTS ALL THE OPPONENT'S PIECES A PIECE ON * C * 'SQUARE' ATTACKS. THIS LIST IS SORTED AND THEN * C * SCANNED TO DETERMINE WHAT MIGHT BE LOST OR WON AS A * C * RESULT OF THIS FORKING?? MOVE. THE LIST OF ATTACKED * C * PIECES IS EXAMINED FOR THE FIRST PIECE MORE VALUABLE * C * THAN THE ATTACKING PIECE OR THE FIRST PIECE THAT IS * C * UNDEFENDED IF IT IS LESS VALUABLE. THIS PIECE WILL * C * BE ASSUMED TO BE SAVED. THE REST OF THE LIST IS THEN * C * EXAMINED TO FIND THE NEXT PIECE MORE VALUABLE OR * C * UNDEFENDED. THE SCORE RETURNED IS A) 0 IF NO PIECES * C * FIT THESE RULES; B) THE VALUE OF THE NEXT MOST VALUABLE * C * ATTACKED PIECE IF IT UNDEFENDED; OR C) THE VALUE OF THE * C * NEXT MOST VALUABLE PIECE LESS THE VALUE OF THE * C * ATTACKING PIECE IF IT IS DEFENDED. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /BOARD/ BOARD(120) INTEGER*4 FORKED(16), LOCS(16) LOGICAL SIDE, FIRST FORK=0 APIECE=BOARD(SQUARE) PIECE=MOD(APIECE,7) NUMBER=0 GO TO (100,200,300,400,300,500,999),PIECE C C------------------------------< COUNT THE NUMBER OF PIECES THAT C------------------------------< A PAWN ON 'SQUARE' ATTACKS C 100 LOC=SQUARE+9 IF(SIDE) LOC=SQUARE-11 DO 140 I=1,2 TEMP=BOARD(LOC) IF(SIDE) GO TO 110 GO TO (120,120,120,120,120,120,130, * 130,130,130,130,130,130,130),TEMP 110 GO TO (130,130,130,130,130,130,130, * 120,120,120,120,120,120,130),TEMP 120 NUMBER=NUMBER+1 FORKED(NUMBER)=TEMP LOCS(NUMBER)=LOC 130 LOC=LOC+2 140 CONTINUE GO TO 600 C C------------------------------< COUNT THE NUMBER OF PIECES THAT C------------------------------< A KNIGHT ON 'SQUARE' ATTACKS C 200 DO 230 I=1,8 LOC=SQUARE+KT(I) TEMP=BOARD(LOC) IF(SIDE) GO TO 210 GO TO (220,220,220,220,220,220,230, * 230,230,230,230,230,230,230),TEMP 210 GO TO (230,230,230,230,230,230,230, * 220,220,220,220,220,220,230),TEMP 220 NUMBER=NUMBER+1 FORKED(NUMBER)=TEMP LOCS(NUMBER)=LOC 230 CONTINUE GO TO 600 C C------------------------------< COUNT THE NUMBER OF PIECES THAT C------------------------------< A BISHOP ON 'SQUARE' ATTACKS C 300 DO 340 I=1,4 LOC=SQUARE DIREC=BP(I) 310 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(SIDE) GO TO 320 GO TO (330,330,330,330,330,330,310, * 340,340,340,340,340,340,340),TEMP 320 GO TO (340,340,340,340,340,340,310, * 330,330,330,330,330,330,340),TEMP 330 NUMBER=NUMBER+1 FORKED(NUMBER)=TEMP LOCS(NUMBER)=LOC IF(MOD(TEMP,7).NE.1) GO TO 310 340 CONTINUE IF(PIECE.EQ.3) GO TO 600 C C------------------------------< COUNT THE NUMBER OF PIECES THAT C------------------------------< A ROOK ON 'SQUARE' ATTACKS C 400 DO 440 I=1,4 LOC=SQUARE DIREC=RK(I) 410 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(SIDE) GO TO 420 GO TO (430,430,430,430,430,430,410, * 440,440,440,440,440,440,440),TEMP 420 GO TO (440,440,440,440,440,440,410, * 430,430,430,430,430,430,440),TEMP 430 NUMBER=NUMBER+1 FORKED(NUMBER)=TEMP LOCS(NUMBER)=LOC IF(MOD(TEMP,7).NE.1) GO TO 410 440 CONTINUE GO TO 600 C C------------------------------< COUNT THE NUMBER OF PIECES THAT C------------------------------< A KING ON 'SQUARE' ATTACKS C 500 DO 530 I=1,8 LOC=SQUARE+KG(I) TEMP=BOARD(LOC) IF(SIDE) GO TO 510 GO TO (520,520,520,520,520,520,530, * 530,530,530,530,530,530,530),TEMP 510 GO TO (530,530,530,530,530,530,530, * 520,520,520,520,520,520,530),TEMP 520 NUMBER=NUMBER+1 FORKED(NUMBER)=TEMP LOCS(NUMBER)=LOC 530 CONTINUE C C------------------------------< NOW SORT THE LIST OF FORKED PIECES C------------------------------< SO THAT THE SCORE WILL REFLECT THE C------------------------------< LOSS OF THE SECOND BEST ONE. C 600 IF(NUMBER.LE.1) GO TO 999 I1=NUMBER-1 DO 750 I=1,I1 J1=I+1 DO 700 J=J1,NUMBER IF(FORKED(I).GE.FORKED(J)) GO TO 700 T=FORKED(I) FORKED(I)=FORKED(J) FORKED(J)=T T=LOCS(I) LOCS(I)=LOCS(J) LOCS(J)=T 700 CONTINUE 750 CONTINUE C C------------------------------< NOW SCAN THE LIST OF FORKED PIECES TO C------------------------------< DETERMINE WHAT CAN BE CAPTURED AND C------------------------------< WHAT THE GAIN WILL BE C FIRST=.TRUE. DO 800 I=1,NUMBER SCORE=0 IF(MOD(FORKED(I),7).EQ.6) GO TO 760 SCORE=MINATK(LOCS(I),SIDE,NUMATK) 760 ATK SC=PVALUE(FORKED(I))-PVALUE(APIECE) IF(SCORE.GT.0.AND.ATKSC.LE.0) GO TO 800 C C------------------------------< THIS PIECE IS ATTACKED AND NOT DEFENDED C------------------------------< OR IS ATTACKED, DEFENDED BUT IS WORTH C------------------------------< MORE THAN THE ATTACKING PIECE. IF THIS C------------------------------< IS THE FIRST SUCH PIECE FOUND, ASSUME I C------------------------------< WILL BE SAVED AND FIND THE NEXT ONE. C 775 IF(.NOT. FIRST) GO TO 850 FIRST=.FALSE. 800 CONTINUE C C------------------------------< NOTHING IS SUBJECT TO CAPTURE, RETURN C GO TO 999 C C------------------------------< A PIECE IS SUBJECT TO CAPTURE, SCORE C------------------------------< IS EITHER THE VALUE OF THE PIECE IF C------------------------------< IT IS UNDEFENDED, OR THE VALUE OF THE C------------------------------< PIECE LESS THE VALUE OF THE CAPTURING C------------------------------< PIECE IF IT IS DEFENDED C 850 FORK=PVALUE(FORKED(I)) IF(SCORE.GT.0) FORK=FORK-PVALUE(BOARD(SQUARE)) 999 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE HCMND(DEVICE) C C ************************************************************ C * * C * HCMND PROCESSES THE 'H' COMMAND. THIS LISTS THE * C * GAME HISTORY OF ALL MOVES MADE BY BOTH SIDES. OUTPUT * C * MAY BE SENT TO THE LINE PRINTER OR USER TERMINAL. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /HIST CM/ NMOVES, ANNOTE COMMON /TREE/ TREE(400),DMY(81) COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR INTEGER*4 BUF1(30),BUF2(30) EQUIVALENCE (BUF1(1),TREE(100)),(BUF2(1),TREE(200)) INTEGER*4 ATEXT(31),DORMAT(19),DIGITS(20),LIM(5) EQUIVALENCE (ATEXT(1),TREE(300)) COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (PERIOD,ALPHA(42)),(BLANK,ALPHA(44)) DATA DORMAT/%"(1X,"J,%" I2,"J,%" 1X,"J,%""J,%"R1, "J,%" 1X,"J, *%"""(""I"J,%""J,%""")"","J,%"T25,"J,%""J,%"R1, "J,%" 1X,"J, *%"""(""I"J,%" "J,%""")"" "J,%"T40,"J,%"31R1"J,%") "J/ DATA DIGITS/%" 1"J,%" 2"J,%" 3"J,%" 4"J,%" 5"J, *%" 6"J,%" 7"J,%" 8"J,%" 9"J,%" 10"J,%" 11"J, *%" 12"J,%" 13"J,%" 14"J,%" 15"J,%" 16"J,%" 17"J,%" 18"J, *%" 19"J,%" 20"J/ DATA LIM/-1J,9J,99J,999J,9999J/ M=0 I=0 C C------------------------------< OUTPUT HEADING C IF(COLOR.EQ.0) WRITE(DEVICE,100) IF(COLOR.EQ.1) WRITE(DEVICE,200) 100 FORMAT(5X,'WHITE',15X,'BLACK+') 200 FORMAT(5X,'WHITE+',14X,'BLACK') 300 DO 400 J=1,8 BUF2(J)=PERIOD 400 CONTINUE DO 500 J=9,30 BUF2(J)=BLANK 500 CONTINUE DO 550 J=1,32 ATEXT(J)=BLANK 550 CONTINUE C C------------------------------< READ MOVES FROM HISTORY FILE C ELAP2=0 I=I+1 IF(I.GT.NMOVES) GO TO 800 READ(1@I)BUF1,ELAP1,NOTATE I=I+1 IF(I.GT.NMOVES) GO TO 600 READ(1@I)BUF2,ELAP2,DUMMY IF(DUMMY.NE.0) NOTATE=DUMMY 600 M=M+1 C C------------------------------< SET UP VARIABLE FORMAT TO OUTPUT C------------------------------< '(MOVETIME)' C DO 620 J=1,5 IF(ELAP1.GT.LIM(J)) W1=J IF(ELAP2.GT.LIM(J)) W2=J 620 CONTINUE DO 650 J=1,19 IF(BUF1(20-J).NE.BLANK) GO TO 675 650 CONTINUE 675 END1=20-J DORMAT(4)=DIGITS(END1) DORMAT(8)=DIGITS(W1) DO 680 J=1,19 IF(BUF2(20-J).NE.BLANK) GO TO 685 680 CONTINUE 685 END2=20-J DORMAT(11)=DIGITS(END2) DORMAT(15)=DIGITS(W2) IF(NOTATE.NE.0) READ(1@NOTATE)ATEXT, NOTATE WRITE(DEVICE,DORMAT)M,(BUF1(J),J=1,END1),ELAP1, * (BUF2(J),J=1,END2),ELAP2, * ATEXT C C------------------------------< READ AND OUTPUT ANNOTATION FOR MOVE C 690 IF(NOTATE.EQ.0) GO TO 300 READ(1@NOTATE) ATEXT,NOTATE WRITE(DEVICE,900) ATEXT GO TO 690 900 FORMAT(T45,31R1) C GO TO 300 800 RETURN END $CONTROL SEGMENT=IOMV SUBROUTINE INMOVE(PLAY8,*) C C ************************************************************ C * * C * INMOVE IS USED TO TRANSLATE ALL CHESS MOVES FROM * C * TEXT STRINGS TO THE INTERNAL FORM USED BY THE PROGRAM. * C * THIS IS DONE BY GENERATING ALL LEGAL MOVES FOR THE SIDE * C * INPUTTING THE MOVE AND THEN USING THAT DATA INPUT TO * C * ELIMINATE ALL INCORRECT MOVES. ENOUGH DATA MUST BE IN- * C * PUT TO FULLY REMOVE ALL AMBIGUITIES. USUALLY A SIMPLE * C * PXP WILL DO FOR 'PAWN TAKES PAWN', SOMETIMES P/KR5XP * C * WILL BE REQUIRED. XB WILL BE ACCEPTED TO 'TAKE THE * C * BISHOP' IF ONLY ONE METHOD OF CAPTURE IS POSSIBLE. AM- * C * BIGUOUS, ILLEGAL, AND SYNTACTICAL MOVE ERRORS ARE DE- * C * TECTED AND IGNORED AFTER APPROPRIATE DIAGNOSTICS ARE * C * PRINTED. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /TREE/ TREE(400),START(10),STOP(10),DUM1(20), *FROMX(10),TOX(10),DUM2(20),PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 INTEGER*4 PIECES(6),FILES(5) INTEGER*4 FROM(100),TO(100),FPIECE(100),TPIECE(100) EQUIVALENCE (FROM(1),TREE(60)),(TO(1),TREE(120)), *(FPIECE(1),TREE(180)),(TPIECE(1),TREE(240)) COMMON /BUFFER/ TEXT(30) COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /V CM/ VCMOVE INTEGER*4 DIGITS(10) LOGICAL EP,PNPROM COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (MINUS,ALPHA(38)),(EQUAL,ALPHA(41)), *(SLASH,ALPHA(39)),(ZERO,ALPHA(27)),(NINE,ALPHA(36)), *(ALPHAO,ALPHA(15)),(ALPHAP,ALPHA(16)),(ALPHAX,ALPHA(24)), *(ALPHAE,ALPHA(5)),(BLANK,ALPHA(44)),(DIGITS(1),ALPHA(28)) DATA FILES/%"R"J,%"N"J,%"B"J,%"Q"J,%"K"J/,PIECES/%"P"J,%"N"J, *%"B"J,%"R"J,%"Q"J,%"K"J/ MTYPE=NORMAL ICOL=1 IF(COLOR)2,3,2 2 FILES(4)=PIECES(6) FILES(5)=PIECES(5) 3 ORANK=0 OFILE=0 OFILEQ=0 DRANK=0 DFILE=0 DFILEQ=0 PIECE=0 CPIECE=0 PPIECE=5 FROMSQ=0 TOSQ=0 EP=.FALSE. PNPROM=.FALSE. C C----------------------------------------< GENERATE ALL LEGAL MOVES C----------------------------------------< AND LOAD FOR ELIMINATION C PLAYER=MOD(PLAY8,2) 28 FROM8=VCMOVE CALL EXTRCT FROMX(1)=FROM8 TOX(1)=TO8 TEMP=PLY PLY=2-PLAYER TEMP1=WIDTH(2-PLAYER) WIDTH(2-PLAYER)=999 START(2-PLAYER)=1 IF(2-PLAYER.GT.1)STOP(2-PLAYER-1)=0 CALL PREANL CALL MOVGEN PLY=TEMP WIDTH(2-PLAYER)=TEMP1 ISTOP=STOP(2-PLAYER) DO 155 I=1,ISTOP FROM8=TREE(I) CALL EXTRCT FROM(I)=FROM8 TO(I)=TO8 FPIECE(I)=BOARD(FROM8) TPIECE(I)=BOARD(TO8) 155 CONTINUE IF(TEXT(1).EQ.ALPHAO) GO TO30 C C----------------------------------------< PROCESS 'FROM' SQUARE AND PIE C DO 351 I=1,4 IF(TEXT(I).EQ.SLASH) GO TO 361 IF(TEXT(I).EQ.MINUS) GO TO 361 IF(TEXT(I).EQ.ALPHAX) GO TO 361 351 CONTINUE GO TO 103 361 IF(I.LT.4) GO TO 371 OFILEQ=TEXT(1) OFILE=TEXT(2) ICOL=3 GO TO 38 371 IF(I.LT.3) GO TO 38 OFILEQ=TEXT(1) IF(TEXT(2).NE.ALPHAP) GO TO 4463 OFILE=OFILEQ OFILEQ=0 4463 ICOL=2 38 IF(I.LT.2) GO TO 385 PIECE=TEXT(ICOL) ICOL=ICOL+1 IF(TEXT(ICOL).NE.SLASH) GO TO 385 ICOL=ICOL+1 DO 381 I=1,4 IF(TEXT(ICOL-1+I).EQ.MINUS) GO TO 382 IF(TEXT(ICOL-1+I).EQ.ALPHAX) GO TO 382 381 CONTINUE GO TO 103 382 IF(I.LT.4) GO TO 383 OFILEQ=TEXT(ICOL) OFILE=TEXT(ICOL+1) ORANK=TEXT(ICOL+2) ICOL=ICOL+3 GO TO 385 383 IF(I.LT.3) GO TO 384 OFILE=TEXT(ICOL) ORANK=TEXT(ICOL+1) ICOL=ICOL+2 GO TO 385 384 IF(I.LT.2) GO TO 103 ORANK=TEXT(ICOL) ICOL=ICOL+1 IF(ORANK.GE.ZERO.AND.ORANK.LE.NINE) GO TO 385 OFILE=ORANK ORANK=0 385 STYPE=TEXT(ICOL) ICOL=ICOL+1 IF(STYPE.EQ.MINUS) GO TO 5 IF(STYPE.NE.MINUS.AND.STYPE.NE.ALPHAX) GO TO 103 C C----------------------------------------< PROCESS 'TO' SQUARE AND PIECE C DO 45 I=1,4 IF(TEXT(ICOL-1+I).EQ.SLASH) GO TO 46 IF(TEXT(ICOL-1+I).EQ.BLANK) GO TO 46 45 CONTINUE GO TO 103 46 IF(I.LT.4) GO TO 47 DFILEQ=TEXT(ICOL) DFILE=TEXT(ICOL+1) ICOL=ICOL+2 GO TO 50 47 IF(I.LT.3) GO TO 50 IF(TEXT(ICOL-1+I).EQ.EQUAL) GO TO 46 DFILEQ=TEXT(ICOL) IF(TEXT(ICOL+1).NE.ALPHAP) GO TO 4464 DFILE=DFILEQ DFILEQ=0 4464 ICOL=ICOL+1 50 IF(I.LT.2) GO TO 6 CPIECE=TEXT(ICOL) ICOL=ICOL+1 IF(TEXT(ICOL).NE.SLASH) GO TO 6 ICOL=ICOL+1 5 DO 581 I=1,4 IF(TEXT(ICOL-1+I).EQ.BLANK) GO TO 582 IF(TEXT(ICOL-1+I).EQ.EQUAL) GO TO 582 581 CONTINUE GO TO 103 582 IF(I.LT.4) GO TO 583 DFILEQ=TEXT(ICOL) DFILE=TEXT(ICOL+1) DRANK=TEXT(ICOL+2) ICOL=ICOL+3 GO TO 585 583 IF(I.LT.3) GO TO 584 DFILE=TEXT(ICOL) DRANK=TEXT(ICOL+1) ICOL=ICOL+2 GO TO 585 584 IF(I.LT.2) GO TO 103 DRANK=TEXT(ICOL) ICOL=ICOL+1 IF(DRANK.GE.ZERO.AND.DRANK.LE.NINE) GO TO 585 DFILE=DRANK DRANK=0 585 IF(TEXT(ICOL).NE.EQUAL) GO TO 6 PPIECE=TEXT(ICOL+1) PNPROM=.TRUE. ICOL=ICOL+2 6 IF(TEXT(ICOL).NE.BLANK) GO TO 103 IF(TEXT(ICOL+1).EQ.ALPHAE) EP=.TRUE. 6645 IF(OFILE.EQ.PIECES(6).OR.OFILE.EQ.PIECES(5)) OFILEQ=OFILE IF(DFILE.EQ.PIECES(6).OR.DFILE.EQ.PIECES(5)) DFILEQ=DFILE C C----------------------------------------< CONVERT CHARACTER STRINGS TO C----------------------------------------< INTEGERS FOR PROCESSING C DO 7 I=1,8 IF(ORANK.EQ.DIGITS(I)) ORANK=I+2 IF(DRANK.EQ.DIGITS(I)) DRANK=I+2 7 CONTINUE IF(DRANK.LT.0.OR.ORANK.LT.0) GO TO 103 IF(EP.AND.DRANK.NE.0) DRANK=DRANK+1 IF(PLAYER.EQ.0.AND.ORANK.NE.0) ORANK=13-ORANK IF(PLAYER.EQ.0.AND.DRANK.NE.0) DRANK=13-DRANK DO 8 I=1,5 IF(OFILEQ.EQ.FILES(I)) OFILEQ=I+1 IF(DFILEQ.EQ.FILES(I)) DFILEQ=I+1 IF(OFILE.EQ.FILES(I)) OFILE=I+1 IF(DFILE.EQ.FILES(I)) DFILE=I+1 8 CONTINUE IF(DFILE.LT.0.OR.OFILE.LT.0) GO TO 103 IF(DFILEQ.LT.0.OR.OFILEQ.LT.0) GO TO 103 DO 9 I=1,6 IF(PPIECE.EQ.PIECES(I)) PPIECE=I IF(CPIECE.EQ.PIECES(I)) CPIECE=I IF(PIECE.EQ.PIECES(I)) PIECE=I 9 CONTINUE IF(PIECE.LT.0.OR.PIECE.GT.6) GO TO 103 IF(CPIECE.LT.0.OR.CPIECE.GT.6) GO TO 103 IF(PPIECE.LT.0.OR.PPIECE.GT.6) GO TO 103 IF(PIECE.GT.0) PIECE=PIECE+7*PLAYER IF(PPIECE.GT.0) PPIECE=PPIECE+7*PLAYER IF(CPIECE.GT.0) CPIECE=CPIECE+7-7*PLAYER C C----------------------------------------< ELIMINATE CASTLING MOVES, C----------------------------------------< EN PASSANT, PROMOTION, ETC. C DO 10 I=1,ISTOP FROM8=TREE(I) CALL EXTRCT IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) FROM(I)=0 IF(EP.AND.TYPE8.NE.ENPASS) FROM(I)=0 IF(STYPE.EQ.ALPHAX.AND.TYPE8.EQ.ENPASS) TPIECE(I)=8-7*PLAYER IF(PNPROM.AND.TYPE8.NE.PROMOTE) FROM(I)=0 10 CONTINUE C C----------------------------------------< ELIMINATE ALL MOVES EXCEPT C----------------------------------------< MOVES OF CORRECT PIECE C DO 12 I=1,ISTOP IF(PIECE.NE.FPIECE(I).AND.PIECE.GT.0) FROM(I)=0 IF(STYPE.NE.ALPHAX) GO TO 11 IF(TPIECE(I).EQ.7) FROM(I)=0 IF(CPIECE.NE.TPIECE(I).AND.CPIECE.NE.0) FROM(I)=0 GO TO 12 11 IF(TPIECE(I).NE.7) FROM(I)=0 12 CONTINUE C C----------------------------------------< ELIMINATE ALL MOVES EXCEPT C----------------------------------------< MOVES ON CORRECT SIDE OF BOAR C DO 14 I=1,ISTOP IF(OFILEQ.EQ.0) GO TO 13 T=6-MOD((FROM(I)-1)/5+1,2) IF(T.NE.OFILEQ) FROM(I)=0 13 IF(DFILEQ.EQ.0) GO TO 14 T=6-MOD((TO(I)-1)/5+1,2) IF(T.NE.DFILEQ) FROM(I)=0 14 CONTINUE C C----------------------------------------< ELIMINATE ALL MOVES EXCEPT C----------------------------------------< MOVES ON CORRECT FILES C DO 16 I=1,ISTOP IF(OFILE.EQ.0) GO TO 15 T=MOD(FROM(I)-1,10)+1 IF(T.NE.OFILE.AND.T.NE.11-OFILE) FROM(I)=0 15 IF(DFILE.EQ.0) GO TO 16 T=MOD(TO(I)-1,10)+1 IF(T.NE.DFILE.AND.T.NE.11-DFILE) FROM(I)=0 16 CONTINUE C C----------------------------------------< ELIMINATE ALL MOVES EXCEPT C----------------------------------------< MOVES ON CORRECT RANK C DO 18 I=1,ISTOP IF(ORANK.EQ.0) GO TO 17 T=(FROM(I)-1)/10+1 IF(T.NE.ORANK) FROM(I)=0 17 IF(DRANK.EQ.0) GO TO 18 T=(TO(I)-1)/10+1 IF(T.NE.DRANK) FROM(I)=0 18 CONTINUE C C----------------------------------------< CHECK TO MAKE SURE ONLY C----------------------------------------< ONE MOVE IS LEFT IN TREE C IC=0 DO 19 I=1,ISTOP IF(FROM(I).EQ.0) GO TO 19 IC=IC+1 IMOVE=I 19 CONTINUE IF(IC.GT.1) GO TO 101 IF(IC.EQ.0) GO TO 102 FROM8=TREE(IMOVE) CALL EXTRCT VALUE8=PPIECE RETURN C C----------------------------------------< CHECK CASTLING MOVES C 30 DO 301 I=1,30 IF(TEXT(2).NE.MINUS.OR.TEXT(3).NE.ALPHAO) GO TO 102 301 CONTINUE IF(TEXT(4).NE.BLANK) GO TO 35 IF(PLAYER) 31,34,31 31 IF(COLOR) 32,33,32 32 TYPEMV=CASTRT GO TO 36 33 TYPEMV=CASTLF GO TO 36 34 IF(COLOR) 33,32,33 35 IF(TEXT(4).NE.MINUS.OR.TEXT(5).NE.ALPHAO) GO TO 102 IF(PLAYER) 34,31,34 36 DO 37 I=1,ISTOP FROM8=TREE(I) CALL EXTRCT IF(TYPEMV.EQ.TYPE8) RETURN 37 CONTINUE GO TO 102 C C----------------------------------------< ERROR MESSAGES C 101 WRITE(6,201) 201 FORMAT(1X,'AMBIGUOUS MOVE') RETURN 1 102 WRITE(6,202) 202 FORMAT(1X,'ILLEGAL MOVE') RETURN 1 103 WRITE(6,203) 203 FORMAT(1X,'UNRECOGNIZABLE MOVE') RETURN 1 END SUBROUTINE INPUT(VALUE) C C ************************************************************ C * * C * INPUT IS A FUNCTION USED TO INPUT INTEGER*4 VALUES * C * FROM THE USER TERMINAL. THE DATA IS INPUT ON AN A FOR- * C * MAT AND TRANSLATED SO THAT 'I2' AND 'I3' TYPE FORMATS * C * ARE NOT USED. THIS ALLOWS THE NUMBERS TO BE INPUT ON A * C * FREE FORMAT WITH LEADING BLANKS AND ZEROES IF DESIRED * C * WITHOUT HAVING TO REMEMBER HOW MANY DIGITS TO TYPE IN * C * FOR THIS PARTICULAR OPTION. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /CHRSET/ ALPHA(44) INTEGER*4 DIGITS(10) EQUIVALENCE (DIGITS(1),ALPHA(27)),(MINUS,ALPHA(38)), *(PLUS,ALPHA(37)),(BLANK,ALPHA(44)) COMMON /TREE/ ARRAY(481) INTEGER*4 TEXT(72) EQUIVALENCE (TEXT(1),ARRAY(200)) 100 VALUE=0 SIGN=1 READ(5,200,END=999)TEXT 200 FORMAT(72R1) DO 600 I=1,72 IF(TEXT(I).EQ.BLANK) GO TO 600 DO 300 J=1,10 IF(TEXT(I).EQ.DIGITS(J)) GO TO 500 300 CONTINUE IF(TEXT(I).EQ.PLUS) SIGN=1 IF(TEXT(I).EQ.MINUS) SIGN=-1 IF(TEXT(I).EQ.PLUS.OR.TEXT(I).EQ.MINUS) GO TO 600 WRITE(6,400) 400 FORMAT(1X,'ILLEGAL NUMERIC INPUT - TRY AGAIN') GO TO 100 500 VALUE=VALUE*10+J-1 600 CONTINUE VALUE=VALUE*SIGN 999 RETURN END LOGICAL FUNCTION ISOLAT(SQUARE,SIDE) C C ************************************************************ C * * C * ISOLAT IS USED TO DETERMINE IF A PAWN IS ISOLATED. * C * IT CHECKS TO SEE IF THERE ARE ANY FRIENDLY PAWNS ON * C * ADJACENT FILES TO SUPPORT THE ONE ON 'SQUARE'. IF NOT, * C * ISOLAT IS SET TO TRUE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC LOGICAL SIDE ISOLAT=.FALSE. C C------------------------------< DETERMINE VALUE OF FRIENDLY PAWNS C IF(SIDE) GO TO 200 100 FPAWN=8 GO TO 300 200 FPAWN=1 C C------------------------------< CHECK TO SEE IF THE PAWN IS ISOLATED C------------------------------< BY SCANNING ADJACENT FILES FOR THE C------------------------------< PRESENCE OF FRIENDLY PAWNS. C 300 SQ=MOD(SQUARE,10)+20 400 SQ=SQ+10 IF(BOARD(SQ-1).EQ.FPAWN) GO TO 500 IF(BOARD(SQ+1).EQ.FPAWN) GO TO 500 IF(SQ.LT.80) GO TO 400 C C------------------------------< PAWN IS ISOLATED, RETURN 'TRUE' C ISOLAT=.TRUE. 500 RETURN END $CONTROL SEGMENT=PC SUBROUTINE KING C C ************************************************************ C * * C * KING GENERATES ALL KING MOVES. SUBROUTINE SCORE IS * C * CALLED TO COMPUTE THE PLAUSIBILITY SCORE FOR THE MOVE, * C * AFTER WHICH THE MOVE IS ENTERED IN THE MOVE LIST. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE LOGICAL SIDE, CHECK 1000 DO 1020 I=1,8 TO8=FROM8+KG(I) TOSQ=BOARD(TO8) TYPE8=NORMAL IF(SIDE.AND.TOSQ.LT.7) GO TO 1020 IF(.NOT.SIDE.AND.TOSQ.GT.7) GO TO 1020 IF(TOSQ.EQ.14) GO TO 1020 BOARD(TO8)=FROMSQ IF(SIDE) HKINGL=TO8 IF(.NOT.SIDE) CKINGL=TO8 IF(CHECK(SIDE)) GO TO 1010 CALL SCORE CALL ENTER 1010 BOARD(TO8)=TOSQ 1020 CONTINUE IF(SIDE) HKINGL=FROM8 IF(.NOT.SIDE) CKINGL=FROM8 RETURN END $CONTROL SEGMENT=PC SUBROUTINE KNIGHT C C ************************************************************ C * * C * KNIGHT GENERATES ALL KNIGHT MOVES. SUBROUTINE * C * SCORE IS CALLED TO COMPUTE THE PLAUSIBILITY SCORE FOR * C * THE MOVE, AFTER WHICH THE MOVE IS ENTERED IN THE MOVE * C * LIST. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE LOGICAL SIDE, CHECK 1000 BOARD(FROM8)=7 DO 1020 I=1,8 TO8=FROM8+KT(I) TOSQ=BOARD(TO8) TYPE8=NORMAL IF(SIDE.AND.TOSQ.LT.7) GO TO 1020 IF(.NOT.SIDE.AND.TOSQ.GT.7) GO TO 1020 IF(TOSQ.EQ.14) GO TO 1020 BOARD(TO8)=FROMSQ IF(CHECK(SIDE)) GO TO 1010 CALL SCORE CALL ENTER 1010 BOARD(TO8)=TOSQ 1020 CONTINUE RETURN END INTEGER FUNCTION KSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * KSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR KING MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE KING CONTROL BOARD FOR THE SIDE TO MOVE. (CKSCOR, * C * HKSCOR IN COMMON BLOCK 'K BD SM'). * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /K BD SM/ CKSCOR(100), HKSCOR(100) LOGICAL SIDE IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 KSCORE=CKSCOR(SQUARE) RETURN C C==============================< HUMAN SCORING C 200 KSCORE=HKSCOR(SQUARE) RETURN END $CONTROL SEGMENT=CMND SUBROUTINE LMCMND(DEVICE) C C ************************************************************ C * * C * LMCMND IS USED TO PROCESS THE 'LM' COMMAND WHICH * C * IS USED TO DUMP OUT ALL LEGAL MOVES FOR EITHER SIDE. * C * IF THE COMPUTER MOVES ARE DESIRED, THE LAST MOVE IS * C * TEMPORARILY 'UN-MADE' AND ALL LEGAL MOVES ARE THEN * C * LISTED. IF THE OUTPUT IS DIRECTED TO THE LINE PRINTER, * C * THE MOVES ARE ALWAYS FOR THE COMPUTER AND NO CHOICE IS * C * GIVEN. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /BUFFER/ TEXT(30) COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 C COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /ORDR CM/ VAL(100) COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /V CM/ VCMOVE COMMON /P V MOVE/ PVMOVE, OVMOVE COMMON /PC CM/ CMNDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL PCMODE, EXMODE C C------------------------------< INITIALIZE C FROM8=VCMOVE CALL EXTRCT TO(1)=TO8 FROM(1)=FROM8 TYPE(1)=TYPE8 START(2)=1 PLY=1 70 FORMAT(1X,'SIMPLE',2X,'COMPLEX',3X,'MOVE') IF(EXMODE) GO TO 50 1 WRITE(DEVICE,30) CALL INPUT(PLY) IF(PLY.EQ.0) RETURN IF(PLY.EQ.1) GO TO 50 5 WRITE(DEVICE,70) C C------------------------------< GENERATE ALL LEGAL MOVES C CALL PREANL TEMP=PVMOVE PVMOVE=OVMOVE CALL MOVGEN PVMOVE=TEMP C C------------------------------< OUTPUT THE MOVE LIST C N=START(PLY+1)-START(PLY) DO 10 I=1,N FROM8=TREE(I) CALL EXTRCT CALL OUTMOV(FROM8,TO8,TYPE8,0,PLY,BOARD) WRITE(DEVICE,20) VALUE8, VAL(I), TEXT 20 FORMAT(1X,I6,2X,I6,2X,30R1) IF(I.EQ.STOP(PLY)) WRITE(DEVICE,15) 10 CONTINUE 15 FORMAT(1X,27('-')) IF(PLY.EQ.1) GO TO 60 RETURN 30 FORMAT(1X,'FOR WHICH SIDE? (ME=1, YOU=2)') C 40 FORMAT(I) C C------------------------------< UNMAKE PROGRAM'S LAST MOVE TO C------------------------------< LIST ALL OF THE PROGRAM'S LEGAL C------------------------------< MOVES. C 50 FROM8=VCMOVE IF(FROM8.EQ.0) GO TO 5 CALL EXTRCT CALL PUMVER GO TO 5 60 FROM8=VCMOVE IF(FROM8.EQ.0) RETURN CALL EXTRCT CALL PMOVER RETURN END SUBROUTINE LOCATE C C ************************************************************ C * * C * LOCATE IS USED TO LOCATE ANY PIECES NECESSARY BE- * C * FORE STARTING THE SEARCH. THE KINGS ARE FOUND SO THAT * C * CHECK WILL NOT HAVE TO LOCATE THEM EACH TIME IT IS * C * CALLED; QUEENS, BISHOPS, ETC. ARE LOCATED AND ACCOUNTED * C * FOR FOR LATER REFERENCE. THIS IS DONE BECAUSE IT IS * C * CHEAPER IN TERMS OF TIME TO LOCATE EVERYTHING ONCE AND * C * KEEP UP WITH WHEN IT IS MOVED, THAN TO LOCATE SOMETHING * C * WHEN IT'S PRESENCE OR ABSENCE IS IMPORTANT. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /Q LOC CM/ CQUEEN, HQUEEN COMMON /R LOC CM/ ONECRK, ONEHRK COMMON /B LOC CM/ ONECBP, ONEHBP LOGICAL CQUEEN, HQUEEN, ONECRK, ONEHRK, ONECBP, ONEHBP CQUEEN=.FALSE. HQUEEN=.FALSE. ONECRK=.FALSE. ONEHRK=.FALSE. ONECBP=.FALSE. ONEHBP=.FALSE. NCR=0 NHR=0 NCB=0 NHB=0 C C------------------------------< LOCATE ALL PIECES C DO 10 I=22,99 IF(BOARD(I).EQ.6) HKINGL=I IF(BOARD(I).EQ.13) CKINGL=I IF(BOARD(I).EQ.3) NHB=NHB+1 IF(BOARD(I).EQ.4) NHR=NHR+1 IF(BOARD(I).EQ.5) HQUEEN=.TRUE. IF(BOARD(I).EQ.10) NCB=NCB+1 IF(BOARD(I).EQ.11) NCR=NCR+1 IF(BOARD(I).EQ.12) CQUEEN=.TRUE. 10 CONTINUE IF(NCB.NE.2) ONECBP=.TRUE. IF(NHB.NE.2) ONEHBP=.TRUE. IF(NCR.NE.2) ONECRK=.TRUE. IF(NHR.NE.2) ONEHRK=.TRUE. RETURN END $CONTROL SEGMENT=LK SUBROUTINE LOOK C C ************************************************************ C * * C * LOOK IS THE MAIN DRIVER FOR THE CHESS TREE SEARCH. * C * IT USES THE MINIMAX SEARCH WITH ALPHA/BETA PRUNING AS * C * DESCRIBED BY CLAUDE SHANNON'S TYPE A SEARCH STRATEGY. * C * BASICALLY, IN DOING A DEPTH FIRST SEARCH, LOOK GEN- * C * ERATES ALL LEGAL MOVES AND MAKES THEM ONE AT A TIME AS * C * IT ADVANCES TO THE NEXT DEEPER LEVEL. IF A CHECK- * C * MATE IS FOUND, THAT MOVE IS IMMEDIATELY SELECTED FOR * C * THAT LEVEL AND BACKED UP. * C * THE COMPUTER WILL AVOID DRAWS AT ANY LEVEL IN THE * C * TREE. IT WILL REMEMBER AN IMMEDIATE DRAWING MOVE AND * C * AFTER COMPLETING THE SEARCH WILL DETERMINE IF IT'S * C * POSITION IS BAD ENOUGH TO WARRANT DRAWING THE GAME. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /MSCORE/ SCORE COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 LOGICAL CHECK, DRAW,SIDE COMMON /TRACE/ TRACE(20,10),TFLAG COMMON /DUP/ PACK(8),POINT,BDSAVE(30,8) COMMON /BUFFER/ TEXT(30) COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /TIME CM/ TIM LIM, MAX TIM COMMON /MOV TIM/ MELAP, MSEC1, MSEC2 COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG INTEGER*4 TAB(10),FMT(9) DATA TAB/%" 10"J,%" 20"J,%" 30"J,%" 40"J,%" 50"J,%" 60"J, 1%" 70"J,%" 80"J,%" 90"J,%" 100"J/, 2FMT/%" (T"J,%""J,%",15A"J,%"1,2X"J,%",I5,"J, 3%" 2X,"J,%"""*"","J,%" I6,"J,%"""*"")"J/ NTERM=0 NGEN=0 TERM=0 MAXPLY=0 CMOVE=0 SMOVE=0 PLY=0 SIDE=.TRUE. DO 4444 I=1,20 DO 4445 J=1,10 TRACE(I,J)=0 4445 CONTINUE 4444 CONTINUE DO 3002 I=1,10 NODES(I)=0 3002 CONTINUE C C------------------------------< ADJUST SEARCH PARAMETERS BASED ON C------------------------------< THE AMOUNT OF TIME REMAINING ON C------------------------------< THE CHESS CLOCK. C CALL ADJUST MAX TIM=TIM LIM + MSEC1 IF(LOOK AH) MAX TIM = 900 + MSEC1 C C------------------------------< RECURSE TO MAXIMUM DEPTH C 1 PLY=PLY+1 SIDE=.NOT. SIDE SIGN=-1 IF(SIDE) SIGN=1 BACKUP(PLY)=SIGN*(10000-PLY) CALL MOVGEN WHICH(PLY)=START(PLY)-1 IF(STOP(PLY).LT.START(PLY)) GO TO 15 2 IF(PLY.GT.1) GO TO 2000 IF(STOP(1).GT.1) GO TO 2002 CMOVE=TREE(1) GO TO 18 2002 IF(LOOK AH .AND. .NOT.MTCHED) GO TO 2000 CALL CTIME(TEST) IF(TEST.LT.MAX TIM) GO TO 2000 WRITE(6,2001) 2001 FORMAT(1X,'MAXIMUM MOVE TIME REACHED') GO TO 9 2000 WHICH(PLY)=WHICH(PLY)+1 IF(WHICH(PLY).GT.STOP(PLY)) GO TO 9 FROM8=TREE(WHICH(PLY)) CALL EXTRCT TO(PLY)=TO8 FROM(PLY)=FROM8 TYPE(PLY)=TYPE8 VALUE(PLY)=VALUE8 IF(PLY.GT.TFLAG) GO TO 203 CALL OUTMOV(FROM8,TO8,TYPE8,0,PLY,BOARD) FMT(2)=TAB(PLY) IF(PLY.LT.DEPTH) WRITE(6,FMT)(TEXT(IX),IX=1,15),VALUE8,BACKUP(PLY) 203 CONTINUE CALL MOVER NODES(PLY)=NODES(PLY)+1 IF(PLY.NE.1) GO TO 3 C C------------------------------< CHECK FOR REPITITION OF MOVES C CALL COMPRS D=0 DO 202 I=1,30 DO 201 J=1,8 IF(BDSAVE(I,J).NE.PACK(J)) GO TO 202 201 CONTINUE D=D+1 202 CONTINUE IF(D.NE.2) GO TO 3 SMOVE=TREE(WHICH(1))*(-1) CALL UMOVER GO TO 2 3 IF(PLY.LT.DEPTH) GO TO 1 C C------------------------------< TERMINAL NODE, SCORE VARIATION C CALL TSCORE IF(PLY.LE.TFLAG) WRITE(6,FMT)(TEXT(IX),IX=1,15),VALUE8,SCORE CALL UMOVER IF(SIDE) GO TO 5 4 IF(SCORE.LE.BACKUP(PLY)) GO TO 2 IF(SCORE.GE.BACKUP(PLY-1)) GO TO 8 GO TO 6 5 IF(SCORE.GE.BACKUP(PLY)) GO TO 2 IF(SCORE.LE.BACKUP(PLY-1)) GO TO 8 6 BACKUP(PLY)=SCORE DO 7 M=1,DEPTH TRACE(M+10,PLY)=WHICH(M)-START(M) TRACE(M,PLY)=TREE(WHICH(M)) 7 CONTINUE GO TO 2 C C------------------------------< ALPHA/BETA CUTOFF FOUND C 8 PLY=PLY-1 SIDE=.NOT. SIDE TO8=TO(PLY) FROM8=FROM(PLY) TYPE8=TYPE(PLY) CALL UMOVER GO TO 2 C C------------------------------< PLY COMPLETED, BACK UP SCORE C 9 PLY=PLY-1 SIDE=.NOT. SIDE IF(PLY)18,18,10 10 BACKUP(PLY)=BACKUP(PLY+1) DO 11 M=1,DEPTH TRACE(M+10,PLY)=TRACE(M+10,PLY+1) TRACE(M,PLY)=TRACE(M,PLY+1) 11 CONTINUE TO8=TO(PLY) FROM8=FROM(PLY) TYPE8=TYPE(PLY) CALL UMOVER IF(PLY.NE.1) GO TO 12 CMOVE=TREE(WHICH(1)) GO TO 2 12 IF(SIDE) GO TO 14 13 IF(BACKUP(PLY).GE.BACKUP(PLY-1)) GO TO 8 GO TO 2 14 IF(BACKUP(PLY).LE.BACKUP(PLY-1)) GO TO 8 GO TO 2 C C------------------------------< NO MOVES GENERATED, IT MUST BE C------------------------------< CHECKMATE OR STALEMATE C 15 DO 16 M=1,PLY TRACE(M,PLY)=TREE(WHICH(M)) TRACE(M+10,PLY)=WHICH(M)-START(M) 16 CONTINUE IF(PLY.EQ.1) GO TO 9 IF(PLY.NE.2) GO TO 171 IF(CHECK(.TRUE.)) GO TO 17 SMOVE=TREE(WHICH(1)) GO TO 8 17 CMOVE=TREE(WHICH(1)) STOP(1)=WHICH(1) GO TO 9 C C------------------------------< DETERMINE THE DESIRABILITY FOR THE C------------------------------< SIDE WITH A DRAWING MOVE TO MAKE IT. C 171 IF(.NOT. SIDE) GO TO 173 IF(CHECK(.TRUE.)) GO TO 174 C C------------------------------< CHECK TO SEE IF THE HUMAN WOULD C------------------------------< ACCEPT A DRAW. C IF(.NOT. DRAW(TEMP)) GO TO 178 GO TO 179 173 IF(CHECK(.FALSE.)) GO TO 174 C C------------------------------< CHECK TO SEE IF THE PROGRAM SHOULD C------------------------------< ACCEPT A DRAW. C 172 IF(DRAW(TEMP)) GO TO 179 178 BACKUP(PLY)=-4000 GO TO 9 179 BACKUP(PLY)=4000 GO TO 9 C C------------------------------< CHECKMATE FOUND, ADD 1 TO THE NUMBER C------------------------------< OF MOVES TO BE EVALUATED (IF ANY C------------------------------< MORE EXIST) SO THAT THE MACHINE C------------------------------< WILL NOT STUMBLE INTO CHECKMATE C------------------------------< DUE TO FORWARD PRUNING THE MOVES C------------------------------< THAT WOULD ALLOW IT TO ESCAPE. C 174 IF(STOP(PLY-2).LT.START(PLY-1)-1) STOP(PLY-2)=STOP(PLY-2)+1 GO TO 9 18 RETURN END SUBROUTINE MATCH(*) C C ************************************************************ C * * C * MATCH IS USED TO DETERMINE IF THE HUMAN'S RESPONSE * C * MATCHED THE PREDICTED MOVE (IN THE PRINCIPLE VARIATION * C * CALCULATED FOR THE LAST MACHINE MOVE). IF SO, THE * C * COUNT OF PREDICTED MOVES IS INCREMENTED. IF IN * C * 'THINK AHEAD' MODE, MATCH WILL RETURN CAUSING THE * C * RESPONSE CALCULATED ON THE OPPONENT'S TIME TO BE * C * USED RATHER THAN CALLING . * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /THNK CM/ PTYPE8, PTO8, PFROM8 COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG COMMON /P V MOVE/ PVMOVE, OVMOVE COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE C C------------------------------< DID THE HUMAN'S MOVE MATCH THE C------------------------------< PREDICTED MOVE? C IF(MTCHED) GO TO 10 IF(PTYPE8.NE.TYPE8) GO TO 20 IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 10 IF(PTO8.NE.TO8.OR.PFROM8.NE.FROM8) GO TO 20 C C------------------------------< PREDICTED MOVE WAS MADE. INCREMENT C------------------------------< COUNT AND RETURN IF NOT IN THINK- C------------------------------< AHEAD MODE OR IF MOVE CALCULATION C------------------------------< WAS NOT COMPLETED. RETURN 1 IF A C------------------------------< RESPONSE IS READY. C 10 PRIGHT=PRIGHT+1 IF(.NOT. FOUNDM) RETURN FOUNDM=.FALSE. RETURN 1 C C------------------------------< PREDICTED MOVE WAS NOT MADE. CLEAR C------------------------------< THE THIRD PLY RESPONSE MOVE SO THAT C------------------------------< IT WILL NOT BE FORCED TO THE TOP C------------------------------< OF THE MOVES LIST SINCE IT IS C------------------------------< IS BASED ON AN INVALID ASSUMPTION. C 20 FOUNDM=.FALSE. PVMOVE=0 RETURN END INTEGER FUNCTION MINATK(SQUARE,SIDE,NUMATK) C C ************************************************************ C * * C * MINATK IS USED TO DETERMINE THE VALUE OF THE LEAST * C * IMPORTANT PIECE ATTACKING A SQUARE. THIS IS USED IN * C * SUBROUTINE 'ENPRIS' TO DETERMINE IF A PIECE IS SUBJECT * C * TO CAPTURE. IT PERFORMS TWO (2) FUNCTIONS: A) IT * C * RETURNS THE VALUE OF THE LEAST PIECE ATTACKING THE * C * SQUARE IN QUESTION, AND B) IT RETURNS THE NUMBER OF *^] C * PIECES ATTACKING THE SQUARE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) LOGICAL SIDE COMMON/BOARD/BOARD(120) COMMON/MOVES/RK(4),BP(4),KT(8),KG(8) MINATK=0 NUMATK=0 MAX=0 IF(SIDE) GO TO 1 BIAS=0 DIR=1 GO TO 2 1 BIAS=7 DIR=-1 2 PAWN=1+BIAS KNIGHT=2+BIAS BISHOP=3+BIAS ROOK=4+BIAS QUEEN=5+BIAS KING=6+BIAS TEMP=BOARD(SQUARE) C C------------------------------< KING ATTACKS C DO 100 I=1,8 IF(BOARD(SQUARE+KG(I)).NE.KING) GO TO 100 MAX=KING NUMATK=NUMATK+1 100 CONTINUE C C------------------------------< ROOK/QUEEN ATTACKS C DO 4 I=1,4 LOC=SQUARE DIREC=RK(I) 3 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(TEMP.EQ.7) GO TO 3 IF(TEMP.NE.ROOK) GO TO 31 MINATK=ROOK NUMATK=NUMATK+1 GO TO 4 31 IF(TEMP.NE.QUEEN) GO TO 4 MAX=QUEEN NUMATK=NUMATK+1 4 CONTINUE C C------------------------------< BISHOP/QUEEN ATTACKS C DO 6 I=1,4 LOC=SQUARE DIREC=BP(I) 5 LOC=LOC+DIREC TEMP=BOARD(LOC) IF(TEMP.EQ.7) GO TO 5 IF(TEMP.NE.BISHOP) GO TO 51 MINATK=BISHOP NUMATK=NUMATK+1 GO TO 6 51 IF(TEMP.NE.QUEEN) GO TO 6 MAX=QUEEN NUMATK=NUMATK+1 6 CONTINUE C C------------------------------< KNIGHT ATTACKS C DO 7 I=1,8 IF(BOARD(SQUARE+KT(I)).NE.KNIGHT) GO TO 7 MINATK=KNIGHT NUMATK=NUMATK+1 7 CONTINUE C C------------------------------< PAWN ATTACKS C IF(BOARD(SQUARE+DIR*9).NE.PAWN) GO TO 8 MINATK=PAWN NUMATK=NUMATK+1 8 IF(BOARD(SQUARE+DIR*11).NE.PAWN) GO TO 9 MINATK=PAWN NUMATK=NUMATK+1 9 IF(MINATK.EQ.0) MINATK=MAX IF(MINATK.GT.6) MINATK=MINATK-7 RETURN END SUBROUTINE MOVGEN C C ************************************************************ C * * C * MOVGEN IS THE DRIVER FOR ALL OF THE DIFFERENT MOVE * C * GENERATORS. THE ENTIRE BOARD IS SCANNED AND AS A PIECE * C * FOR THE SIDE TO MOVE IS DETECTED, THE APPROPRIATE MOVE * C * GENERATOR IS CALLED. AFTER ALL LEGAL MOVES ARE IN THE * C * LIST, SUBROUTINE ORDER IS CALLED TO ORDER THE MOVES * C * FOR THE SEARCH. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /ORDR CM/ VAL(100) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE LOGICAL SIDE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END,TF(2) DATA TF/.FALSE.,.TRUE./ STOP(PLY)=START(PLY)-1 SIDE=TF(2-MOD(PLY,2)) C C------------------------------< SCAN THE ENTIRE BOARD TO FIND ALL C------------------------------< PIECES OF THE SIDE TO MOVE. GEN- C------------------------------< ERATE AND SCORE ALL MOVES FOR THEM. C DO 9999 FROM8=22,99 FROMSQ=BOARD(FROM8) IF(.NOT.SIDE.AND.FROMSQ.LT.8) GO TO 9998 IF(SIDE.AND.FROMSQ.GT.6) GO TO 9998 BOARD(FROM8)=7 GO TO (1000,2000,3000,4000,5000,6000,9998, * 1000,2000,3000,4000,5000,6000,9998),FROMSQ 1000 CALL PAWN GO TO 9998 2000 CALL KNIGHT GO TO 9998 3000 CALL BISHOP GO TO 9998 4000 CALL ROOK GO TO 9998 5000 CALL BISHOP CALL ROOK GO TO 9998 6000 CALL KING 9998 BOARD(FROM8)=FROMSQ 9999 CONTINUE IF(END) GO TO 9997 C C------------------------------< IF NOT IN THE ENDGAME, GENERATE C------------------------------< CASTLING MOVES. C CALL CASTLE C C------------------------------< NOW ORDER THE MOVE LIST C 9997 CALL ORDER RETURN END $CONTROL SEGMENT=LK SUBROUTINE MVMKER C C ************************************************************ C * * C * MVMKER IS USED TO MAKE/UNMAKE ALL MOVES ON THE GAME * C * BOARD. IT SAVES THE VALUE OF THE 'TO' SQUARE BEFORE * C * MAKING A MOVE SO THAT THE MOVE CAN BE UNMADE LATER. * C * ENTRY 'MOVER' IS USED TO MAKE A MOVE AND ENTRY 'UMOVER' * C * IS USED TO UNMAKE A MOVE. BOTH ROUTINES USE DATA IN * C * COMMON BLOCK 'INFO' TO MAKE/UNMAKE MOVES. NO VALIDITY * C * CHECK IS MADE SO THE PARAMETERS MUST BE CORRECT BEFORE * C * THE CALL IS MADE. * C * * C ************************************************************ C C C TYPE8: 1 => NORMAL MOVE C 2 => CASTLE TO RIGHT SIDE OF BOARD C 3 => CASTLE TO LEFT SIDE OF BOARD C 4 => EN PASSANT PAWN CAPTURE C 5 => PAWN PROMOTION MOVES C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR COMMON /TREE/ DUMMY(480),PLY COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /CAPT CM/ SAVE(40) CHARACTER*5 CCOLOR, HCOLOR C C C ENTRY MOVER PLAYER=MOD(PLY,2) GO TO(1,2,9,16,17),TYPE8 C C------------------------------< NORMAL MOVES C 1 SAVE(PLY)=BOARD(TO8) BOARD(TO8)=BOARD(FROM8) BOARD(FROM8)=7 IF(BOARD(TO8).EQ.13) CKINGL=TO8 IF(BOARD(TO8).EQ.6) HKINGL=TO8 RETURN C C------------------------------< CASTLE TO RIGHT C 2 SAVE(PLY)=7 IF(PLAYER)3,6,3 3 IF(COLOR)4,5,4 4 BOARD(22)=7 BOARD(23)=13 BOARD(24)=11 BOARD(25)=7 CKINGL=23 RETURN 5 BOARD(22)=7 BOARD(24)=13 BOARD(25)=11 BOARD(26)=7 CKINGL=24 RETURN 6 IF(COLOR)7,8,7 7 BOARD(95)=7 BOARD(96)=4 BOARD(97)=6 BOARD(99)=7 HKINGL=97 RETURN 8 BOARD(96)=7 BOARD(97)=4 BOARD(98)=6 BOARD(99)=7 HKINGL=98 RETURN C C------------------------------< CASTLE TO LEFT C 9 SAVE(PLY)=7 IF(PLAYER)10,13,10 10 IF(COLOR)11,12,11 11 BOARD(25)=7 BOARD(26)=11 BOARD(27)=13 BOARD(29)=7 CKINGL=27 RETURN 12 BOARD(26)=7 BOARD(27)=11 BOARD(28)=13 BOARD(29)=7 CKINGL=28 RETURN 13 IF(COLOR)14,15,14 14 BOARD(92)=7 BOARD(93)=6 BOARD(94)=4 BOARD(95)=7 HKINGL=93 RETURN 15 BOARD(92)=7 BOARD(94)=6 BOARD(95)=4 BOARD(96)=7 HKINGL=94 RETURN C C------------------------------< EN PASSANT PAWN CAPTURE C 16 BOARD(TO8)=BOARD(FROM8) BOARD(FROM8)=7 SAVE(PLY)=BOARD(TO8+10-20*PLAYER) BOARD(TO8+10-20*PLAYER)=7 RETURN C C------------------------------< PAWN PROMOTION C 17 BOARD(FROM8)=5+7*PLAYER GO TO 1 C C C ENTRY UMOVER PLAYER=PLY-PLY/2*2 GO TO(18,19,26,33,34),TYPE8 C C------------------------------< RETRACT NORMAL MOVE C 18 BOARD(FROM8)=BOARD(TO8) BOARD(TO8)=SAVE(PLY) IF(BOARD(FROM8).EQ.13) CKINGL=FROM8 IF(BOARD(FROM8).EQ.6) HKINGL=FROM8 RETURN C C------------------------------< RETRACT CASTLE RIGHT C 19 IF(PLAYER)20,23,20 20 IF(COLOR)21,22,21 21 BOARD(22)=11 BOARD(23)=7 BOARD(24)=7 BOARD(25)=13 CKINGL=25 RETURN 22 BOARD(22)=11 BOARD(24)=7 BOARD(25)=7 BOARD(26)=13 CKINGL=26 RETURN 23 IF(COLOR)24,25,24 24 BOARD(95)=6 BOARD(96)=7 BOARD(97)=7 BOARD(99)=4 HKINGL=95 RETURN 25 BOARD(96)=6 BOARD(97)=7 BOARD(98)=7 BOARD(99)=4 HKINGL=96 RETURN C C------------------------------< RETRACT CASTLE LEFT C 26 IF(PLAYER)27,30,27 27 IF(COLOR)28,29,28 28 BOARD(25)=13 BOARD(26)=7 BOARD(27)=7 BOARD(29)=11 CKINGL=25 RETURN 29 BOARD(26)=13 BOARD(27)=7 BOARD(28)=7 BOARD(29)=11 CKINGL=26 RETURN 30 IF(COLOR)31,32,31 31 BOARD(92)=4 BOARD(93)=7 BOARD(94)=7 BOARD(95)=6 HKINGL=95 RETURN 32 BOARD(92)=4 BOARD(94)=7 BOARD(95)=7 BOARD(96)=6 HKINGL=96 RETURN C C------------------------------< RETRACT EN PASSANT PAWN CAPTURE C 33 BOARD(FROM8)=BOARD(TO8) BOARD(TO8)=7 BOARD(TO8+10-20*PLAYER)=SAVE(PLY) RETURN C C------------------------------< RETRACT PAWN PROMOTION C 34 BOARD(TO8)=1+7*PLAYER GO TO 18 END INTEGER FUNCTION NSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * NSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR KNIGHT MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE KNIGHT CONTROL BOARD FOR THE SIDE TO MOVE. (CNSCOR, * C * HNSCOR IN COMMON BLOCK 'N BD SM'). * C * THE SCORE IS ADJUSTED AS INDICATED FOR EACH OF THE * C * FOLLOWING FACTORS PRESENT: * C * 1) BONUS FOR MOVING TO THE 5TH THRU 8TH RANK WHEN * C * OPPONENT'S KING IS STILL ON THE BACK RANK. THIS * C * PUTS THE KNIGHT (OUTPOST KNIGHT) IN A POSITION * C * LEADING TO FORKS AND OTHER THREATS. THIS DOES * C * NOT APPLY IF THE KNIGHT CAN BE DRIVEN AWAY BY * C * A SIMPLE PAWN PUSH. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /N BD SM/ CNSCOR(100), HNSCOR(100) COMMON /N SM/ ENMOVE, OUTPST, N EDGE LOGICAL PPUSH, SIDE COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END OUTPSC=OUTPST IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 NSCORE=CNSCOR(SQUARE) IF(END) GO TO 9999 IF(SQUARE.LT.60) GO TO 9999 IF(HKINGL.LT.70) GO TO 9999 C C----------------------< AN OUTPOST KNIGHT SHOULD BE SUPPORTED C----------------------< BY A FRIENDLY PAWN. IF NOT, A LESSER C----------------------< BONUS WILL BE GIVEN. C IF(BOARD(SQUARE-9).NE.8.AND.BOARD(SQUARE-11).NE.8) GO TO 400 GO TO 300 C C==============================< HUMAN SCORING C 200 NSCORE=HNSCOR(SQUARE) IF(END) GO TO 9999 IF(SQUARE.GT.60) GO TO 9999 IF(CKINGL.GT.50) GO TO 9999 C C----------------------< AN OUTPOST KNIGHT SHOULD BE SUPPORTED C----------------------< BY A FRIENDLY PAWN. IF NOT, A LESSER C----------------------< BONUS WILL BE GIVEN. C IF(BOARD(SQUARE+9).NE.1.AND.BOARD(SQUARE+11).NE.1) GO TO 400 GO TO 300 C C------------------------------< THE KNIGHT HAS BEEN POSTED ON C------------------------------< AN AGGRESSIVE SQUARE THAT CAN LEAD C------------------------------< TO FORKING MOVES (5TH THRU 8TH RANKS). C------------------------------< IF THE KNIGHT CAN'T BE DRIVEN AWAY C------------------------------< BY AN ENEMY PAWN, ADD A BONUS TO C------------------------------< THE SCORE. C 400 OUTPSC=OUTPST/2 300 IF(END) GO TO 9999 IF(PPUSH(SQUARE,SIDE)) GO TO 9999 NSCORE=NSCORE+OUTPSC 9999 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE OCMND(DEVICE,*) C C ************************************************************ C * * C * OCMND PROCESSES THE 'O' COMMAND. THIS DISPLAYS * C * VARIOUS PIECE CONTROL BOARDS WHEN CHANGING OR DEBUGGING * C * THE PRE-ANALYSIS SUBROUTINE. * C * THE COMMAND HAS THE FOLLOWING SYNTAX: * C * OSB * C * WHERE S IDENTIFIES THE SIDE ('C' FOR THE COMPUTER AND * C * 'H' FOR THE HUMAN) AND B IDENTIFIES THE BOARD DESIRED * C * USING THE USUAL PIECE CODES (P FOR PAWN, N FOR KNIGHT, * C * ETC. 'OP' WILL DISPLAY THE PIECE VALUES. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /Q BD SM/ CQSCOR(100), HQSCOR(100) COMMON /K BD SM/ CKSCOR(100), HKSCOR(100) COMMON /R BD SM/ CRSCOR(100), HRSCOR(100) COMMON /B BD SM/ CBSCOR(100), HBSCOR(100) COMMON /N BD SM/ CNSCOR(100), HNSCOR(100) COMMON /P BD SM/ CPSCOR(100), HPSCOR(100) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (B,ALPHA(2)),(C,ALPHA(3)),(H,ALPHA(8)), *(K,ALPHA(11)),(N,ALPHA(14)),(P,ALPHA(16)),(Q,ALPHA(17)), *(R,ALPHA(18)),(V,ALPHA(22)) COMMON / BUFFER / TEXT(30) COMMON /DRAW CM/ STAT BD(100) LOGICAL DRAW,TEMP CALL PREANL IF(TEXT(3).EQ.P.AND.TEXT(4).NE.P) DEVICE=6 IF(TEXT(2).EQ.C) GO TO 200 IF(TEXT(2).EQ.P) GO TO 300 IF(TEXT(2).EQ.V) GO TO 400 IF(TEXT(2).NE.H) RETURN 1 C C------------------------------< 'OH?' COMMANDS C IF(TEXT(3).EQ.P) CALL OUTPUT(DEVICE,HPSCOR) IF(TEXT(3).EQ.N) CALL OUTPUT(DEVICE,HNSCOR) IF(TEXT(3).EQ.B) CALL OUTPUT(DEVICE,HBSCOR) IF(TEXT(3).EQ.R) CALL OUTPUT(DEVICE,HRSCOR) IF(TEXT(3).EQ.Q) CALL OUTPUT(DEVICE,HQSCOR) IF(TEXT(3).EQ.K) CALL OUTPUT(DEVICE,HKSCOR) RETURN C C------------------------------< 'OC?' COMMANDS C 200 IF(TEXT(3).EQ.P) CALL OUTPUT(DEVICE,CPSCOR) IF(TEXT(3).EQ.N) CALL OUTPUT(DEVICE,CNSCOR) IF(TEXT(3).EQ.B) CALL OUTPUT(DEVICE,CBSCOR) IF(TEXT(3).EQ.R) CALL OUTPUT(DEVICE,CRSCOR) IF(TEXT(3).EQ.Q) CALL OUTPUT(DEVICE,CQSCOR) IF(TEXT(3).EQ.K) CALL OUTPUT(DEVICE,CKSCOR) RETURN C C------------------------------< 'OP' COMMAND C 300 CALL SETPCV WRITE(6,310)(PVALUE(I+7),PVALUE(I),I=1,5) 310 FORMAT(10X,'BLITZ',2X,'OPPONENT'/ *1X,'PAWN',T12,I4,4X,I4/ *1X,'KNIGHT',T12,I4,4X,I4/ *1X,'BISHOP',T12,I4,4X,I4/ *1X,'ROOK',T12,I4,4X,I4/ *1X,'QUEEN',T12,I4,4X,I4) RETURN C C------------------------------< 'OV' COMMAND C 400 TEMP=DRAW(TEMP1) CALL OUTPUT(DEVICE,STAT BD) RETURN END $CONTROL SEGMENT=ADJ SUBROUTINE OPTION(*) C C ************************************************************ C * * C * OPTION IS THE DRIVER FOR ALL OF THE SEPARATE COM- * C * COMMAND MODULES. IT DECODES THE FIRST CHARACTER OF THE * C * INPUT AND CALLS THE CORRECT MODULE. THE ONLY DIRECT * C * INPUT TO OPTION IS '?' WHICH REQUESTS A LISTING OF ALL * C * LEGAL COMMANDS. * C * SEVERAL COMMANDS CAN HAVE A 'P' APPENDED TO THEM * C * TO DIRECT THEIR OUTPUT TO THE LINE PRINTER RATHER THAN * C * THE USER TERMINAL. THE FORTRAN UNIT NUMBER IS PASSED * C * AS AN ARGUMENT RATHER THAN BEING USED DIRECTLY. UNIT * C * '6' GOES TO THE LINE PRINTER AND UNIT '108' GOES TO THE * C * USER TERMINAL. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON/BUFFER/TEXT(30) LOGICAL IN BOOK, DRAW COMMON /BOOK CM/ KEY, IN BOOK COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /TRACE/ TRACE(20,10), TFLAG COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /DEBUG/ DEBUG LOGICAL DEBUG COMMON /HIST CM/ NMOVES, ANNOTE COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG COMMON /PC CM/ COMMANDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL PCMODE, EXMODE COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (A,ALPHA(1)),(B,ALPHA(2)),(C,ALPHA(3)), *(D,ALPHA(4)),(E,ALPHA(5)),(F,ALPHA(6)),(G,ALPHA(7)), *(H,ALPHA(8)),(I,ALPHA(9)),(J,ALPHA(10)),(K,ALPHA(11)), *(L,ALPHA(12)),(M,ALPHA(13)),(N,ALPHA(14)),(O,ALPHA(15)), *(P,ALPHA(16)),(Q,ALPHA(17)),(R,ALPHA(18)),(S,ALPHA(19)), *(T,ALPHA(20)),(U,ALPHA(21)),(V,ALPHA(22)),(W,ALPHA(23)), *(X,ALPHA(24)),(Y,ALPHA(25)),(Z,ALPHA(26)) INTEGER*4 BLANK, QUEST LOGICAL HELP DATA TLEVEL / 0J/,BLANK/%" "J/,QUEST/%"?"J/,HELP/.FALSE./ DO 10 I=1,30 IF(TEXT(31-I).NE.BLANK) GO TO 20 10 CONTINUE RETURN 1 20 DEVICE=6 IF(TEXT(31-I).EQ.P) DEVICE=10 IF(TEXT(1).EQ.A) GO TO 2400 IF(TEXT(1).EQ.B.AND.TEXT(2).EQ.O) GO TO 1400 IF(TEXT(1).EQ.C) GO TO 900 IF(TEXT(1).EQ.D.AND.TEXT(2).EQ.B) GO TO 3300 IF(TEXT(1).EQ.D.AND.TEXT(2).EQ.R.AND. * TEXT(3).EQ.A.AND.TEXT(4).EQ.W) GO TO 4300 IF(TEXT(1).EQ.D) GO TO 500 IF(TEXT(1).EQ.E.AND.TEXT(2).EQ.N) GO TO 1000 IF(TEXT(1).EQ.F) GO TO 300 IF(TEXT(1).EQ.H) GO TO 1200 IF(TEXT(1).EQ.L.AND.TEXT(2).EQ.M) GO TO 1700 IF(TEXT(1).EQ.O) GO TO 1300 IF(TEXT(1).EQ.P.AND.TEXT(2).EQ.BLANK) GO TO 1500 IF(TEXT(1).EQ.P.AND.TEXT(2).EQ.C) GO TO 1600 IF(TEXT(1).EQ.R.AND.TEXT(2).EQ.E *.AND.TEXT(3).EQ.S) GO TO 4755 IF(TEXT(1).EQ.R.AND.(TEXT(2).EQ.BLANK * .OR.TEXT(2).EQ.K)) GO TO 1800 IF(TEXT(1).EQ.S.AND.TEXT(2).EQ.B) GO TO 400 IF(TEXT(1).EQ.S.AND.TEXT(2).EQ.O) GO TO 7800 IF(TEXT(1).EQ.S.AND.TEXT(2).EQ.R) GO TO 1900 IF(TEXT(1).EQ.S.AND.(TEXT(2).EQ.BLANK * .OR.TEXT(2).EQ.P)) GO TO 600 IF(TEXT(1).EQ.S) GO TO 100 IF(TEXT(1).EQ.T.AND.TEXT(2).EQ.R) GO TO 1100 IF(TEXT(1).EQ.T.AND.TEXT(2).EQ.G) GO TO 5000 IF(TEXT(1).EQ.T) GO TO 800 IF(TEXT(1).EQ.V) GO TO 200 IF(TEXT(1).EQ.QUEST) GO TO 700 9999 RETURN C C------------------------------< ? : DISPLAY COMMANDS AND EXPLANATION C 700 WRITE(6,710) 710 FORMAT(// *1X,'A : ANNOTE A MOVE IN THE GAME HISTORY'/ *1X,'BO : TURN OPENING BOOK OFF'/ *1X,'C? : CONTROL CLOCK'/ *1X,'D : DISPLAY BOARD'/ *1X,'DRAW: OFFER THE PROGRAM A DRAW'/ *1X,'END : TERMINATE EXECUTION'/ *1X,'F : FORCE COMPUTER TO MAKE A MOVE'/ *1X,'H : LIST GAME HISTORY'/ *1X,'LM : LIST MOVES FOR EITHER SIDE'/ *1X,'O? : OUTPUT CONTROL BOARDS'/ *1X,'P : OUTPUT PREDICTED MOVE'/ *1X,'PC : ENTER PROGRAMMED COMMANDS'/ *1X,'R : RESET BOARD TO PRIOR MOVE'/ *1X,'S : OUTPUT MOVE STATISTICS'/ *1X,'S? : SET SEARCH LIMIT CONTROLS'/ *1X,'SB : SET NEW BOARD POSITION'/) WRITE(6,715) 715 FORMAT(1X,'SO : SET OPENING BLITZ SHOULD PLAY'/ *1X,'SR : SET OPPONENT''S RATING'/ *1X,'T : CONTROL THINK-AHEAD'/ *1X,'TG : SET PROGRAM TO TOURNAMENT PLAY LEVEL'/ *1X,'TR : DUMP MOVE TREE DURING ANALYSIS'/ *1X,'V : DISPLAY PRINCIPLE VARIATION OF COMPUTER''S MOVE'/ *) IF(.NOT. HELP) WRITE(6,720) 720 FORMAT( *1X,'P MAY BE APPENDED TO THE DISPLAY TYPE COMMANDS'/ *1X,'TO DIRECT THE OUTPUT FROM THAT COMMAND TO THE'/ *1X,'LINE PRINTER OR WHEREVER FORTRAN I/O UNIT 6'/ *1X,'IS CURRENTLY ASSIGNED'// *1X,'A ''?'' MAY BE APPENDED TO SOME SPECIFIC COMMANDS'/ *1X,'TO GIVE A DETAILED DESCRIPTION OF THE SUB-'/ *1X,'COMMANDS (C? EXPLAINS CLOCK SUBCOMMANDS).'/) HELP=.TRUE. RETURN 1 C C------------------------------< A : ANNOTE GAME HISTORY C 2400 CALL ACMND RETURN 1 C C------------------------------< BO : TURN OPENING BOOK OFF C 1400 IN BOOK = .FALSE. RETURN 1 C C------------------------------< C : CONTROL CLOCK C 900 CALL CCMND(DEVICE) RETURN 1 C C------------------------------< D : DISPLAY GAME BOARD C 500 CALL DISPLY(DEVICE) RETURN 1 C C------------------------------< DB : TURN ON DEBUG TRACE MODE C 3300 DEBUG=.NOT.DEBUG IF(DEBUG) WRITE(6,3301) IF(.NOT. DEBUG) WRITE(6,3401) RETURN 1 3301 FORMAT(1X,'DEBUG MODE ON') 3401 FORMAT(1X,'DEBUG MODE OFF') C C------------------------------< DRAW : OFFER THE PROGRAM A DRAW C 4300 IF(.NOT. DRAW(SCORE)) GO TO 4302 WRITE(6,4301) 4301 FORMAT(1X,'DRAW ACCEPTED') WRITE(6,4304)SCORE 4304 FORMAT(1X,'BOARD EVALUATION =',I6) NMOVES=NMOVES+1 WRITE(1@NMOVES)TEXT GO TO 1000 4302 WRITE(6,4303) 4303 FORMAT(1X,'DRAW REFUSED') WRITE(6,4304)SCORE RETURN 1 C C------------------------------< F : EVALUATE FORCED MOVE C 300 CALL FCMND RETURN 1 C C------------------------------< H : PRINT GAME HISTORY C 1200 CALL HCMND(DEVICE) RETURN 1 C C------------------------------< LM : LIST PLAUSIBLE MOVE TREE C 1700 CALL LMCMND(DEVICE) RETURN 1 C C------------------------------< OX : OUTPUT CONTROL BOARDS C------------------------------< ( X = 'C' OR 'H' ) C 1300 CALL OCMND(DEVICE,$9999) RETURN 1 C C------------------------------< P : OUTPUT PREDICTED MOVE C 1500 CALL PCMND RETURN 1 C C------------------------------< PC : ENTER PROGRAMMED COMMANDS C 1600 CALL PCCMND RETURN 1 C C------------------------------< R : RESET BOARD TO PRIOR MOVE C 1800 DMY=0 CALL RCMND(DMY) RETURN 1 C C------------------------------< RESIGN : RESIGN GAME C 4755 WRITE(6,4756)HCOLOR 4756 FORMAT(1X,A5,' RESIGNS') NMOVES=NMOVES+1 WRITE(1@NMOVES)TEXT GO TO 1000 C C------------------------------< S : PRINT MOVE STATISTICS C 600 CALL STATS(DEVICE) RETURN 1 C C------------------------------< S? : SET SEARCH LIMIT CONTROLS C 100 CALL SCMND($9999) RETURN 1 C C------------------------------< SB : SET THE BOARD TO SOME C------------------------------< PRE-DETERMINED POSITION C 400 CALL SETBRD 410 WRITE(6,420) 420 FORMAT(1X,'ENTER MOVE NUMBER') CALL INPUT(MOVE) NCMOVS=MOVE NHMOVS=MOVE IF(COLOR.EQ.1) NHMOVS=NHMOVS-1 IN BOOK = .FALSE. RETURN 1 C C------------------------------< SO : SET OPENING TO USE C 7800 CALL SETOPN RETURN 1 C C------------------------------< SR : SET OPPONENT'S RATING C 1900 CALL SRCMND RETURN 1 C C------------------------------< T : CONTROL THINK-AHEAD C 800 THNK AH=.NOT. THNK AH FOUND M=.FALSE. LOOK AH=.FALSE. MTCHED=.FALSE. IF(THNK AH) WRITE(6,801) IF(.NOT. THNK AH) WRITE(6,802) RETURN 1 801 FORMAT(1X,'I WILL THINK ALL OF THE TIME') 802 FORMAT(1X,'I WILL NOT THINK ALL OF THE TIME') C RETURN 1 C C------------------------------< TG : TOURNAMENT GAME SETTING C 5000 CALL SETTG RETURN 1 C C------------------------------< TR : TRACE MOVE LOOK AHEAD C 1100 IF(EXMODE) GO TO 1110 1102 WRITE(6,1101) 1101 FORMAT(1X,'TRACE SEARCH TO WHAT LEVEL?') CALL INPUT(TFLAG) TLEVEL=TFLAG RETURN 1 1110 IF(TLEVEL.NE.0) GO TO 1120 WRITE(6,1101) CALL INPUT(TLEVEL) 1120 TFLAG=TLEVEL RETURN 1 C C------------------------------< V : OUTPUT PRINCIPLE VARIATION C 200 CALL VCMND(DEVICE) RETURN 1 C C------------------------------< END : TERMINATE PLAY C 1000 STOP 'GOOD BYE' END SUBROUTINE ORDER C C ************************************************************ C * * C * THIS SUBROUTINE RE-ORDERS THE MOVE LIST GENERATED * C * BY THE MOVE GENERATORS. THIS PLACES MOVES WITH HIGH * C * PLAUSIBILITY SCORES AT THE TOP OF THE LIST, HOPEFULLY * C * MAXIMIZING THE NUMBER OF ALPHA/BETA CUTOFFS THAT OCCUR * C * DURING THE COURSE OF THE SEARCH. IF THE CURRENT PLY IS * C * ONE, EXCHNG IS USED WITH EACH MOVE IN THE LIST TO * C * DETERMINE IF THE MOVE LEAVES ANY PIECES SUBJECT TO * C * CAPTURE. IF SO, THE SCORE IS ADJUSTED TO REFLECT THE * C * LOSS OF THE PIECE. * C * FOR EACH MOVE GENERATED, 'EN PRIS' IS USED TO DE- * C * TERMINE IF ANY FRIENDLY PIECES ARE LEFT EXPOSED TO A * C * CAPTURE. IF SO, THESE MOVES ARE MOVED DOWN IN THE LIST * C * TO SAVE TIME. * C * IF THE PLY IS NOT GREATER THAN 'ORDER1', THEN ALL * C * MOVES FORWARD PRUNED ARE CHECKED TO SEE IF THE PUT THE * C * OPPONENT KING IN CHECK. IF SO, THE MOVES ARE MOVED UP * C * BELOW THE LAST MOVE LEFT AFTER PRUNING AND THE WIDTH * C * IS INCREASED TO COVER THEM. * C * IF THE PLY IS NOT GREATER THAN 'ORDER2', THEN ALL * C * CAPTURING MOVES ARE DONE AS THE CHECKING MOVES ABOVE * C * TO MAKE SURE THE PROGRAM WILL EXAMINE ALL EXCHANGES OPEN* C * TO IT. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE LOGICAL SIDE, SAVES, CHECK, PPUSH COMMON /ORDR CM/ VAL(100) COMMON /CAPT CM/ SAVE(40) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO COMMON /P V MOVE/ PVMOVE, OVMOVE IF(WIDTH(PLY).GT.100) GO TO 9999 START(PLY+1)=STOP(PLY)+1 F=START(PLY) L=STOP(PLY) LGLMVS=L-F+1 NGEN=NGEN+LGLMVS NTERM=NTERM+1 IF(F.GE.L) GO TO 9999 IF(PLY.GT.1) GO TO 300 FROM8=PVMOVE CALL EXTRCT PVTO=TO8 PVFROM=FROM8 PVTYPE=TYPE8 300 CONTINUE C C------------------------------< ADJUST EACH MOVE'S SCORE TO REFLECT C------------------------------< THE CONDITION OF FRIENDLY PIECES. C------------------------------< THIS GIVES MOVES WHICH LEAVE OTHER C------------------------------< PIECES 'EN PRISE' A LOWER SCORE C------------------------------< SO THAT THEY WILL BE FORWARD PRUNED C------------------------------< OR EXAMINED LAST. C TEMP=0 DO 3000 I=F,L TEMP=TEMP+1 FROM8=TREE(I) CALL EXTRCT SCORE=VALUE8 IF(PLY.EQ.DEPTH) GO TO 2500 C C------------------------------< IF THE PREDICTED MOVE WAS MADE, C------------------------------< MAKE THE PRINCIPLE VARIATION'S 3RD C------------------------------< MOVE GO TO THE TOP OF THE LIST. C IF(PVMOVE.EQ.0 .OR. PLY.GT.1) GO TO 400 IF(PVTYPE.NE.TYPE8) GO TO 400 IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 450 IF(PVTO.NE.TO8.OR.PVFROM.NE.FROM8) GO TO 400 450 SCORE=SCORE+8000 GO TO 2500 400 CONTINUE IF(LGLMVS.LE.WIDTH(PLY)) GO TO 2500 CALL MOVER C C------------------------------< CHECK TO SEE IF THIS MOVE IS A C------------------------------< FORKING TYPE MOVE. IF SO, ADJUST C------------------------------< THE SCORE TO MAKE SURE IT IS EX- C------------------------------< AMINED BY THE SEARCH. C IF(TYPE8.EQ.CASTRT.OR.TYPE8.EQ.CASTLF) GO TO 500 IF(PLY.EQ.1) TSCORE=EXCHNG(TO8,SIDE) IF(PLY.GT.1) TSCORE=ENPRIS(TO8,SIDE) SCORE=SCORE-TSCORE C C------------------------------< IF THE PIECE CAN BE CAPTURED, DO C------------------------------< NOT CONSIDER THE MOVE A FORK. IF C------------------------------< AT THE LAST 2 LEVELS IN THE TREE, C------------------------------< DO NOT CONSIDER FORKS SINCE THE C------------------------------< ULTIMATE GAIN IN MATERIAL WILL NOT C------------------------------< BE DISCOVERED. C IF(TSCORE.GT.0 .OR. PLY.GT.DEPTH-2) GO TO 500 IF(PLY.GT.1) GO TO 475 IF(ENPRIS(TO8,SIDE).EQ.1) GO TO 500 475 SCORE=SCORE+FORK(TO8,SIDE) 500 DO 2000 SQUARE=22,99 IF(SQUARE.EQ.TO8) GO TO 2000 SQVAL=BOARD(SQUARE) IF(SQVAL.EQ.14) GO TO 2000 IF(SQVAL.EQ.6.OR.SQVAL.EQ.13) GO TO 2000 IF(SIDE.AND.SQVAL.GT.6) GO TO 2000 IF(.NOT.SIDE.AND.SQVAL.LT.8) GO TO 2000 IF(PLY.EQ.1) TSCORE=EXCHNG(SQUARE,SIDE) IF(PLY.GT.1) TSCORE=ENPRIS(SQUARE,SIDE) SCORE=SCORE-TSCORE 2000 CONTINUE C C------------------------------< IF THIS PIECE IS BEING MOVED TO C------------------------------< A SQUARE WHERE IT CAN BE ATTACKED C------------------------------< BY A PAWN, PENALIZE THE SCORE. C IF(PPUSH(TO8,SIDE)) SCORE=SCORE-ATAK SC C C------------------------------< CHECK TO SEE IF THIS MOVE IS A C------------------------------< PAWN PUSH. IF SO, ADD A BONUS C------------------------------< FOR ATTACKING A PIECE. C MVGPC=MOD(BOARD(TO8),7) IF(MVGPC.NE.1) GO TO 2300 SCORE=SCORE+PATACK(TO8,SIDE) 2300 CALL UMOVER 2500 VAL(TEMP)=SCORE 3000 CONTINUE C C------------------------------< NOW ORDER THE MOVES BASED ON THE C------------------------------< VALUES CALCULATED BY THE MOVE C------------------------------< GENERATORS + THE ABOVE TRICKS C F1=L-1 DO 901 I=F,F1 I1=I+1 DO 900 J=I1,L T1=I-F+1 T2=J-F+1 IF(VAL(T1).GE.VAL(T2)) GO TO 900 TEMP=VAL(T1) VAL(T1)=VAL(T2) VAL(T2)=TEMP TEMP=TREE(I) TREE(I)=TREE(J) TREE(J)=TEMP 900 CONTINUE 901 CONTINUE C C------------------------------< FORWARD PRUNE TREE C 200 IF(PLY.EQ.DEPTH) GO TO 9999 IF(LGLMVS.GT.WIDTH(PLY)) STOP(PLY)=START(PLY)+WIDTH(PLY)-1 C C------------------------------< IF AT OR BELOW THE CHECK REORDERING C------------------------------< LEVEL (ORDER1), MOVE CHECKS UP TO C------------------------------< THE POINT IMMEDIATELY FOLLOWING THE C------------------------------< THE LAST MOVE LEFT AFTER FORWARD C------------------------------< PRUNING. C C------------------------------< IF AT OR BELOW THE CAPTURE REORDERING C------------------------------< LEVEL (ORDER2) DO THE SAME FOR ALL C------------------------------< CAPTURING MOVES C IF(PLY.GT.ORDER1.AND.PLY.GT.ORDER2) GO TO 9999 5000 JLAST=STOP(PLY)+1 JMOVE=JLAST JTOP=JLAST-START(PLY)+1 JBOT=JTOP 1300 IF(JMOVE.GE.START(PLY+1)) GO TO 9999 FROM8=TREE(JMOVE) CALL EXTRCT C C------------------------------< TREAT CAPTURING MOVES C IF(PLY.GT.ORDER2) GO TO 1500 IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 1500 IF(TYPE8.EQ.ENPASS) GO TO 1800 IF(BOARD(TO8).NE.7) GO TO 1800 C C------------------------------< TREAT CHECKING MOVES C 1500 IF(PLY.GT.ORDER1) GO TO 1900 CALL MOVER IF(CHECK(.NOT. SIDE)) GO TO 1400 CALL UMOVER GO TO 1900 1400 CALL UMOVER 1800 TEMP=TREE(JLAST) TREE(JLAST)=TREE(JMOVE) TREE(JMOVE)=TEMP TEMP=VAL(JTOP) VAL(JTOP)=VAL(JBOT) VAL(JBOT)=TEMP STOP(PLY)=STOP(PLY)+1 JLAST=JLAST+1 JTOP=JTOP+1 1900 JMOVE=JMOVE+1 JBOT=JBOT+1 GO TO 1300 9999 RETURN END $CONTROL SEGMENT=IOMV SUBROUTINE OUTMOV(FROM8,TO8,TYPE8,MTYPE,PLAY8,BOARD) C C ************************************************************ C * * C * OUTMOVE IS USED BY ANY ROUTINE WISHING TO OUTPUT A * C * MOVE IN STANDARD CHESS NOTATION. C * TO OUTPUT MACHINE MOVES AND EVEN TO OUTPUT HUMAN MOVES. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) INTEGER*4 BOARD(120),FILE(8),PIECES(6) COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE INTEGER*4 RANK(8) COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (RANK(1),ALPHA(28)),(ALPHAA,ALPHA(1)), *(ALPHAE,ALPHA(5)),(ALPHAM,ALPHA(13)),(ALPHAO,ALPHA(15)), *(ALPHAP,ALPHA(16)),(ALPHAT,ALPHA(20)),(ALPHAX,ALPHA(24)), *(PLUS,ALPHA(37)),(MINUS,ALPHA(38)),(SLASH,ALPHA(39)), *(EQUAL,ALPHA(41)) COMMON /BUFFER/ TEXT(30) DATA FILE/%"R"J,%"N"J,%"B"J,%" "J,%" "J,%"B"J,%"N"J,%"R"J/ DATA PIECES/%"P"J,%"N"J,%"B"J,%"R"J,%"Q"J,%"K"J/ C C------------------------------< IF MOVE IS A CASTLING MOVE, GO TO C------------------------------< A SPECIAL OUTPUT ROUTINE. C IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 8888 IF(TO8.LT.22.OR.TO8.GT.99) RETURN IF(FROM8.LT.22.OR.FROM8.GT.99) RETURN C C------------------------------< DETERMINE WHICH SIDE IS MOVING C 8888 PLAYER=MOD(PLAY8,2) C C------------------------------< GET AND CONVERT PIECES BEING MOVED C------------------------------< AND/OR CAPTURED. C PIECE=BOARD(FROM8) CPIECE=BOARD(TO8) DO 1 I=1,30 1 TEXT(I)=FILE(4) IF(PIECE.GT.6) PIECE=PIECE-7 IF(CPIECE.GT.7) CPIECE=CPIECE-7 IF(TYPE8.EQ.ENPASS) CPIECE=1 C C------------------------------< PROCESS ORIGIN FILE/SQUARE C------------------------------< AND DESTINATION FILE/SQUARE C GO TO (6,15,19,6,6),TYPE8 6 OFILEQ=PIECES(6) DFILEQ=PIECES(6) OFILE=MOD(FROM8-1,10) DFILE=MOD(TO8-1,10) IF(COLOR)7,8,7 7 IF(OFILE.GT.4) OFILEQ=PIECES(5) IF(DFILE.GT.4) DFILEQ=PIECES(5) GO TO 9 8 IF(OFILE.LT.5) OFILEQ=PIECES(5) IF(DFILE.LT.5) DFILEQ=PIECES(5) 9 ORANK=(FROM8-1)/10-1 DRANK=(TO8-1)/10-1 IF(TYPE8.EQ.ENPASS) DRANK=DRANK-1 IF(PLAYER.NE.0) GO TO 775 ORANK=9-ORANK DRANK=9-DRANK IF(TYPE8.EQ.ENPASS) DRANK=DRANK-2 C C------------------------------< NOW BUILD TEXT STRING TO OUTPUT C------------------------------< BASED ON INFORMATION FROM ABOVE. C 775 TEXT(1)=PIECES(PIECE) TEXT(2)=SLASH TEXT(3)=OFILEQ PTR=4 TEXT(PTR)=FILE(OFILE) IF(TEXT(PTR).NE.FILE(4)) PTR=PTR+1 TEXT(PTR)=RANK(ORANK) PTR=PTR+1 TEXT(PTR)=MINUS PTR=PTR+1 IF(CPIECE.EQ.7) GO TO 10 TEXT(PTR-1)=ALPHAX TEXT(PTR)=PIECES(CPIECE) TEXT(PTR+1)=SLASH PTR=PTR+2 10 TEXT(PTR)=DFILEQ PTR=PTR+1 TEXT(PTR)=FILE(DFILE) IF(TEXT(PTR).NE.FILE(4)) PTR=PTR+1 TEXT(PTR)=RANK(DRANK) PTR=PTR+2 IF(PIECE.NE.1) GO TO 11 IF(PLAYER.EQ.0.AND.TO8.GT.30) GO TO 11 IF(PLAYER.EQ.1.AND.TO8.LT.90) GO TO 11 TEXT(PTR-1)=EQUAL TEXT(PTR)=PIECES(5) PTR=PTR+2 C C------------------------------< ADD 'EP' FOR EN PASSANT CAPTURES C 11 IF(TYPE8.NE.ENPASS) GO TO 12 TEXT(PTR) = ALPHAE TEXT(PTR+1)=ALPHAP PTR=PTR+4 C C------------------------------< ADD ' +' IF THE MOVE IS A CHECK C 12 IF(MTYPE.NE.1.AND.MTYPE.NE.3) GO TO 13 TEXT(PTR) = PLUS C C------------------------------< ADD 'MATE' IF THE MOVE GIVES C------------------------------< CHECKMATE. C 13 IF(MTYPE.NE.3) GO TO 14 TEXT(PTR) = ALPHAM TEXT(PTR+1)=ALPHAA TEXT(PTR+2)=ALPHAT TEXT(PTR+3)=ALPHAE 14 RETURN C C------------------------------< PROCESS CASTLING MOVES C 15 IF(PLAYER)16,17,16 16 IF(COLOR)22,18,22 17 IF(COLOR)18,22,18 18 TEXT(4)=MINUS TEXT(5)=ALPHAO GO TO 22 19 IF(PLAYER)20,21,20 20 IF(COLOR)18,22,18 21 IF(COLOR)22,18,22 22 TEXT(1)=ALPHAO TEXT(2)=MINUS TEXT(3)=ALPHAO GO TO 14 END $CONTROL SEGMENT=DSP SUBROUTINE OUTPUT(DEVICE,BOARD) C C ************************************************************ C * * C * THIS SUBROUTINE WILL OUTPUT THE SIGNIFICANT PART OF * C * ANY BOARD TO THE TERMINAL OR LINE PRINTER. NUMERICS * C * ONLY ARE USED, EVEN FOR THE GAME BOARD. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) INTEGER*4 BOARD(100) COMMON /BUFFER/ TEXT(30) WRITE(DEVICE,310)(TEXT(I),I=2,3) DO 110 I=22,92,10 J=I+7 WRITE(DEVICE,300)(BOARD(L),L=I,J) 110 CONTINUE RETURN 300 FORMAT(1X,8I5) 310 FORMAT(14X,'SCORING BOARD (',2R1,')') END INTEGER FUNCTION PASSED(SQUARE,SIDE) C C ************************************************************ C * * C * PASSED IS USED TO COMPUTE THE VALUE OF A PASSED PAWN * C * ON 'SQUARE'. IT CHECKS TO SEE IF A PAWN ON 'SQUARE' IS * C * PASSED AND COMPUTES IT'S NET WORTH IF IT IS. IF NOT, * C * A SCORE OF ZERO (0) IS RETURNED. * C * IF A PAWN IS PASSED, IT IS NOT GIVEN CREDIT FOR *^] C * ADVANCING IF IT IS ISOLATED AND UNDEFENDED. IF IT IS * C * NOT ISOLATED, PAWNS ARE KEPT CONNECTED BY ANOTHER * C * ROUTINE SO A FRIENDLY DEFENDER IS ALWAYS NEARBY. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /P BD SM/ CPSCOR(100), HPSCOR(100) LOGICAL SIDE, ISOLAT PASSED=0 C C------------------------------< DETERMINE DIRECTION OF MOVES, VALUE C------------------------------< OF ENEMY PAWNS, AND RANK. C IF(SIDE) GO TO 200 100 EPAWN=1 FPAWN=8 DIR=1 RANK=SQUARE/10-2 GO TO 300 200 EPAWN=8 FPAWN=1 DIR=-1 RANK=9-SQUARE/10 C C------------------------------< CHECK TO SEE IF THE PAWN IS PASSED C------------------------------< BY SCANNING THIS AND ADJACENT FILES C------------------------------< IN FRONT OF THIS PAWN FOR THE C------------------------------< PRESENCE OF ENEMY PAWNS. C 300 IF(RANK.GT.5) GO TO 450 SQ=SQUARE 400 SQ=SQ+DIR*10 IF(BOARD(SQ-1).EQ.EPAWN) GO TO 500 IF(BOARD(SQ).EQ.EPAWN) GO TO 500 IF(BOARD(SQ+1).EQ.EPAWN) GO TO 500 IF(BOARD(SQ).NE.14) GO TO 400 C C------------------------------< THE PAWN SHOULD BE SUPPORTED TO C------------------------------< GET THE FULL SCORE FOR ADVANCING C 450 IF(.NOT.ISOLAT(SQUARE,SIDE)) GO TO 475 IF(MINATK(SQUARE,.NOT.SIDE,DUMMY).EQ.0) GO TO 480 C C------------------------------< PAWN IS PASSED, IT'S WORTH IS THE C------------------------------< RANK TIMES THE PASSED PAWN SCORE C------------------------------< IN AN EXPONENTIAL SORT OF WAY! C 475 RANK=RANK*RANK 480 PASSED=PPAWN*FLOAT(RANK)/3.0 500 RETURN END INTEGER FUNCTION PATACK(SQUARE,SIDE) C C ************************************************************ C * * C * PATACK IS USED TO DETERMINE IF A PAWN ON 'SQUARE' * C * IS ATTACKING A PIECE. IF SO A BONUS IS RETURNED AS THE * C * VALUE. ADDITIONALLY, IF A PAWN IS ATTACKING A PIECE * C * WHICH MUST FLEE (KNIGHT OR ROOK), A FURTHER BONUS IS * C * ADDED. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO LOGICAL SIDE PATACK=0 IF(SIDE) GO TO 200 C C------------------------------< DETERMINE WHAT THE PAWN BEING C------------------------------< PUSHED ATTACKS. IF IT ATTACKS C------------------------------< NOTHING OR ANOTHER PAWN, RETURN. C 100 IF(BOARD(SQUARE+9).EQ.1.OR.BOARD(SQUARE+11).EQ.1) GO TO 999 DO 110 I=9,11,2 LOC=SQUARE+I IF(BOARD(LOC).LT.7) GO TO 300 110 CONTINUE GO TO 999 200 IF(BOARD(SQUARE-9).EQ.8.OR.BOARD(SQUARE-11).EQ.8) GO TO 999 DO 210 I=9,11,2 LOC=SQUARE-I IF(BOARD(LOC).EQ.14) GO TO 999 IF(BOARD(LOC).GT.7) GO TO 300 210 CONTINUE GO TO 999 C C------------------------------< PAWN IS ATTACKING A PIECE, ADD IN C------------------------------< A BONUS. IF IT IS ATTACKING A ROOK C------------------------------< OR KNIGHT (WHICH MUST FLEE), ADD C------------------------------< IN ANOTHER BONUS. C 300 PATACK=ATAK SC PIECE=MOD(BOARD(LOC),7) IF(PIECE.NE.2.AND.PIECE.NE.4) GO TO 999 PATACK=PATACK+ATAK SC/2 999 RETURN END $CONTROL SEGMENT=PC SUBROUTINE PAWN C C ************************************************************ C * * C * PAWN GENERATES ALL PAWN MOVES. SUBROUTINE SCORE IS * C * CALLED TO COMPUTE THE PLAUSIBILITY SCORE FOR THE MOVE, * C * AFTER WHICH THE MOVE IS ENTERED IN THE MOVE LIST. THE * C * 'EN PASSANT' AS WELL AS PROMOTION MOVES ARE CONSIDERED * C * HERE, ALTHOUGH PROMOTION IS STRICTLY TO A QUEEN. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE LOGICAL SIDE, CHECK COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY IF(SIDE) GO TO 2000 C C==============================< COMPUTER PAWN MOVES C C C----------------------< CAPTURES C 1000 TO8=FROM8+9 DO 1040 I=1,2 TOSQ=BOARD(TO8) IF(TOSQ.GT.6) GO TO 1035 BOARD(TO8)=8 IF(CHECK(.FALSE.)) GO TO 1030 TYPE8=NORMAL IF(TO8.LT.90) GO TO 1010 TYPE8=PROMOTE BOARD(TO8)=12 1010 CALL SCORE CALL ENTER 1030 BOARD(TO8)=TOSQ 1035 TO8=TO8+2 1040 CONTINUE C C----------------------< EN PASSANT CAPTURES C TOSQ=1 IF(PLY.GT.1) GO TO 1050 TLAST=HTO8 FLAST=HFROM8 GO TO 1060 1050 TLAST=TO(PLY-1) FLAST=FROM(PLY-1) 1060 IF(FLAST.LT.80) GO TO 1090 IF(BOARD(TLAST).NE.1) GO TO 1090 TO8=FROM8+9 DO 1080 I=1,2 IF(BOARD(TO8).NE.7) GO TO 1075 IF(FLAST.NE.TO8+10) GO TO 1075 IF(TLAST.NE.TO8-10) GO TO 1075 BOARD(TLAST)=7 BOARD(TO8)=8 IF(CHECK(.FALSE.)) GO TO 1070 TYPE8=ENPASS CALL SCORE CALL ENTER 1070 BOARD(TLAST)=1 BOARD(TO8)=7 1075 TO8=TO8+2 1080 CONTINUE C C----------------------< REGULAR MOVES C 1090 TOSQ=7 TO8=FROM8+10 DO 1130 I=1,2 IF(BOARD(TO8).NE.7) GO TO 9999 BOARD(TO8)=8 IF(CHECK(.FALSE.)) GO TO 1120 TYPE8=NORMAL IF(TO8.LT.90) GO TO 1100 TYPE8=PROMOTE BOARD(TO8)=12 1100 CALL SCORE CALL ENTER 1120 BOARD(TO8)=7 IF(FROM8.GT.40) GO TO 9999 TO8=TO8+10 1130 CONTINUE GO TO 9999 C C==============================< HUMAN PAWN MOVES C C C----------------------< CAPTURES C 2000 TO8=FROM8-9 DO 2040 I=1,2 TOSQ=BOARD(TO8) IF(TOSQ.LT.8.OR.TOSQ.GT.13) GO TO 2035 BOARD(TO8)=1 IF(CHECK(.TRUE.)) GO TO 2030 TYPE8=NORMAL IF(TO8.GT.30) GO TO 2010 TYPE8=PROMOTE BOARD(TO8)=5 2010 CALL SCORE CALL ENTER 2030 BOARD(TO8)=TOSQ 2035 TO8=TO8-2 2040 CONTINUE C C----------------------< EN PASSANT CAPTURES C TOSQ=8 TLAST=TO(PLY-1) FLAST=FROM(PLY-1) 2060 IF(FLAST.GT.40) GO TO 2090 IF(BOARD(TLAST).NE.8) GO TO 2090 TO8=FROM8-9 DO 2080 I=1,2 IF(BOARD(TO8).NE.7) GO TO 2075 IF(FLAST.NE.TO8-10) GO TO 2075 IF(TLAST.NE.TO8+10) GO TO 2075 BOARD(TLAST)=7 BOARD(TO8)=1 IF(CHECK(.TRUE.)) GO TO 2070 TYPE8=ENPASS CALL SCORE CALL ENTER 2070 BOARD(TLAST)=8 BOARD(TO8)=7 2075 TO8=TO8-2 2080 CONTINUE C C----------------------< REGULAR MOVES C 2090 TOSQ=7 TO8=FROM8-10 DO 2130 I=1,2 IF(BOARD(TO8).NE.7) GO TO 9999 BOARD(TO8)=1 IF(CHECK(.TRUE.)) GO TO 2120 TYPE8=NORMAL IF(TO8.GE.30) GO TO 2100 TYPE8=PROMOTE BOARD(TO8)=5 2100 CALL SCORE CALL ENTER 2120 BOARD(TO8)=7 IF(FROM8.LT.80) GO TO 9999 TO8=TO8-10 2130 CONTINUE 9999 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE PCMND C C ************************************************************ C * * C * PCMND IS USED TO PROCESS THE 'P' COMMAND. IT * C * OUTPUTS THE PREDICTED HUMAN RESPONSE TO THE COMPUTER'S * C * LAST MOVE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /TRCE CM/ STRACE(20), TSCORE COMMON /BUFFER/ TEXT(30) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /BOARD/ BOARD(120) COMMON /BOOK CM/ KEY, IN BOOK LOGICAL IN BOOK COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR C C------------------------------< IF NO PREDICTED MOVE, RETURN C IF(IN BOOK) GO TO 40 IF(STRACE(2).EQ.0) GO TO 20 C C------------------------------< GET PREDICTED MOVE, CONVERT IT C------------------------------< AND OUTPUT IT. C FROM8=STRACE(2) CALL EXTRCT 5 CALL OUTMOV(FROM8,TO8,TYPE8,0,0,BOARD) WRITE(6,10)TEXT 10 FORMAT(1X,'PREDICTED MOVE IS ',30R1) RETURN 20 WRITE(6,30) 30 FORMAT(1X,'NO PREDICTED MOVE') RETURN C C------------------------------< READ PREDICTED MOVE FROM BOOK C------------------------------< MOVE DATABASE. C 40 TKEY=KEY READ(3@KEY) FROM8 KEY=TKEY CALL EXTRCT IF(COLOR.EQ.1) GO TO 5 TO8=121-TO8 FROM8=121-FROM8 GO TO 5 END $CONTROL SEGMENT=CMND SUBROUTINE PCCMND C C ************************************************************ C * * C * PCCMND IS USED TO PROCESS THE 'PC' COMMAND WHICH * C * CONTROLS THE PROGRAMMED COMMAND MODE. PROGRAMMED COM- * C * MANDS ARE SIMPLY COMMANDS THAT ARE TYPED IN ONCE AND * C * EXECUTED ONCE AFTER EACH MACHINE MOVE IS TYPED OUT. * C * PROGRAMMED COMMAND MODE IS TERMINATED BY TYPING THE * C * 'PC' COMMAND AGAIN. THE NEXT TIME 'PC' IS ENTERED, THE * C * COMMAND BUFFER IS INITIALIZED AND NEW COMMANDS WILL BE * C * ACCEPTED. THE MOST COMMON COMMAND TO USE IN THIS MODE * C * IS THE 'D' COMMAND TO DISPLAY THE BOARD AFTER EACH MA- * C * CHINE MOVE. AS MANY COMMANDS AS DESIRED (UP TO 10) MAY * C * BE USED, WHEN NO MORE COMMANDS ARE TO BE ENTERED, TYPE * C * A BLANK LINE (CARRIAGE RETURN WILL DO). * C * THERE ARE NO RESTRICTIONS AS TO WHAT COMMANDS CAN * C * BE USED, BUT SOME CAUTION SHOULD BE USED. IT WOULD NOT * C * BE WISE TO USE THE 'F' COMMAND AS THE COMMAND PROCESSOR * C * WILL EXPECT YOU TO TYPE IN A MOVE TO FORCE THE COMPUTER * C * TO TAKE. THIS AND OTHERS, WHILE NOT ILLEGAL, ARE IM- * C * PRACTICAL. * C * THE ONLY ABSOLUTE NO-NO IS TO ENTER THE 'PC' COM- * C * MAND AS A PROGRAMMED COMMAND. THIS WILL CAUSE RE- * C * CURSION WITH ATTENDANT PROBLEMS IN FORTRAN. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PC CM/ CMNDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL PCMODE, EXMODE COMMON /BUFFER/ TEXT(30) COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)),(D,ALPHA(4)) IF(TEXT(3).EQ.D) GO TO 100 IF(PCMODE) GO TO 70 C C------------------------------< READ THE COMMANDS IN AND PUT INTO C------------------------------< THE COMMAND BUFFER. C WRITE(6,80) PCMODE=.TRUE. NCMNDS=0 10 NCMNDS=NCMNDS+1 WRITE(6,20) 20 FORMAT(1X,'ENTER COMMAND') READ(5,30)(CMNDS(NCMNDS,I),I=1,3) 30 FORMAT(3R1) IF(CMNDS(NCMNDS,1).EQ.BLANK) GO TO 60 GO TO 10 60 NCMNDS=NCMNDS-1 IF(NCMNDS.EQ.0) PCMODE=.FALSE. RETURN C C------------------------------< TERMINATE PROGRAMMED COMMAND MODE C 70 PCMODE=.FALSE. WRITE(6,90) RETURN 80 FORMAT(1X,'PROGRAMMED COMMAND MODE') 90 FORMAT(1X,'PROGRAMMED COMMAND MODE TERMINATED') C C------------------------------< DISPLAY PROGRAMMED COMMANDS C 100 IF(.NOT. PCMODE) GO TO 130 DO 110 I=1,NCMNDS WRITE(6,120)(CMNDS(I,J),J=1,3) 110 CONTINUE 120 FORMAT(1X,3R1) RETURN 130 WRITE(6,140) 140 FORMAT(1X,'NONE') RETURN END SUBROUTINE PMVMKR C C ************************************************************ C * * C * PMVMKR IS USED TO PERMANANTLY MAKE MOVES ON THE * C * GAME BOARD. IT USES THE USUAL 'MOVER'/'UMOVER' ROU- * C * TINES TO MOVE PIECES AROUND AND THEN CHECKS ON THE STA- * C * TUS OF MOVES AND SQUARES WHICH COULD AFFECT CASTLING * C * STATUS. IT IS ONLY USED TO MAKE HUMAN MOVES AND COM- * C * PUTER MOVES WHEN THEY ARE TO BE MADE AFTER MOVE CAL- * C * CULATION. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) LOGICAL SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,SAVE6 COMMON /K LOC CM/ CKINGL, HKINGL COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 LOGICAL CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /TREE/ DUMMY(480),PLY COMMON /BOARD/ BOARD(120) C C C ENTRY PUMVER CKINGM=SAVE1 CROOKR=SAVE2 CROOKL=SAVE3 HKINGM=SAVE4 HROOKR=SAVE5 HROOKL=SAVE6 CALL UMOVER RETURN C C C ENTRY PMOVER SAVE1=CKINGM SAVE2=CROOKR SAVE3=CROOKL SAVE4=HKINGM SAVE5=HROOKR SAVE6=HROOKL CALL MOVER IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 20 IF(TO8.EQ.22) CROOKR=.TRUE. IF(TO8.EQ.29) CROOKR=.TRUE. IF(TO8.EQ.92) HROOKL=.TRUE. IF(TO8.EQ.99) HROOKR=.TRUE. IF(FROM8.EQ.22) CROOKR=.TRUE. IF(FROM8.EQ.29) CROOKL=.TRUE. IF(FROM8.EQ.92) HROOKL=.TRUE. IF(FROM8.EQ.99) HROOKR=.TRUE. IF(BOARD(TO8).EQ.6) HKINGM=.TRUE. IF(BOARD(TO8).EQ.13) CKINGM=.TRUE. RETURN 20 IF(MOD(PLY,2).EQ.0) HKINGM=.TRUE. IF(MOD(PLY,2).EQ.1) CKINGM=.TRUE. RETURN END LOGICAL FUNCTION PPUSH(SQUARE,SIDE) C C ************************************************************ C * * C * PPUSH IS USED TO DETERMINE IF A PIECE ON 'SQUARE' * C * BE ATTACKED BY PUSHING A PAWN. IF A PAWN CAN BE USED * C * TO ATTACK 'SQUARE' PPUSH IS SET TO TRUE UNLESS THE * C * PAWN CAN BE CAPTURED BY A PAWN ON THE SAME RANK AS * C * 'SQUARE'. DOUBLE RANK ADVANCES ARE ALSO CHECKED FOR * C * PAWNS STILL ON THEIR ORIGINAL SQUARE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) LOGICAL SIDE, PUSH2 COMMON /BOARD/ BOARD(120) PPUSH = .FALSE. PUSH2=.TRUE. IF(SIDE) GO TO 200 100 EPAWN=1 FPAWN=8 DIR=1 IF(SQUARE.LT.51.OR.SQUARE.GT.60) PUSH2=.FALSE. GO TO 300 200 EPAWN=8 FPAWN=1 DIR=-1 IF(SQUARE.LT.61.OR.SQUARE.GT.70) PUSH2=.FALSE. C C------------------------------< CAN A PAWN BE PUSHED ONE RANK TO C------------------------------< ATTACK 'SQUARE'? C 300 IF(BOARD(SQUARE).EQ.FPAWN) RETURN IF(BOARD(SQUARE-2*DIR).EQ.FPAWN) GO TO 400 IF(BOARD(SQUARE+DIR*9).NE.7) GO TO 400 IF(BOARD(SQUARE+DIR*19).EQ.EPAWN) GO TO 9998 C C------------------------------< CAN A PAWN BE PUSHED TWO RANKS TO C------------------------------< ATTACK 'SQUARE'? C IF(.NOT. PUSH2) GO TO 400 IF(BOARD(SQUARE+DIR*19).NE.7) GO TO 400 IF(BOARD(SQUARE+DIR*29).EQ.EPAWN) GO TO 9998 C C------------------------------< CAN A PAWN BE PUSHED ONE RANK TO C------------------------------< ATTACK 'SQUARE'? C 400 IF(BOARD(SQUARE+2*DIR).EQ.FPAWN) GO TO 9999 IF(BOARD(SQUARE+DIR*11).NE.7) GO TO 9999 IF(BOARD(SQUARE+DIR*21).EQ.EPAWN) GO TO 9998 C C------------------------------< CAN A PAWN BE PUSHED TWO RANKS TO C------------------------------< ATTACK 'SQUARE'? C IF(.NOT. PUSH2) GO TO 9999 IF(BOARD(SQUARE+DIR*21).NE.7) GO TO 9999 IF(BOARD(SQUARE+DIR*31).EQ.EPAWN) GO TO 9998 GO TO 9999 C C------------------------------< A PAWN CAN BE PUSHED TO ATTACK C------------------------------< 'SQUARE' BECAUSE: C------------------------------< A) THERE IS A PAWN ON AN ADJACENT C------------------------------< FILE. C------------------------------< B) THE SQUARES IN FRONT OF IT C------------------------------< ARE CLEAR ALLOWING ADVANCE. C------------------------------< C) THE PAWN CANNOT BE CAPTURED C------------------------------< BY AN ENEMY PAWN. C 9998 PPUSH = .TRUE. 9999 RETURN END SUBROUTINE PREANL C C ************************************************************ C * * C * PREANL IS USED TO SET THE PIECE CONTROL BOARDS TO * C * CONTROL PROGRAM STRATEGY. THERE IS A CONTROL BOARD * C * FOR EACH TYPE OF PIECE TO CONTROL HOW TO BEST USE IT * C * IN FORMING STRATEGY. INITIALLY, ALL BOARDS ARE SET TO * C * ATTRACT PIECES TOWARD THE CENTER OF THE BOARD, AND AF- * C * TER DEVELOPMENT IS COMPLETE, THE BOARDS ATTRACT PIECES * C * TOWARD THE VICINITY OF THE OPPONENT'S KING OR GOOD * C * SQUARES TO CONTROL. * C * THEN A SPECIFIC SUBROUTINE IS CALLED FOR EACH PIECE * C * TYPE TO SET SPECIFIC TACTICAL VALUES BEFORE THE ACTUAL * C * SEARCH IS STARTED. FOR EXAMPLE, KNIGHTS ARE DRIVEN * C * AWAY FROM THE EDGE OF THE BOARD, BISHOPS ARE ATTRACTED * C * TO STRONG DIAGONALS, ETC. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /K LOC CM/ CKINGL, HKINGL COMMON /P LOC CM/ CPLOC(8), HPLOC(8), NCPNS, NHPNS COMMON /K BD SM/ CKSCOR(100), HKSCOR(100) COMMON /Q BD SM/ CQSCOR(100), HQSCOR(100) COMMON /R BD SM/ CRSCOR(100), HRSCOR(100) COMMON /B BD SM/ CBSCOR(100), HBSCOR(100) COMMON /N BD SM/ CNSCOR(100), HNSCOR(100) COMMON /P BD SM/ CPSCOR(100), HPSCOR(100) COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /DEV STS/ CDONE, HDONE LOGICAL CDONE, HDONE COMMON /MTRL SC/ CPCVAL, HPCVAL CALL SETPCV OPEN=(HPCVAL+CPCVAL.GT.43200).AND.(MOVE.LE.15) END=HPCVAL+CPCVAL.LT.26400 MIDDLE=.NOT.OPEN .AND. .NOT.END C C------------------------------< DETERMINE IF EACH SIDE HAS COMPLETED C------------------------------< MINOR PIECE DEVELOPMENT. C HDONE=.TRUE. CDONE=.TRUE. IF(MOVE.GT.15) GO TO 550 DO 500 SQ=22,29 IF(BOARD(SQ).EQ.9) CDONE=.FALSE. IF(BOARD(SQ).EQ.10) CDONE=.FALSE. IF(BOARD(SQ+70).EQ.2) HDONE=.FALSE. IF(BOARD(SQ+70).EQ.3) HDONE=.FALSE. C C------------------------------< EITHER SET THE CONTROL BOARDS TO C------------------------------< ATTACK THE OPPONENT'S KING OR THE C------------------------------< CENTER OF THE BOARD DEPENDING ON C------------------------------< THE STAGE OF THE GAME. C 500 CONTINUE 550 CONTINUE CALL LOCATE TEMP=CKINGL IF(OPEN) TEMP=65 CALL SETSQ(HKSCOR,TEMP,PADVNC) TEMP=HKINGL IF(OPEN) TEMP=55 CALL SETSQ(CKSCOR,TEMP,PADVNC) DO 100 I=1,100 CQSCOR(I)=CKSCOR(I) CRSCOR(I)=CKSCOR(I) CBSCOR(I)=CKSCOR(I) CNSCOR(I)=CKSCOR(I) HQSCOR(I)=HKSCOR(I) HRSCOR(I)=HKSCOR(I) HBSCOR(I)=HKSCOR(I) HNSCOR(I)=HKSCOR(I) 100 CONTINUE C C------------------------------< LOCATE THE PAWNS ON THE BOARD TO C------------------------------< DETERMINE WHICH DIRECTION THE PIECES C------------------------------< SHOULD HEAD. C 200 NHPNS=0 NCPNS=0 DO 400 ST=22,29 DO 350 SQ=ST,99,10 IF(BOARD(SQ).NE.1) GO TO 300 NHPNS=NHPNS+1 HPLOC(NHPNS)=SQ GO TO 400 300 IF(BOARD(SQ).NE.8) GO TO 350 NCPNS=NCPNS+1 CPLOC(NCPNS)=SQ 350 CONTINUE 400 CONTINUE CALL SETPBD CALL SETNBD CALL SETBBD CALL SETRBD CALL SETQBD CALL SETKBD RETURN END INTEGER FUNCTION PSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * PSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR PAWN MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE PAWN CONTROL BOARD FOR THE SIDE TO MOVE. (CPSCOR, * C * HPSCOR IN COMMON BLOCK 'P BD SM'). * C * THE SCORE IS ADJUSTED AS INDICATED FOR EACH OF THE * C * FOLLOWING FACTORS PRESENT: C * 1) BONUS FOR ADVANCING A PASSED PAWN * C * 2) BONUS FOR PUSHING A PAWN TO A SQUARE WHERE IT * C * BECOMES PASSED, IE. PUSHING IT PAST A PAWN * C * WHICH COULD CAPTURE IT (EXCHANGING, POSSIBLY). * C * 3) PENALTY FOR DOUBLING/TRIPLING PAWNS. * C * 4) BONUS FOR KEEPING PAWNS CONNECTED. * C * 5) BONUS FOR KEEPING PAWNS ABREAST (FLUID). * C * 6) PENALTY FOR MOVING A PAWN TO A SQUARE WHERE IT * C * IS ISOLATED. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /P BD SM/ CPSCOR(100), HPSCOR(100) LOGICAL SIDE, ISOLAT IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 PSCORE=CPSCOR(SQUARE) FPAWN=8 GO TO 300 C C==============================< HUMAN SCORING C 200 PSCORE=HPSCOR(SQUARE) FPAWN=1 C C------------------------------< ADD IN THE SCORE FOR ADVANCING/ C------------------------------< CREATING A PASSED PAWN BY CALLING C------------------------------< 'PASSED' TO DETERMINE IF A PAWN C------------------------------< ON 'SQUARE' IS PASSED AND IF SO, C------------------------------< IT'S VALUE. C 300 PSCORE=PSCORE+PASSED(SQUARE,SIDE) C C------------------------------< DETERMINE IF THE PAWN IS BEING MOVED C------------------------------< TO A FILE WITH AT LEAST ONE FRIENDLY C------------------------------< PAWN ON IT. IF SO, PENALIZE THE SCORE C------------------------------< FOR DOUBLING/TRIPLING PAWNS. C RANK=MOD(SQUARE,10)+30 RANKE=RANK+50 PCOUNT=1 DO 400 SQ=RANK,RANKE,10 IF(SQ.EQ.SQUARE) GO TO 400 IF(BOARD(SQ).EQ.FPAWN) PCOUNT=PCOUNT+1 400 CONTINUE IF(PCOUNT.LE.1) GO TO 500 PSCORE=PSCORE-DPAWN IF(PCOUNT.EQ.2) GO TO 500 PSCORE=PSCORE-TPAWN C C------------------------------< IF THE PAWN IS ISOLATED, PENALIZE C------------------------------< THE SCORE (THIS CAPTURING MOVE C------------------------------< MAKES THIS PAWN ISOLATED)- C 500 IF(ISOLAT(SQUARE,SIDE)) PSCORE=PSCORE-IPAWN*PCOUNT C C------------------------------< DETERMINE IF THE PAWN IS CONNECTED C------------------------------< WITH FREINDLY PAWNS. IF SO, ADD A C------------------------------< BONUS TO THE MOVE'S SCORE. C L1=SQUARE-10 L2=SQUARE+10 IF(.NOT.SIDE.AND.(SQUARE-1)/10.EQ.5) L1=L1-10 IF(SIDE.AND.(SQUARE-1)/10.EQ.6) L2=L2+10 DO 600 SQ=L1,L2,10 IF(BOARD(SQ-1).EQ.FPAWN) GO TO 700 IF(BOARD(SQ+1).EQ.FPAWN) GO TO 700 600 CONTINUE GO TO 800 700 PSCORE=PSCORE+CPAWN C C------------------------------< DETERMINE IF THE PAWN IS ABREAST OF C------------------------------< WITH A FREINDLY PAWN (FLUID PAWN C------------------------------< STRUCTURE). IF SO, ADD A BONUS TO C------------------------------< THE MOVE'S SCORE. C IF(BOARD(SQUARE-1).EQ.FPAWN.OR.BOARD(SQUARE+1).EQ.FPAWN) * PSCORE=PSCORE+ABREST 800 RETURN END INTEGER FUNCTION QSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * QSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR QUEEN MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE QUEEN CONTROL BOARD FOR THE SIDE TO MOVE. (CQSCOR, * C * HQSCOR IN COMMON BLOCK 'Q BD SM'). * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /Q BD SM/ CQSCOR(100), HQSCOR(100) LOGICAL SIDE IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 QSCORE=CQSCOR(SQUARE) RETURN C C==============================< HUMAN SCORING C 200 QSCORE=HQSCOR(SQUARE) RETURN END SUBROUTINE QUERY C C ************************************************************ C * * C * QUERY IS USED TO QUERY THE OPERATOR ABOUT THE * C * AMOUNT OF TIME REMAINING ON THE PROGRAM'S CHESS CLOCK. * C * FOR THE FIRST THIRTY MOVES, THE QUERY IS MADE EACH 10 * C * MOVES; AFTER THAT THE QUERY IS MADE EACH 3 MOVES. FOR * C * EXAMPLE, THE OPERATOR WOULD BE ASKED ON MOVE 10,20,30, * C * 33,36,39,43,46,49,53,56,59. NOTICE THAT AFTER 30 MOVES,* C * EVERY 3RD IS USED, SKIPPING THE 10TH SINCE THE CLOCK * C * IS RESET EACH 10TH MOVE IN TOURNAMENT PLAY. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (C,ALPHA(3)),(D,ALPHA(4)) COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /BUFFER/ TEXT(30) LOGICAL CLOCK, CQUERY C------------------------------< IF MORE THAT 10 MOVES REMAIN IN THE C------------------------------< TIMING INTERVAL, ONLY ASK EVERY C------------------------------< 10 MOVES. C IF(MOVES-NCMOVS.LE.10) GO TO 100 IF(MOD(NCMOVS,10).EQ.0) GO TO 200 GO TO 999 C C------------------------------< IF FEWER THAN 10 MOVES REMAIN, ASK ON C------------------------------< EACH 3RD MOVE, NOT COUNTING EACH C------------------------------< 10TH MOVE (33,36,39,43,46,49,ETC) C 100 MOVE=MOVES-NCMOVS IF(MOVE.EQ.10) GO TO 999 IF(MOD(MOVE,3).NE.0) GO TO 999 200 TEXT(2)=D CALL CCMND(6) TEXT(2)=C TEXT(3)=C CALL CCMND(6) 999 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE RCMND(RESTRT) C C ************************************************************ C * * C * RCMND IS USED TO PROCESS THE 'R' COMMAND WHICH CAN * C * RESET THE BOARD TO THE POSITION AFTER ANY PRIOR MOVE. * C * THE BOARD IS ALWAYS RESET TO THE POSITION FOR THE MOVE * C * INDICATED, SO THAT IT IS THE HUMAN'S TURN TO MOVE. FOR * C * EXAMPLE, IF THE COMPUTER IS WHITE, AND YOU WISH TO BACK * C * UP TO MOVE 15, THE MOVE FOR BLACK LISTED UNDER MOVE 15 * C * WOULD NOT BE MADE. * C * 'RK' IS AN ALTERNATIVE WAY TO SET THE BOARD TO *^] C * SET UP A BOARD POSITION. IN THIS MODE, YOU CAN KEY * C * MOVES IN FOR BOTH SIDES, STARTING WITH WHITE. THE * C * MOVES WILLBE MADE AS YOU ENTER THEM, TERMINATING * C * WHEN THE CORRECT NUMBER HAVE BEEN TYPED IN OR BY * C * END-OF-FILE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BUFFER/ TEXT(30) COMMON /HIST CM/ NMOVES, ANNOTE COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR COMMON /TREE/ TREE(480), PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /V CM/ VCMOVE COMMON /CHR SET/ ALPHA(44) EQUIVALENCE (K,ALPHA(11)) CHARACTER*5 CCOLOR, HCOLOR DATA ZERO / 0J / KEYIN=0 IF (RESTRT.EQ.1)GOTO 99 IF(TEXT(2).EQ.K) KEYIN=1 5 IF(KEYIN.EQ.0) WRITE(6,10) IF(KEYIN.EQ.1) WRITE(6,11) 11 FORMAT(1X,'HOW MANY MOVES?') 10 FORMAT(1X,'RESET BOARD TO WHICH MOVE?') CALL INPUT(MOVENO) IF(MOVENO.EQ.0) RETURN 99 IF((KEYIN.EQ.1).OR.(RESTRT.EQ.1)) NMOVES=999 PLY=1 IF(COLOR.EQ.1) PLY=0 C C------------------------------< DETERMINE EXACTLY HOW MANY MOVES C------------------------------< TO PROCESS. LEAVE THE HUMAN'S LAST C------------------------------< MOVE OUT SO IT WILL BE HIS TURN. C NCMOVS=MOVENO NHMOVS=MOVENO IF(COLOR.EQ.1) NHMOVS=NHMOVS-1 MOVENO=MOVENO*2 IF(COLOR.EQ.1) MOVENO=MOVENO-1 C IF(MOVENO.GT.NMOVES) GO TO 60 NMOVES=MOVENO CALL SETGB COUNT=0 TEMP1=ORDER1 TEMP2=ORDER2 ORDER1=0 ORDER2=0 C C------------------------------< NOW, EITHER READ THE MOVE FILE OR C------------------------------< FROM THE USER THE LIST OF MOVES C------------------------------< TO MAKE. C 30 PLY=2-MOD(PLY+1,2) COUNT=COUNT+1 IF(COUNT.GT.MOVENO) GO TO 45 IF(KEYIN.EQ.1) GO TO 35 READ(1@COUNT,END=999)TEXT GO TO 37 35 READ(5,100,END=45) TEXT 100 FORMAT(30R1) WRITE(1@COUNT) TEXT, ZERO, ZERO 37 CALL INMOVE(PLY,$35) 40 CALL PMOVER GO TO 30 45 ORDER1=TEMP1 ORDER2=TEMP2 CALL ENTERD(VCMOVE) RETURN 60 WRITE(6,70) 70 FORMAT(1X,'THAT MOVE HASN''T BEEN MADE YET!') GO TO 5 999 NMOVES=COUNT-1 NHMOVS=NMOVES/2 NCMOVS=NHMOVS RESTRT=0 RETURN END $CONTROL SEGMENT=PC SUBROUTINE ROOK C C ************************************************************ C * * C * ROOK GENERATES ALL ROOK MOVES AND VERTICAL/HORI- * C * ZONTAL MOVES FOR THE QUEEN. SUBROUTINE SCORE IS CALLED * C * TO COMPUTE THE PLAUSIBILITY SCORE FOR THE MOVE, AFTER * C * WHICH THE MOVE IS ENTERED IN THE MOVE LIST. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE LOGICAL SIDE, CHECK COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE 1000 DO 1030 I=1,4 TO8=FROM8 DIREC=RK(I) 1010 TO8=TO8+DIREC TOSQ=BOARD(TO8) TYPE8=NORMAL IF(SIDE.AND.TOSQ.LT.7) GO TO 1030 IF(.NOT.SIDE.AND.TOSQ.GT.7) GO TO 1030 IF(TOSQ.EQ.14) GO TO 1030 BOARD(TO8)=FROMSQ IF(CHECK(SIDE)) GO TO 1020 CALL SCORE CALL ENTER 1020 BOARD(TO8)=TOSQ IF(TOSQ.EQ.7) GO TO 1010 1030 CONTINUE RETURN END INTEGER FUNCTION RSCORE(SQUARE,SIDE) C C ************************************************************ C * * C * RSCORE IS USED TO COMPUTE THE PLAUSIBILITY SCORE * C * FOR ROOK MOVES. THE SCORE IS OBTAINED DIRECTLY FROM * C * THE ROOK CONTROL BOARD FOR THE SIDE TO MOVE. (CRSCOR, * C * HRSCOR IN COMMON BLOCK 'R BD SM'). * C * THE SCORE IS ADJUSTED AS INDICATED FOR EACH OF THE * C * FOLLOWING FACTORS PRESENT: * C * 1) BONUS FOR MOVING TO THE 7TH OR 8TH RANK WHILE * C * THE OPPONENT'S KING IS STILL ON THE 8TH RANK. * C * 2) BONUS FOR MOVING TO AN OPEN OR HALF OPEN FILE. * C * 3) BONUS FOR DOUBLING ROOKS ON AN OPEN FILE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /R BD SM/ CRSCOR(100), HRSCOR(100) COMMON /MOVES/ RK(4),BP(4),KT(8),KG(8) COMMON /R SM/ ERMOVE, RANK78, ROPEN, RHALF, DROOKS, CROOKS, * RPASS, R EDGE COMMON /K LOC CM/ CKINGL, HKINGL COMMON /R LOC CM/ ONECRK, ONEHRK COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END LOGICAL ONECRK, ONEHRK, SIDE, CP, HP, NOTTWO NOTTWO=.FALSE. IF(SIDE) GO TO 200 C C==============================< COMPUTER SCORING C 100 RSCORE=CRSCOR(SQUARE) ROOK=11 PAWN=8 150 IF(ONECRK) GO TO 275 GO TO 300 C C==============================< HUMAN SCORING C 200 RSCORE=HRSCOR(SQUARE) ROOK=4 PAWN=1 250 IF(.NOT.ONEHRK) GO TO 300 275 NOTTWO=.TRUE. C C------------------------------< DETERMINE IF THERE ARE PAWNS ON C------------------------------< FILE AND WHICH SIDE THEY BELONG TO. C 300 CP=.FALSE. HP=.FALSE. J=MOD(SQUARE,10)+30 DO 500 I=J,90,10 T=BOARD(I) IF(T.NE.1) GO TO 400 HP=.TRUE. H=I GO TO 500 400 IF(T.NE.8) GO TO 500 CP=.TRUE. C=I 500 CONTINUE C C------------------------------< IF THERE ARE NO PAWNS, ADD A BONUS C------------------------------< FOR MOVING A ROOK TO AN OPEN FILE. C IF(HP.AND.CP) GO TO 9999 IF(HP.OR.CP) GO TO 900 RSCORE=RSCORE+ROPEN C C------------------------------< CHECK TO SEE IF THERE IS ANOTHER C------------------------------< ROOK ON THIS FILE. IF SO, ADD A C------------------------------< BONUS FOR DOUBLING ON AN OPEN FILE. C IF(NOTTWO) GO TO 9999 DO 700 I=1,2 SQ=SQUARE DIREC=RK(I) 600 SQ=SQ+DIREC TEMP=BOARD(SQ) IF(TEMP.EQ.7) GO TO 600 IF(TEMP.EQ.ROOK) GO TO 800 700 CONTINUE GO TO 9999 800 RSCORE=RSCORE+DROOKS GO TO 9999 C C------------------------------< IF THERE IS ONE PAWN ON THIS FILE, C------------------------------< AND IT DOES NOT BELONG TO THE SIDE C------------------------------< TO MOVE, ADD A BONUS FOR MOVING A C------------------------------< ROOK TO A HALF-OPEN FILE. C 900 IF(SIDE) GO TO 950 IF(HP) RSCORE=RSCORE+RHALF GO TO 975 950 IF(CP) RSCORE=RSCORE+RHALF C C------------------------------< IF THE FILE HAS PAWNS PRESENT, C------------------------------< CHECK TO SEE IF ONE IS PASSED. IF C------------------------------< SO, ADD A BONUS TO THE SCORE TO C------------------------------< ENCOURAGE THE ROOKS TO GET BEHIND C------------------------------< THE PAWN. ====== C 975 IF(OPEN) GO TO 9999 IF(SIDE) GO TO 2000 1000 IF(CP) GO TO 1100 TEMP=PASSED(H,.NOT.SIDE) IF(TEMP.EQ.0) GO TO 9999 IF(SQUARE.GT.H) RSCORE=RSCORE+RPASS+TEMP/2 GO TO 9999 1100 TEMP=PASSED(C,SIDE) IF(TEMP.EQ.0) GO TO 9999 IF(SQUARE.LT.C) RSCORE=RSCORE+RPASS+TEMP/2 GO TO 9999 2000 IF(HP) GO TO 2100 TEMP=PASSED(C,.NOT.SIDE) IF(TEMP.EQ.0) GO TO 9999 IF(SQUARE.LT.C) RSCORE=RSCORE+RPASS+TEMP/2 GO TO 9999 2100 TEMP=PASSED(H,SIDE) IF(TEMP.EQ.0) GO TO 9999 IF(SQUARE.GT.H) RSCORE=RSCORE+RPASS+TEMP/2 9999 RETURN END SUBROUTINE SAVER C C ************************************************************ C * * C * SAVER WITH IT'S TWO ENTRY POINTS 'SAVE GB' AND * C * 'REST GB' IS USED TO SAVE/RESTORE THE GAME BOARD AND * C * CASTLING STATUS. THIS IS USED BY ROUTINES WHICH * C * MUST MODIFY THE GAME BOARD TO PROCESS VARIOUS COMMANDS * C * AND THEN NEED TO RESTORE IT TO 'AS IT WAS' AFTER FIN- * C * ISHING PROCESSING. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /SAVE CM/ SBOARD(100) COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL LOGICAL SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,SAVE6 LOGICAL CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL C C C ENTRY SAVE GB DO 10 I=1,100 SBOARD(I)=BOARD(I) 10 CONTINUE SAVE1=CKINGM SAVE2=CROOKR SAVE3=CROOKL SAVE4=HKINGM SAVE5=HROOKR SAVE6=HROOKL RETURN C C C ENTRY REST GB DO 20 I=1,100 BOARD(I)=SBOARD(I) 20 CONTINUE CKINGM=SAVE1 CROOKR=SAVE2 CROOKL=SAVE3 HKINGM=SAVE4 HROOKR=SAVE5 HROOKL=SAVE6 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE SCMND(*) C C ************************************************************ C * * C * SCMND IS USED TO CONTROL THE PRUNING OF THE TREE * C * DURING MOVE CALCULATION. THERE ARE FOUR BASIC PRUNING * C * FUNCTIONS TO CONTROL: * C * 1) 'SD' : LOOK-AHEAD DEPTH CONTROL. THIS CONTROLS * C * HOW FAR THE PROGRAM LOOKS AHEAD IN TERMS OF * C * HALF MOVES OR 'PLIES'. * C * 2) 'SW' : FORWARD PRUNING WIDTHS. THIS CONTROLS * C * 'FANOUT' OR NUMBER OF MOVES AT EACH LEVEL THE * C * PROGRAM WILL CONSIDER. FOR EXAMPLE, IF ON THE * C * FIRST PLY, THE MACHINE HAS 40 LEGAL MOVES AND * C * PRUNING WIDTH FOR PLY 1 IS SET AT 20, ONLY THE * C * BEST (HOPEFULLY) 20 MOVES WILL BE CONSIDERED, * C * IGNORING THE BOTTOM 20. THIS CAN RESULT IN A * C * TREMENDOUS SPEED-UP IN MOVE CALCULATION TIME, * C * BUT CAN ALSO RESULT IN PATHETIC BLUNDERS SINCE * C * THE PROGRAM CAN'T KNOW WHICH ARE THE BEST 20 * C * MOVES UNTIL IT HAS ACTUALLY LOOKED AT THEM. THIS* C * SOMEWHAT PROBABLISTIC PRUNING STILL IS QUITE AD- * C * VANTAGEOUS JUST TO IGNORE THE LAST 5 MOVES. * C * 'SW1' SETS THE MINIMUM FORWARD PRUNING WIDTHS * C * (ALSO THE DEFAULTS IF TIMING IS NOT IN EFFECT) * C * FOR THE PROGRAM TO USE. 'SW2' SETS THE MAXIMUM * C * VALUES THE WIDTHS MAY BE ADJUSTED TO WHEN USING * C * THE CLOCK TO CONTROL SEARCH TIME. * C * 3) 'S1' CHECK RE-ORDERING LEVEL. THIS IS THE LIMIT * C * BELOW WHICH ALL CHECKING MOVES ARE EXAMINED. * C * AFTER MOVE GENERATION, THE MOVE LIST IS RE- * C * ORDERED ACCORDING TO NORMAL RULES AND FORWARD * C * PRUNING IS DONE. IF BELOW THE CHECK RE-ORDERING * C * LEVEL, ALL CHECKING MOVES THAT WERE FORWARD * C * PRUNED ARE MOVED UP AND THE WIDTH IS INCREASED * C * TO INCLUDE THEM AS WELL. THIS WILL HELP THE * C * PROGRAM FIND MATES AND AVOID THEM AS WELL. * C * 4) 'S2' CAPTURE RE-ORDERING LEVEL. THIS IS THE * C * LIMIT BELOW WHICH ALL CAPTURES WILL BE EXAMINED, * C * EVEN IF THE CAPTURE IS A SACRIFICE OR LOSS. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BUFFER/ TEXT(30) COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (D,ALPHA(4)),(W,ALPHA(23)), *(ONE,ALPHA(28)),(TWO,ALPHA(29)),(QUEST,ALPHA(43)) IF(TEXT(2).EQ.ONE) GO TO 13 IF(TEXT(2).EQ.TWO) GO TO 55 IF(TEXT(2).EQ.W) GO TO 3 IF(TEXT(2).EQ.QUEST) GO TO 17 IF(TEXT(2).NE.D) RETURN 1 C C------------------------------< SD : SET MAXIMUM LOOK-AHEAD DEPTH C WRITE(6,1)DEPTH 1 FORMAT(1X,'MAXIMUM LOOK AHEAD IS NOW ',I2) IF(TEXT(3).EQ.D) GO TO 999 105 WRITE(6,12) CALL INPUT(DEP) IF(DEP.EQ.0) GO TO 999 IF(DEP.LT.2.OR.DEP.GT.10) GO TO 201 DEPTH=DEP GO TO 999 201 WRITE(6,202) 202 FORMAT(1X,'LEGAL RANGE IS 2-10') GO TO 105 12 FORMAT(1X,'ENTER MAXIMUM LOOK-AHEAD (PLY) ') C C------------------------------< SW : SET SEARCH WIDTH LIMITS C 3 IF(TEXT(3).EQ.TWO) GO TO 100 IF(TEXT(3).EQ.D) GO TO 10 I=1 4 WRITE(6,5)I 5 FORMAT(1X,'ENTER DEFAULT WIDTH FOR PLY ',I2) 6 CALL INPUT(WT) IF(WT.EQ.0) GO TO 8 WIDTH(I)=WT MIN(I)=WT I=I+1 IF(I.LT.DEPTH) GO TO 4 GO TO 10 8 IF(I.EQ.1) GO TO 10 DO 9 J=I,10 WIDTH(J)=WIDTH(I-1) MIN(J)=MIN(J-1) 9 CONTINUE GO TO 10 100 I=1 400 WRITE(6,500)I 500 FORMAT(1X,'ENTER MAXIMUM WIDTH FOR PLY ',I2) 600 CALL INPUT(WT) IF(WT.EQ.0) GO TO 800 MAX(I)=WT I=I+1 IF(I.LT.DEPTH) GO TO 400 GO TO 10 800 IF(I.EQ.1) GO TO 10 DO 900 J=I,10 MAX(J)=MAX(I-1) 900 CONTINUE 10 LIMIT=DEPTH-1 WRITE(6,11)(I,MIN(I),WIDTH(I),MAX(I),I=1,LIMIT) WRITE(6,111)DEPTH 111 FORMAT(1X,I2,3X,' 1',5X,'??',4X,'99') GO TO 999 11 FORMAT(1X,'PLY',2X,'MIN',2X,'WIDTH',2X,'MAX'/(1X,I2,2X,I3 *,4X,I3,3X,I3)) C C------------------------------< S1 : SET CHECK REORDERING LEVEL C 13 WRITE(6,14)ORDER1 14 FORMAT(1X,'CHECK REORDERING LEVEL IS ',I2) IF(TEXT(3).EQ.D) GO TO 999 WRITE(6,151) 15 CALL INPUT(ORDER1) IF(ORDER1.GE.0.AND.ORDER1.LE.DEPTH) GO TO 999 WRITE(6,16)DEPTH 16 FORMAT(1X,'LEGAL RANGE IS 0-',I2) 151 FORMAT(1X,'ENTER PLAUSIBILITY REORDERING LEVEL') GO TO 15 C C------------------------------< S2 : SET CAPTURE REORDERING LEVEL C 55 WRITE(6,141)ORDER2 141 FORMAT(1X,'CAPTURE REORDERING LEVEL IS ',I2) IF(TEXT(3).EQ.D) GO TO 999 WRITE(6,151) 56 CALL INPUT(ORDER2) IF(ORDER2.GE.0.AND.ORDER2.LE.DEPTH) GO TO 999 WRITE(6,16)DEPTH GO TO 56 C C------------------------------< S? : PRUNE CONTROL HELP C 17 WRITE(6,18) 18 FORMAT( *1X,'SD : SET MAXIMUM LOOK AHEAD (IN PLY)'/ *1X,'SW : SET FORWARD PRUNING WIDTHS'/ *1X,'SW1: SET DEFAULT/MINIMUM WIDTHS'/ *1X,'SW2: SET MAXIMUM WIDTHS'/ *1X,'S1 : SET MAX LEVEL TO INCLUDE ALL CHECKS'/ *1X,'S2 : SET MAX LEVEL TO INCLUDE ALL UNSAFE CAPTURES'/ *) 999 RETURN END SUBROUTINE SCORE C C ************************************************************ C * * C * THIS SUBROUTINE PERFORMS ALL PLAUSIBLITY SCORING * C * FOR MOVES AS THEY ARE GENERATED. AFTER CALLING THE * C * APPROPRIATE SCORING MODULE, OTHER PLAUSIBILITY ANALYSIS * C * IS CARRIED OUT IF THIS IS A PIECE MOVE. INDIVIDUAL * C * SCORING ALGORITHMS AND CALLS ARE EXPLAINED BELOW. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 EQUIVALENCE (RVAL,VALUE8) COMMON / MOVE CM / FROMSQ, TOSQ, SIDE COMMON /K LOC CM/ CKINGL, HKINGL COMMON /B LOC CM/ ONECBP, ONEHBP COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /B SM/ EBMOVE, LDIAG, BPAIR COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO LOGICAL ONECBP, ONEHBP, SIDE, ISOLAT COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOT COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END C C------------------------------< DETERMINE PAWN VALUES C FPAWN=1 EPAWN=8 IF(SIDE) GO TO 131 FPAWN=8 EPAWN=1 131 CONTINUE C C==============================< SCORE IS DEFINED AS THE VALUE OF C==============================< THE SQUARE WE'RE MOVING TO MINUS C==============================< THE SQUARE WE'RE MOVING FROM C GO TO (10,20,30,40,50,60,9999,10,20,30,40,50,60,9999),FROMSQ 10 VALUE8=PSCORE(TO8,SIDE) IF(.NOT.END) VALUE8=VALUE8+EXPOSE(SIDE) C C----------------------< CHECK TO SEE IF CAPTURING WITH THIS C----------------------< PAWN CAUSES A FRIENDLY PAWN TO C----------------------< BECOME 'UN-ISOLATED'. IF SO, ADD C----------------------< A BONUS TO THE SCORE. C IF(TOSQ.EQ.7) GO TO 16 FILE=IABS(FROM8-TO8)-10 IF(.NOT.SIDE) FILE=-FILE 13 FILEST=MOD(TO8-FILE,10)+30 FILEND=FILEST+50 DO 14 SQ=FILEST,FILEND,10 IF(BOARD(SQ).EQ.FPAWN) GO TO 15 14 CONTINUE GO TO 155 15 BOARD(TO8)=7 IF(ISOLAT(SQ,SIDE)) VALUE8=VALUE8+IPAWN BOARD(TO8)=FROMSQ IF(TYPE8.EQ.PROMOT) BOARD(TO8)=FROMSQ+4 155 CONTINUE C C----------------------< CHECK TO SEE IF CAPTURING WITH THIS C----------------------< PAWN ALSO CAUSES A FREINDLY PAWN TO C----------------------< BECOME ISOLATED. IF SO, PENALIZE THE C----------------------< SCORE. C FILEST=MOD(FROM8+FILE,10)+30 FILEND=FILEST+50 DO 11 SQ=FILEST,FILEND,10 IF(BOARD(SQ).EQ.FPAWN) GO TO 12 11 CONTINUE GO TO 175 12 IF(ISOLAT(SQ,SIDE)) VALUE8=VALUE8-IPAWN 175 CONTINUE C C----------------------< ADD A BONUS TO THE SCORE FOR ATTACKING C----------------------< A PIECE SINCE IT WILL MOST LIKELY HAVE C----------------------< TO MOVE AWAY. C 16 VALUE8=VALUE8+PATACK(TO8,SIDE) GO TO 99 20 VALUE8=NSCORE(TO8,SIDE) GO TO 70 30 VALUE8=BSCORE(TO8,SIDE) GO TO 70 40 VALUE8=RSCORE(TO8,SIDE) GO TO 70 50 VALUE8=QSCORE(TO8,SIDE) GO TO 70 60 VALUE8=KSCORE(TO8,SIDE) 70 IF(OPEN) GO TO 99 VALUE8=VALUE8+BLOCK(TO8,SIDE) C C==============================< SUBTRACT VALUE OF SQUARE THIS MOVE C==============================< IS VACATING. C 99 BOARD(TO8)=TOSQ BOARD(FROM8)=FROMSQ GO TO (101,201,301,401,501,601,9999, * 101,201,301,401,501,601,9999),FROMSQ 101 VALUE8=VALUE8-PSCORE(FROM8,SIDE) IF(END) GO TO 999 VALUE8=VALUE8-EXPOSE(SIDE) GO TO 999 201 VALUE8=VALUE8-NSCORE(FROM8,SIDE) GO TO 701 301 VALUE8=VALUE8-BSCORE(FROM8,SIDE) GO TO 701 401 VALUE8=VALUE8-RSCORE(FROM8,SIDE) GO TO 701 501 VALUE8=VALUE8-QSCORE(FROM8,SIDE) GO TO 701 601 VALUE8=VALUE8-KSCORE(FROM8,SIDE) 701 IF(OPEN) GO TO 999 VALUE8=VALUE8-BLOCK(FROM8,SIDE) 999 BOARD(TO8)=FROMSQ BOARD(FROM8)=7 IF(TYPE8.EQ.PROMOT) BOARD(TO8)=FROMSQ+4 C C C----------------------< IF MOVING A PIECE BACK TO WHERE C----------------------< IT WAS EARLIER IN THE TREE, THEN C----------------------< PENALIZE THE MOVES'S SCORE C 1000 IF(PLY.LE.2) GO TO 1010 IF(END) GO TO 1010 ST=2-MOD(PLY,2) EN=PLY-2 DO 1020 I=ST,EN,2 IF(TO8.EQ.FROM(I).AND.FROM8.EQ.TO(I)) GO TO 1030 1020 CONTINUE GO TO 1010 1030 VALUE8=VALUE8-TEMPO C C C==============================< ADD IN THE TACTICAL SCORE FOR THE C==============================< PIECE WE ARE CAPTURING (IF ANY) C 1010 GO TO (100,200,300,400,500,600,9999, * 100,200,300,400,500,600,9999),TOSQ 100 VALUE8=VALUE8+PVALUE(TOSQ)+PSCORE(TO8,.NOT.SIDE) FILE=MOD(TO8,10)-1 C C----------------------< ADD A BONUS TO THE SCORE IF CAPTURING C----------------------< A PAWN WHICH IS ATTACKING A PIECE. C VALUE8=VALUE8+PATACK(TO8,.NOT.SIDE) C C----------------------< SEE IF CAPTURING THIS ENEMY PAWN C----------------------< HAS CREATED A PASSED PAWN ON THIS C----------------------< OR AN ADJACENT FILE. IF SO, ADJUST C----------------------< THE SCORE TO REFLECT THIS. C DIR=-1 IF(SIDE) DIR=1 130 L1=TO8-1 L2=TO8+1 DO 160 FILE=L1,L2 SQ=FILE 140 SQ=SQ+DIR*10 IF(BOARD(SQ).EQ.FPAWN) GO TO 150 IF(BOARD(SQ).NE.14) GO TO 140 GO TO 160 150 VALUE8=VALUE8+PASSED(SQ,SIDE) 160 CONTINUE C C----------------------< DETERMINE IF CAPTURING THIS PAWN C----------------------< WILL RESULT IN THE SIDE NOT TO MOVE C----------------------< HAVING AN ISOLATED PAWN. IF SO, ADD C----------------------< A BONUS TO THE SCORE. C SQTO=TO8-1 165 FILEST=MOD(SQTO,10)+30 FILEND=FILEST+50 DO 170 SQ=FILEST,FILEND,10 IF(BOARD(SQ).EQ.EPAWN) GO TO 180 170 CONTINUE GO TO 190 180 IF(ISOLAT(SQ,.NOT.SIDE)) VALUE8=VALUE8+IPAWN 190 SQTO=SQTO+2 IF(SQTO.EQ.TO8+1) GO TO 165 GO TO 9999 200 VALUE8=VALUE8+PVALUE(TOSQ)+NSCORE(TO8,.NOT.SIDE) GO TO 9999 300 VALUE8=VALUE8+PVALUE(TOSQ)+BSCORE(TO8,.NOT.SIDE) C C----------------------< IF CAPTURING ONE OF A PAIR OF BISHOPS C----------------------< ADD A BONUS FOR ELIMINATING THIS C----------------------< STRATEGIC ADVANTAGE C IF(SIDE) GO TO 305 IF(.NOT. ONEHBP) VALUE8=VALUE8+BPAIR GO TO 9999 305 IF(.NOT. ONECBP) VALUE8=VALUE8+BPAIR GO TO 9999 400 VALUE8=VALUE8+PVALUE(TOSQ)+RSCORE(TO8,.NOT.SIDE) GO TO 9999 500 VALUE8=VALUE8+PVALUE(TOSQ)+QSCORE(TO8,.NOT.SIDE) GO TO 9999 600 CONTINUE 9999 RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETBBD C C ************************************************************ C * * C * SETBBD IS USED TO SET THE BISHOP CONTROL BOARDS IN * C * COMMON BLOCK 'B BD SM'. THE BOARD IS SET UP EITHER * C * AROUND THE CENTER OR AROUND THE OPPONENT'S KING BASED * C * ON WHETHER OR NOT THE OPENING IS COMPLETE. THE * C * FOLLOWING SCORING CONSIDERATIONS ARE INCLUDED IN THE * C * CONTROL BOARD: * C * 1) THE SQUARES IN FRONT OF UNMOVED CENTER PAWNS ARE * C * GIVEN PENALTIES TO PREVENT BLOCKING THEM IN. * C * 2) A BONUS IS GIVEN TO EJECT THE BISHOPS FROM THE * C * BACK ROW IN THE OPENING OF THE GAME. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /BOARD/ BOARD(120) COMMON /B BD SM/ CBSCOR(100), HBSCOR(100) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL LOGICAL CKINGM, CROOKR, CROOKL, HKINGM, HROOKR, HROOKL COMMON /CAST SM/ CAST SC, UB CAST COMMON /B SM/ EBMOVE, LDIAG, BPAIR COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO COMMON /DEV STS/ CDONE, HDONE LOGICAL CDONE, HDONE LOGICAL LEFT, RIGHT C C------------------------------< ADJUST THE CONTROL BOARD TO PREVENT C------------------------------< POSTING A BISHOP IN FRONT OF CENTER C------------------------------< PAWNS THAT HAVEN'T BEEN MOVED. C IF(.NOT. OPEN) GO TO 50 IF(BOARD(35).EQ.8) CBSCOR(45)=CBSCOR(45)-BPAWN IF(BOARD(36).EQ.8) CBSCOR(46)=CBSCOR(46)-BPAWN IF(BOARD(35).EQ.8.OR.BOARD(45).EQ.8) * CBSCOR(55)=CBSCOR(55)-BPAWN IF(BOARD(36).EQ.8.OR.BOARD(46).EQ.8) * CBSCOR(56)=CBSCOR(56)-BPAWN IF(BOARD(85).EQ.1) HBSCOR(75)=HBSCOR(75)-BPAWN IF(BOARD(86).EQ.1) HBSCOR(76)=HBSCOR(76)-BPAWN IF(BOARD(85).EQ.1.OR.BOARD(75).EQ.1) * HBSCOR(65)=HBSCOR(65)-BPAWN IF(BOARD(86).EQ.1.OR.BOARD(76).EQ.1) * HBSCOR(66)=HBSCOR(66)-BPAWN 50 CONTINUE C C------------------------------< IF IN THE OPENING, ADJUST THE CONTROL C------------------------------< BOARD TO FORCE BISHOPS OFF OF THE C------------------------------< BACK RANK (DEVELOP) C IF(CDONE) GO TO 100 CBSCOR(24)=CBSCOR(24)+EBMOVE CBSCOR(27)=CBSCOR(27)+EBMOVE 100 CONTINUE IF(CKINGM) GO TO 300 IF(CROOKR) GO TO 200 CBSCOR(24)=CBSCOR(24)+UB CAST 200 IF(CROOKL) GO TO 300 CBSCOR(27)=CBSCOR(27)+UB CAST 300 CONTINUE IF(HDONE) GO TO 400 HBSCOR(94)=HBSCOR(94)+EBMOVE HBSCOR(97)=HBSCOR(97)+EBMOVE 400 CONTINUE IF(HKINGM) GO TO 600 IF(HROOKR) GO TO 500 HBSCOR(97)=HBSCOR(97)+UB CAST 500 IF(HROOKL) GO TO 600 HBSCOR(94)=HBSCOR(94)+UB CAST 600 CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETBRD C C ************************************************************ C * * C * SETBRD IS USED TO SET UP THE BOARD IN ANY POSITION * C * DESIRED. IT USES A FORSYTHE LIKE STRING OF CHARACTERS * C * TO DESCRIBE THE BOARD POSITION. THE BOARD SQUARES * C * ARE NUMBERED AS FOLLOWS: * C * * C * 1 2 3 4 5 6 7 8 * C * 9 10 11 12 13 14 15 16 * C * 17 18 19 20 21 22 23 24 * C * 25 26 27 28 29 30 31 32 * C * 33 34 35 36 37 38 39 40 * C * 41 42 43 44 45 46 47 48 * C * 49 50 51 52 53 54 55 56 * C * 57 58 59 60 61 62 63 64 * C * * C * USING STANDARD PIECE CODES, SIMPLY TYPE IN THE * C * CODE FOR THE PIECE YOU WISH TO PLACE THERE STARTING * C * WITH COMPUTER PIECES. USE A NUMBER BETWEEN 1 AND 8 TO * C * INDICATE EMPTY SQUARES. WHEN ALL COMPUTER PIECES ARE * C * DEFINED, TYPE A '.' OR PERIOD IN THE STRING. CONTINUING,* C * START BACK AT SQUARE 1 AND START DEFINING HUMAN PIECES. * C * FOR EXAMPLE, 'K2R4PPP.88888Q75PPP7K ' WOULD DEFINE THE * C * FOLLOWING BOARD POSITION: * C * * C * CK * * CR * * * * * C * CP CP CP * * * * * * C * * * * * * * * * * C * * * * * * * * * * C * * * * * * * * * * C * HQ * * * * * * * * C * * * * * * HP HP HP * C * * * * * * * * HK * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /K LOC CM/ CKINGL, HKINGL COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR LOGICAL CKINGM,CROOKR,CROOKL,MODIFY,HKINGM,HROOKR,HROOKL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /BOARD/ BOARD(120) INTEGER*4 CHAR(16), INPUT(72) COMMON /TREE/ TREE(400),DMY(81) COMMON /V CM/ VCMOVE COMMON /BUFFER/ TEXT(30) COMMON /CHR SET/ ALPHA(44) EQUIVALENCE (O,ALPHA(15)) EQUIVALENCE (TREE(1), INPUT(1)) DATA CHAR /%"P"J,%"N"J,%"B"J,%"R"J,%"Q"J,%"K"J,%" "J, *%"."J,%"1"J,%"2"J,%"3"J,%"4"J,%"5"J,%"6"J,%"7"J,%"8"J/ 9999 WRITE(6,6) 6 FORMAT(1X,'ENTER BOARD POSITION') READ(5,5)INPUT 5 FORMAT(72R1) IF(INPUT(1).EQ.%' ') GO TO 6000 CKINGM = .FALSE. HKINGM = .FALSE. CROOKR = .FALSE. CROOKL = .FALSE. HROOKR = .FALSE. HROOKL = .FALSE. MODIFY=.FALSE. IF(TEXT(3).EQ.O) MODIFY=.TRUE. IF(MODIFY) GO TO 9 SQ=21 DO 400 I=1,8 DO 390 J=1,8 SQ=SQ+1 BOARD(SQ)=7 390 CONTINUE SQ=SQ+2 400 CONTINUE 9 SQ = 21 SIDE = 1 DO 110 J = 1, 72 DO 100 K = 1, 16 IF(INPUT(J).EQ.CHAR(K)) GO TO 101 100 CONTINUE GO TO 120 101 IF(K.EQ.7) GO TO 80 IF(K.EQ.8) GO TO 60 IF(K.GT.8) GO TO 70 C C--------------------------------------< CHARACTER INDICATES A PIECE C 50 SQ = SQ + 1 IF(MOD(SQ-1,10).GT.8) SQ = SQ + 2 IF (SQ .GT. 99) GO TO 120 IF (BOARD (SQ) .NE. 7 .AND. .NOT.MODIFY) GO TO 120 BOARD (SQ) = K + 7 * SIDE GO TO 110 C C--------------------------------------< PERIOD INDICATES END OF LISTING C--------------------------------------< OF COMPUTER PIECES C 60 IF (SQ .GT. 99) GO TO 120 IF (SIDE .NE. 1) GO TO 120 SIDE = 0 SQ = 21 GO TO 110 C C--------------------------------------< NUMBER INDICATES EMPTY SQUARE(S C 70 LIM = K - 8 DO 71 I = 1, LIM SQ = SQ + 1 IF (MOD(SQ-1,10) .GT. 8 .OR. MOD(SQ-1,10) .LT.1) * SQ = SQ + 2 71 CONTINUE 110 CONTINUE C C--------------------------------------< BLANK INDICATES END OF C--------------------------------------< STRING C 80 CKINGL = 0 HKINGL = 0 SQ = 21 85 DO 41 L = 1, 8 DO 40 L1 = 1, 8 SQ = SQ + 1 IF (BOARD (SQ) .EQ. 6) HKINGL = SQ IF (BOARD (SQ) .EQ. 13) CKINGL = SQ 40 CONTINUE SQ = SQ + 2 41 CONTINUE IF(HKINGL .EQ. 0 .OR. CKINGL .EQ. 0) GO TO 140 IF(COLOR.EQ.0) GO TO 6200 IF(BOARD(25).NE.13) CKINGM=.TRUE. IF(BOARD(95).NE.6) HKINGM=.TRUE. GO TO 6300 6200 IF(BOARD(26).NE.13) CKINGM=.TRUE. IF(BOARD(96).NE.6) HKINGM=.TRUE. 6300 CONTINUE IF (BOARD (22) .NE. 11) CROOKR = .TRUE. IF (BOARD (29) .NE. 11) CROOKL = .TRUE. IF (BOARD (92) .NE. 4) HROOKL = .TRUE. IF (BOARD (99) .NE. 4) HROOKR = .TRUE. VCMOVE=0 6000 RETURN C C--------------------------------------< INPUT ERROR C 120 WRITE(6,130) 130 FORMAT (1X,'INPUT ERROR, TRY AGAIN') GO TO 9999 140 WRITE(6,150) 150 FORMAT (1X,'EACH SIDE MUST HAVE 1 KING (K)') GO TO 9999 END $CONTROL SEGMENT=SET SUBROUTINE SETCLK C C ************************************************************ C * * C * THIS SUBROUTINE IS USED TO RESET THE CHESS CLOCK * C * AFTER THE INITIAL NUMBER OF MOVES HAVE BEEN MADE. FOR * C * EXAMPLE, FOR 40 MOVES IN 2 HOURS AND 10 MOVES EACH 1/2 * C * HOUR AFTER THAT, THE CLOCK IS SET TO 30 MINUTES EACH * C * AFTER THE FIRST 40 MOVES HAVE BEEN MADE AND IS RESET TO * C * 30 AFTER EACH SUCCEEDING 10 MOVES ARE MADE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /MOV CNT/ NCMOVS, NHMOVS LOGICAL CLOCK, CQUERY C------------------------------< IF NOT AT THE PRESET TIME LIMIT, C------------------------------< RETURN WITHOUT RESETTING THE CLOCKS. C IF(NHMOVS+NCMOVS.LT.2*MOVES) GO TO 100 MOVES=MOVES+SMOVES GELAP=SELAP CTOTAL=CTOTAL+CELAP HTOTAL=HTOTAL+HELAP CELAP=0 HELAP=0 100 RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETGB C C ************************************************************ C * * C * SETGB IS USED TO SET THE GAME BOARD TO IT'S INITIAL * C * POSITION. CASTLING STATUS IS SET FOR THE START OF THE * C * GAME ALSO. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL LOGICAL CKINGM, CROOKR, CROOKL, HKINGM, HROOKR, HROOKL COMMON /COLR CM/ CCOLOR, HCOLOR, COLOR CHARACTER*5 CCOLOR, HCOLOR INTEGER*4 HP(8),CP(8) DATA HP/4J,2J,3J,5J,6J,3J,2J,4J/,CP/11J,9J,10J,12J, *13J,10J,9J,11J/ C C------------------------------< CLEAR THE BOARD C DO 11 I=4,7 DO 10 J=2,9 BOARD(I*10+J)=7 10 CONTINUE 11 CONTINUE C C------------------------------< SET PIECES AND PAWNS C DO 20 I=2,9 BOARD(20+I)=CP(I-1) BOARD(30+I)=8 BOARD(80+I)=1 BOARD(90+I)=HP(I-1) 20 CONTINUE C C------------------------------< IF PROGRAM IS BLACK, THE KING AND C------------------------------< QUEEN MUST BE REVERSED. C IF(COLOR.EQ.0) GO TO 30 BOARD(25)=13 BOARD(26)=12 BOARD(95)=6 BOARD(96)=5 C C------------------------------< INITIALIZE CASTLING STATUS C 30 CKINGM=.FALSE. CROOKR=.FALSE. CROOKL=.FALSE. HKINGM=.FALSE. HROOKR=.FALSE. HROOKL=.FALSE. RETURN END SUBROUTINE SETIO(AUTO,*) C C ************************************************************ C * * C * SETIO IS USED TO OPEN DCB'S F:1 AND F:2 FOR FORTRAN * C * I/O UNITS 1 AND 2 TO SPECIFIC FILES. THE FILE NAMES * C * ARE BASED ON THE PLAYER'S NAME. THE FILES ARE OPENED * C * OUT FIRST TO CREATE THEM FOLLOWED BY INOUT TO BE ABLE * C * TO UPDATE THEM. IF RESTARTING A GAME, INOUT IS USED * C * SO AS NOT TO DELETE THE STATUS OF THE GAME THAT IS * C * BEING RESTARTED. * C * 'SAVEGM' IS AN ENTRY POINT USED TO SAVE THE GAME * C * STATUS AFTER EACH MOVE SO THAT THE GAME MAY BE RE- * C * STARTED IF COMMUNICATION IS LOST OF THE SYSTEM HAS * C * SOME TYPE OF MALFUNCTION. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) SYSTEM INTRINSIC COMMAND CHARACTER*24 BFFR, CNAME*6, BFR1*36, BFR2*16, ANAME*6 INTEGER*2 IERR, IPARM, IERR1, IPARM1, IERR2, IPARM2 EQUIVALENCE (NAME(1),ANAME) COMMON /NAME CM/ NAME(5) LOGICAL AUTO, TAUTO, BLNK DATA IERR/0/,IPARM/0/,IERR1/0/,IPARM1/0/,IERR2/0/, *IPARM2/0/ BFFR="BUILD X1 ;DISC=600" BFR1="FILE FTN01=X1 ,OLD;ACC=UPDATE" BFR2="PURGE X1 " BFFR[24:1]=%15C BFR1[36:1]=%15C BFR2[16:1]=%15C DO 1 I=1,6 IF(ANAME[I:1].EQ.%40C)BLNK=.TRUE. CNAME[I:1]=ANAME[I:1] IF(ANAME[I:1].NE.%40C.AND.BLNK)CNAME[I:1]=%40C 1 CONTINUE BFFR[9:6]=CNAME[1:6] BFR1[14:6]=CNAME[1:6] BFR2[9:6]=CNAME[1:6] 100 CALL COMMAND(BFFR,IERR,IPARM) IF(.CC.)90,200,90 C OPEN O.K.-ASSIGN TO FORTRAN UNIT 1 200 CALL COMMAND(BFR1,IERR1,IPARM1) IERR=IERR1 IPARM=IPARM1 IF(.CC.)300,999,300 C IF ERR 116, FILE EXISTS-RESTART 90 IF(IERR.EQ.116) GOTO 10 C SHOULDN'T GET HERE-FILE ERROR! 300 WRITE(6,40)IERR,IPARM 40 FORMAT(1X,"FILE SYSTEM ERROR #",I6,1X,"PARM=",I6) RETURN 10 WRITE(6,20)NAME 20 FORMAT(1X,'ARE YOU CONTINUING YOUR LAST GAME, ',5A4) READ(5,30)RESTRT 30 FORMAT(R1) IF(RESTRT.NE.%'Y'.AND.RESTRT.NE.%'N') GO TO 10 IF(RESTRT.EQ.%"Y")FLAG=1 IF(RESTRT.EQ.%"Y")GOTO 200 WRITE(6,60) 60 FORMAT(1X,"OLD GAME EXISTS- SHOULD I PURGE?") READ(5,50)PURGE 50 FORMAT(R1) IF(PURGE.EQ.%"N") RETURN 1 C IF NO, GET NEW NAME.....ELSE PURGE! CALL COMMAND(BFR2,IERR2,IPARM) IF(.CC.)300,100,300 999 IF(RESTRT.EQ.%"Y")CALL RCMND(FLAG) IF(RESTRT.EQ.%"Y")AUTO=.TRUE. RETURN ENTRY SAVEGM CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETKBD C C ************************************************************ C * * C * SETKBD IS USED TO SET THE KING CONTROL BOARDS IN * C * COMMON BLOCK 'K BD SM'. THE BOARD IS SET UP EITHER * C * AROUND THE CENTER OR AROUND THE OPPONENT'S KING BASED * C * ON WHETHER OR NOT THE OPENING IS COMPLETE. THE * C * FOLLOWING SCORING CONSIDERATIONS ARE INCLUDED IN THE * C * CONTROL BOARD: * C * 1) IF THE OPPONENT'S QUEEN IS STILL ON THE BOARD, * C * THE CONTROL BOARD IS SET UP TO KEEP THE KING BE * C * HIND THE PAWNS HE IS CLOSE TO. THIS KEEPS THE * C * KING FROM BEING EXPOSED TO ATTACK. * C * 2) IF THE ONE SIDE DOESN'T HAVE A QUEEN, OR THE * C * GAME IS IN THE ENDGAME PHASE, THEN THE KINGS * C * ARE GIVEN MORE SPECIFIC GOALS. THAT IS, IF * C * PAWNS ARE ONLY ON 1 WING, THEN THE KINGS * C * GO IN THAT DIRECTION (TRY TO HEAD THEM OFF/ * C * ADVANCE THEM). IF PAWNS ARE PRESENT ON BOTH * C * SIDES OF THE BOARD, THEN THE KINGS WILL CEN- * C * TRALIZE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END LOGICAL CQUEEN, HQUEEN, TEMP COMMON /BOARD/ BOARD(120) COMMON /K BD SM/ CKSCOR(100), HKSCOR(100) COMMON /K SM/ EKMOVE, KSAFE COMMON /K LOC CM/ CKINGL, HKINGL COMMON /Q LOC CM/ CQUEEN, HQUEEN LOGICAL CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL COMMON /P LOC CM/ CPLOC(8), HPLOC(8), NCPNS, NHPNS INTEGER*4 CPL(8),HPL(8) IF(END) GO TO 600 C C------------------------------< IF THE COMPUTER HAS A QUEEN ON THE C------------------------------< BOARD, SET THE KING CONTROL BOARD C------------------------------< TO ATTRACT THE KING BEHIND THE PAWNS C------------------------------< ON THE SIDE HE IS ON. C IF(.NOT. CQUEEN) GO TO 200 SIDE=MOD(CKINGL,10)-1 FILES=2 IF(SIDE.GT.4) FILES=7 RANK=1 DO 100 I=3,5 RANK=RANK+1 START=FILES+I*10 ENDING=START+2 DO 110 SQ=START,ENDING IF(BOARD(SQ).EQ.8) GO TO 120 110 CONTINUE 100 CONTINUE GO TO 200 120 LOC=RANK*10+FILES+1 IF(BOARD(LOC).EQ.13) GO TO 130 LOC1=LOC-1 IF(FILES.GT.4) LOC1=LOC+1 IF(BOARD(LOC1).EQ.13) LOC=LOC1 130 IF(.NOT. CKINGM) LOC=CKINGL TEMP=OPEN OPEN=.FALSE. CALL SETSQ(CKSCOR,LOC,KSAFE) OPEN=TEMP C C------------------------------< IF THE HUMAN HAS A QUEEN ON THE C------------------------------< BOARD, SET THE KING CONTROL BOARD C------------------------------< TO ATTRACT THE KING BEHIND THE PAWNS C------------------------------< ON THE SIDE HE IS ON. C 200 IF(.NOT. HQUEEN) GO TO 400 SIDE=MOD(HKINGL,10)-1 FILES=2 IF(SIDE.GT.4) FILES=7 RANK=10 DO 300 I=1,3 RANK=RANK-1 START=FILES+(9-I)*10 ENDING=START+2 DO 310 SQ=START,ENDING IF(BOARD(SQ).EQ.1) GO TO 320 310 CONTINUE 300 CONTINUE GO TO 400 320 LOC=RANK*10+FILES+1 IF(BOARD(LOC).EQ.6) GO TO 330 LOC1=LOC-1 IF(FILES.GT.4) LOC1=LOC+1 IF(BOARD(LOC1).EQ.6) LOC=LOC1 330 IF(.NOT. HKINGM) LOC=HKINGL TEMP=OPEN OPEN=.FALSE. CALL SETSQ(HKSCOR,LOC,KSAFE) OPEN=TEMP C C------------------------------< IF THE COMPUTER KING HASN'T CASTLED, C------------------------------< AND STILL CAN, DISCOURAGE IT FROM C------------------------------< MOVING AND LOSING THAT PRIVILEGE. C 400 IF(CKINGM.OR.(CROOKR.AND.CROOKL)) GO TO 500 IF(BOARD(25).EQ.13) CKSCOR(25)=CKSCOR(25)+EKMOVE IF(BOARD(26).EQ.13) CKSCOR(26)=CKSCOR(26)+EKMOVE C C------------------------------< IF THE HUMAN KING HASN'T CASTLED, C------------------------------< AND STILL CAN, DISCOURAGE IT FROM C------------------------------< MOVING AND LOSING THAT PRIVILEGE. C 500 IF(HKINGM.OR.(HROOKR.AND.HROOKL)) GO TO 600 IF(BOARD(95).EQ.6) HKSCOR(95)=HKSCOR(95)+EKMOVE IF(BOARD(96).EQ.6) HKSCOR(96)=HKSCOR(96)+EKMOVE C C------------------------------< LOCATE PAWN MASSES TO DETERMINE C------------------------------< WHERE KINGS SHOULD GO. C 600 IF(NCPNS.EQ.0) GO TO 700 DO 650 I=1,NCPNS CPL(I)=MOD(CPLOC(I),10)-1 650 CONTINUE 700 IF(NHPNS.EQ.0) GO TO 800 DO 750 I=1,NHPNS HPL(I)=MOD(HPLOC(I),10)-1 750 CONTINUE C C------------------------------< IF ALL TESTS FAIL, THEN CENTRALIZE C------------------------------< THE KINGS. C 800 IF(NCPNS+NHPNS.EQ.0) GO TO 9999 CLOC=65 CLOC1=CLOC HLOC=55 HLOC1=HLOC C C------------------------------< IF THERE ARE PAWNS ON BOTH WINGS, C------------------------------< CENTRALIZE THE KINGS (FOR NOW). C IF(NCPNS.EQ.0) GO TO 900 IF(NCPNS.EQ.1) GO TO 850 IF(CPL(1).LT.4.AND.CPL(NCPNS).GT.4) GO TO 900 850 CLOC=CPLOC((NCPNS+1)/2) CLOC1=CLOC+10 900 IF(NHPNS.EQ.0) GO TO 1000 IF(NHPNS.EQ.1) GO TO 950 IF(HPL(1).LT.4.AND.HPL(NHPNS).GT.4) GO TO 1000 950 HLOC=HPLOC((NHPNS+1)/2) HLOC1=HLOC-10 C C------------------------------< THE KING SHOULD: C------------------------------< A) MOVE TOWARD IT'S OWN PAWN MASS C------------------------------< IF IT HAS ONE, OR C------------------------------< B) MOVE TOWARD THE OPPONENTS PAWN C------------------------------< MASS IF IT DOESN'T HAVE ONE, OR C------------------------------< C) MOVE TOWARD THE OPPONENT'S C------------------------------< KING IF NEITHER HAVE ONE. C 1000 IF(NCPNS.EQ.0.AND.NHPNS.GT.0) CLOC1=HLOC-10 IF(NHPNS.EQ.0.AND.NCPNS.GT.0) HLOC1=CLOC+10 IF(.NOT.HQUEEN .OR. END) CALL SETSQ(CKSCOR,CLOC1,KSAFE) IF(.NOT.CQUEEN .OR. END) CALL SETSQ(HKSCOR,HLOC1,KSAFE) 9999 RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETNBD C C ************************************************************ C * * C * SETNBD IS USED TO SET THE KNIGHT CONTROL BOARDS IN * C * COMMON BLOCK 'N BD SM'. THE BOARD IS SET UP EITHER * C * AROUND THE CENTER OR AROUND THE OPPONENT'S KING BASED * C * ON WHETHER OR NOT THE OPENING IS COMPLETE. THE * C * FOLLOWING SCORING CONSIDERATIONS ARE INCLUDED IN THE * C * CONTROL BOARD: * C * 1) THE BORDER SQUARES ARE GIVEN LOWER VALUES TO * C * PREVENT THE KNIGHT FROM GETTING ON THE EDGE OF * C * THE BOARD WHERE MUCH OF IT'S EFFECTIVENESS IS * C * LOST DUE TO RESTRICTED MOBILITY. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /BOARD/ BOARD(120) COMMON /N SM/ ENMOVE, OUTPST, N EDGE COMMON /N BD SM/ CNSCOR(100), HNSCOR(100) COMMON /GEN SM/ ATAK SC, BPAWN, BLKSC, TEMPO COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL LOGICAL CKINGM, CROOKR, CROOKL, HKINGM, HROOKR, HROOKL COMMON /CAST SM/ CAST SC, UB CAST COMMON /DEV STS/ CDONE, HDONE LOGICAL CDONE, HDONE C C------------------------------< SET THE KNIGHT CONTROL BOARD TO C------------------------------< DISCOURAGE KNIGHTS FROM MOVING TO C------------------------------< SQUARES ON THE EDGE (RIM) OF THE C------------------------------< BOARD WHERE THEY ARE RESTRICTED C------------------------------< AND SUBJECT TO BECOMING TRAPPED. C DO 100 I=23,28 CNSCOR(I)=CNSCOR(I)-N EDGE HNSCOR(I)=HNSCOR(I)-N EDGE CNSCOR(I+70)=CNSCOR(I+70)-N EDGE HNSCOR(I+70)=HNSCOR(I+70)-N EDGE 100 CONTINUE DO 200 I=22,92,10 CNSCOR(I)=CNSCOR(I)-N EDGE HNSCOR(I)=HNSCOR(I)-N EDGE CNSCOR(I+7)=CNSCOR(I+7)-N EDGE HNSCOR(I+7)=HNSCOR(I+7)-N EDGE 200 CONTINUE C C------------------------------< ADJUST THE CONTROL BOARD TO PREVENT C------------------------------< POSTING A KNIGHT IN FRONT OF CENTER C------------------------------< PAWNS THAT HAVEN'T BEEN MOVED. C 250 IF(.NOT. OPEN) GO TO 275 IF(BOARD(85).EQ.1) HNSCOR(75)=HNSCOR(75)-BPAWN IF(BOARD(86).EQ.1) HNSCOR(76)=HNSCOR(76)-BPAWN IF(BOARD(85).EQ.1.OR.BOARD(75).EQ.1) * HNSCOR(65)=HNSCOR(65)-BPAWN IF(BOARD(86).EQ.1.OR.BOARD(76).EQ.1) * HNSCOR(66)=HNSCOR(66)-BPAWN 505 IF(BOARD(35).EQ.8) CNSCOR(45)=CNSCOR(45)-BPAWN IF(BOARD(36).EQ.8) CNSCOR(46)=CNSCOR(46)-BPAWN IF(BOARD(35).EQ.8.OR.BOARD(45).EQ.8) * CNSCOR(55)=CNSCOR(55)-BPAWN IF(BOARD(36).EQ.8.OR.BOARD(46).EQ.8) * CNSCOR(56)=CNSCOR(56)-BPAWN 275 CONTINUE C C------------------------------< IF IN THE OPENING, ADJUST THE CONTROL C------------------------------< BOARD TO FORCE KNIGHTS OFF OF THE C------------------------------< BACK RANK (DEVELOP) C IF(CDONE) GO TO 300 CNSCOR(23)=CNSCOR(23)+ENMOVE CNSCOR(28)=CNSCOR(28)+ENMOVE IF(CKINGM) GO TO 300 IF(CROOKR) GO TO 350 CNSCOR(23)=CNSCOR(23)+UB CAST 350 IF(CROOKL) GO TO 300 CNSCOR(28)=CNSCOR(28)+UB CAST 300 CONTINUE IF(HDONE) GO TO 500 HNSCOR(93)=HNSCOR(93)+ENMOVE HNSCOR(98)=HNSCOR(98)+ENMOVE IF(HKINGM) GO TO 500 IF(HROOKR) GO TO 450 HNSCOR(98)=HNSCOR(98)+UB CAST 450 IF(HROOKL) GO TO 500 HNSCOR(93)=HNSCOR(93)+UB CAST 500 CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETOPN C C ************************************************************ C * * C * SETOPN IS USED TO GIVE THE USER SOME DEGREE OF * C * CONTROL OVER WHICH OPENING THE PROGRAM WILL PLAY AND * C * ALSO WHICH LINE THE PROGRAM WILL USE OUT OF THE LINES * C * INCLUDED IN THE BOOKMOVE FILE. THIS SUBROUTINE SETS * C * VARIABLE 'MVNUMB' SO THAT BOOK WILL CHOSE 'MVNUMB' * C * MOVE OUT OF IT'S LIST OF ALTERNATIVE MOVES. FOR EX- * C * AMPLE, '3' WOULD CAUSE IT TO CHOSE THE 3RD POSSIBILITY * C * FOR IT'S NEXT MOVE. EACH TIME BOOK USES 'MVNUMB' IT IS * C * RESET TO 1 SINCE USUALLY THE GOOD VARIATIONS WILL BE * C * FIRST. 'SO' CAN BE USED AS MANY TIMES AS DESIRED TO * C * MAKE THE PROGRAM FOLLOW ANY LINE IN IT'S 'BOOK'. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /OPEN CM/ MVNUMB WRITE(6,10) 10 FORMAT(1X,'WHICH VARIATION SHOULD I PLAY?') CALL INPUT(TEMP) IF(TEMP.EQ.0) RETURN MVNUMB=TEMP RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETPBD C C ************************************************************ C * * C * SETPBD IS USED TO SET THE PAWN CONTROL BOARDS * C * USED IN CONTROLLING PAWN ADVANCES. THE CENTER TWO * C * PAWNS ARE ALWAYS ENCOURAGED TO ADVANCE, THE PAWNS ON * C * THE OPPOSITE SIDE OF THE BOARD FROM THE CASTLED KING * C * ARE ENCOURAGED ALSO. THE PAWNS IN FRONT OF THE CASTLED * C * KING ARE ENCOURAGED TO STAY PUT UNTIL THE OPPONENT'S * C * QUEEN IS OFF OF THE BOARD OR UNTIL THE KING HAS MOVED * C * OUT FROM BEHIND THEIR PROTECTIVE SCREEN. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /P SM/ PADVNC, PPAWN, IPAWN, DPAWN, TPAWN, CPAWN, * ABREST, PPSHSC COMMON /CAST CM/ CKINGM,CROOKR,CROOKL,HKINGM,HROOKR,HROOKL LOGICAL CKINGM, CROOKR, CROOKL, HKINGM, HROOKR, HROOKL COMMON /K LOC CM/ CKINGL, HKINGL COMMON /Q LOC CM/ CQUEEN, HQUEEN COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /P BD SM/ CPSCOR(100), HPSCOR(100) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE C C------------------------------< INITIALIZE THE PAWN CONTROL BOARD C------------------------------< TO ENCOURAGE ALL PAWNS TO ADVANCE C DO 50 SQ=22,99 FILE=MOD(SQ,10)-2 IF(FILE.GT.3) FILE=7-FILE CPSCOR(SQ)=(SQ/10-2)*(PADVNC/2+FILE*2) HPSCOR(SQ)=(9-SQ/10)*(PADVNC/2+FILE*2) 50 CONTINUE DO 100 I=22,29 CPSCOR(I+70)=PVALUE(12) HPSCOR(I)=PVALUE(5) 100 CONTINUE L=+1 R=+1 C C------------------------------< IF THE KING HAS CASTLED AND THE C------------------------------< HUMAN STILL HAS A QUEEN ON THE C------------------------------< BOARD, DISCOURAGE ADVANCING PAWNS C------------------------------< IN FRONT OF THE CASTLED KING. C------------------------------< IF THE KING HASN'T CASTLED YET, C------------------------------< DISCOURAGE MOVING PAWNS ON EITHER C------------------------------< SIDE OF THE CENTER PAWNS. C IF(CKINGL.GT.30 .OR. END) GO TO 225 IF(CKINGM) GO TO 200 IF(.NOT. CROOKR) R=-1 IF(.NOT. CROOKL) L=-1 200 IF(CKINGL.GE.26) L=-1 IF(CKINGL.LE.25) R=-1 225 DO 255 J=42,44 L2=J+40 DO 250 I=J,L2,10 CPSCOR(I)=CPSCOR(I)*R CPSCOR(I+5)=CPSCOR(I+5)*L 250 CONTINUE 255 CONTINUE IF(.NOT. OPEN) GO TO 260 CPSCOR(45)=CPSCOR(45)+PADVNC/2 CPSCOR(46)=CPSCOR(46)+PADVNC/2 CPSCOR(55)=CPSCOR(55)+PADVNC CPSCOR(56)=CPSCOR(56)+PADVNC 260 CONTINUE IF(MOVE.GT.1) GO TO 275 IF(BOARD(65).NE.1) CPSCOR(56)=CPSCOR(56)+200 IF(BOARD(66).NE.1) CPSCOR(55)=CPSCOR(55)+200 275 CONTINUE C C------------------------------< IF THE KING HAS CASTLED AND THE C------------------------------< COMPUTER STILL HAS A QUEEN ON THE C------------------------------< BOARD, DISCOURAGE ADVANCING PAWNS C------------------------------< IN FRONT OF THE CASTLED KING. C------------------------------< IF THE KING HASN'T CASTLED YET, C------------------------------< DISCOURAGE MOVING PAWNS ON EITHER C------------------------------< SIDE OF THE CENTER PAWNS. C L=+1 R=+1 IF(HKINGL.LT.90 .OR. END) GO TO 325 IF(HKINGM) GO TO 300 IF(.NOT. HROOKR) R=-1 IF(.NOT. HROOKL) L=-1 300 IF(HKINGL.LE.95) L=-1 IF(HKINGL.GE.96) R=-1 325 DO 355 J=32,34 L2=J+40 DO 350 I=J,L2,10 HPSCOR(I)=HPSCOR(I)*L HPSCOR(I+5)=HPSCOR(I+5)*R 350 CONTINUE 355 CONTINUE IF(.NOT. OPEN) GO TO 360 HPSCOR(75)=HPSCOR(75)+PADVNC/2 HPSCOR(76)=HPSCOR(76)+PADVNC/2 HPSCOR(65)=HPSCOR(65)+PADVNC HPSCOR(66)=HPSCOR(66)+PADVNC 360 CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETPCV C C ************************************************************ C * * C * SETPCV IS USED TO SET THE MATERIAL VALUE FOR EACH * C * SIDE SO THAT THE SIDE WHICH IS MATERIAL AHEAD WILL * C * TEND TO EXCHANGE WHILE THE SIDE THAT IS MATERIAL BE- * C * HIND WILL TEND TO AVOID EXCHANGES. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) REAL RATIO COMMON /BOARD/ BOARD(120) COMMON /PIEC CM/ PVALUE(13), PINIT(13) COMMON /MTRL SC/ CPCVAL, HPCVAL C C------------------------------< ADD UP MATERIAL FOR BOTH SIDES C CPCVAL=0 HPCVAL=0 SQ=21 DO 3 I=1,8 DO 2 J=1,8 SQ=SQ+1 TEMP=BOARD(SQ) IF(TEMP.GT.7) GO TO 1 HPCVAL=HPCVAL+PINIT(TEMP) GO TO 2 1 CPCVAL=CPCVAL+PINIT(TEMP) 2 CONTINUE SQ=SQ+2 3 CONTINUE C C------------------------------< COMPUTE MATERIAL RATIO AND SET THE C------------------------------< VALUE OF COMPUTER PIECES SO THAT C------------------------------< THE SIDE MATERIAL AHEAD WILL TRY C------------------------------< TO EXCHANGE, WHILE THE SIDE BEHIND C------------------------------< WILL TRY TO AVOID EXCHANGING. C RATIO=1 IF(HPCVAL.EQ.0.OR.CPCVAL.EQ.0) GO TO 4 RATIO=FLOAT(HPCVAL-8000)/FLOAT(CPCVAL-8000) IF(RATIO.LT..90) RATIO=.90 IF(RATIO.GT.1.10) RATIO=1.10 4 DO 5 I=1,13 PVALUE(I)=PINIT(I) 5 CONTINUE DO 6 I=8,12 PVALUE(I)=RATIO*PINIT(I) 6 CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETQBD C C ************************************************************ C * * C * SETQBD IS USED TO SET THE QUEEN CONTROL BOARDS IN * C * COMMON BLOCK 'Q BD SM'. THE BOARD IS SET UP EITHER * C * AROUND THE CENTER OR AROUND THE OPPONENT'S KING BASED * C * ON WHETHER OR NOT THE OPENING IS COMPLETE. THE * C * FOLLOWING SCORING CONSIDERATIONS ARE INCLUDED IN THE * C * CONTROL BOARD: * C * 1) THE SQUARE WHERE THE QUEEN IS SITTING IS GIVEN * C * A HIGHER VALUE DURING THE OPENING OF THE GAME TO * C * TEND TO MAKE THE QUEEN STAY IN ONE PLACE UNTIL * C * DEVELOPMENT IS COMPLETE. EARLY QUEEN MOVES * C * USUALLY RESULT IN LOST TEMPI DUE TO MOVING THE * C * QUEEN AROUND TO AVOID ATTACKS. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /BOARD/ BOARD(120) COMMON /Q BD SM/ CQSCOR(100), HQSCOR(100) COMMON /Q SM/ EQMOVE, Q EDGE COMMON /DEV STS/ CDONE, HDONE LOGICAL CDONE, HDONE C C------------------------------< IF STILL IN THE OPENING PHASE OF C------------------------------< THE GAME, DISCOURAGE THE QUEEN C------------------------------< FROM MOVING TO AVOID HAVING TO C------------------------------< REPEATEDLY MOVE IT AWAY FROM ATTACKS C------------------------------< AND LOSING TEMPI. C IF(CDONE) GO TO 100 IF(BOARD(25).EQ.12) CQSCOR(25)=EQMOVE IF(BOARD(26).EQ.12) CQSCOR(26)=EQMOVE 100 CONTINUE IF(HDONE) GO TO 200 IF(BOARD(95).EQ.5) HQSCOR(95)=EQMOVE IF(BOARD(96).EQ.5) HQSCOR(96)=EQMOVE 200 CONTINUE C C------------------------------< SET THE QUEEN CONTROL BOARD TO C------------------------------< DISCOURAGE QUEENS FROM MOVING TO C------------------------------< SQUARES ON THE EDGE (RIM) OF THE C------------------------------< BOARD WHERE THEY ARE RESTRICTED C------------------------------< AND SUBJECT TO BECOMING TRAPPED. C IF(.NOT. END) GO TO 500 DO 300 I=23,28 CQSCOR(I)=CQSCOR(I)-Q EDGE HQSCOR(I)=HQSCOR(I)-Q EDGE CQSCOR(I+70)=CQSCOR(I+70)-Q EDGE HQSCOR(I+70)=HQSCOR(I+70)-Q EDGE 300 CONTINUE DO 400 I=22,92,10 CQSCOR(I)=CQSCOR(I)-Q EDGE HQSCOR(I)=HQSCOR(I)-Q EDGE CQSCOR(I+7)=CQSCOR(I+7)-Q EDGE HQSCOR(I+7)=HQSCOR(I+7)-Q EDGE 400 CONTINUE 500 RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETRBD C C ************************************************************ C * * C * SETRBD IS USED TO SET THE ROOK CONTROL BOARDS IN * C * COMMON BLOCK 'R BD SM'. THE BOARD IS SET UP EITHER * C * AROUND THE CENTER OR AROUND THE OPPONENT'S KING BASED * C * ON WHETHER OR NOT THE OPENING IS COMPLETE. THE * C * FOLLOWING SCORING CONSIDERATIONS ARE INCLUDED IN THE * C * CONTROL BOARD: * C * 1) THE SQUARES WHERE ROOKS ARE SITTING ARE GIVEN * C * HIGH VALUES DURING THE OPENING OF THE GAME TO * C * TEND TO MAKE THE ROOK STAY IN ONE PLACE UNTIL * C * DEVELOPMENT IS COMPLETE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END COMMON /BOARD/ BOARD(120) COMMON /R BD SM/ CRSCOR(100), HRSCOR(100) COMMON /R SM/ ERMOVE, RANK78, ROPEN, RHALF, DROOKS, CROOKS, * RPASS, R EDGE COMMON /K LOC CM/ CKINGL, HKINGL C C------------------------------< IF IN THE OPENING PHASE OF THE C------------------------------< GAME, DISCOURAGE ROOKS FROM MOVING C------------------------------< SINCE PROBABLY THE MOVE WILL NOT BE C------------------------------< STRONG UNTIL OPEN LINES DEVELOP. C IF(.NOT. OPEN) GO TO 100 IF(BOARD(22).EQ.11) CRSCOR(22)=CRSCOR(22)+ERMOVE IF(BOARD(29).EQ.11) CRSCOR(29)=CRSCOR(29)+ERMOVE IF(BOARD(92).EQ.4) HRSCOR(92)=HRSCOR(92)+ERMOVE IF(BOARD(99).EQ.4) HRSCOR(99)=HRSCOR(99)+ERMOVE C C------------------------------< SET THE CONTROL BOARD TO ATTRACT C------------------------------< ROOKS TO THE 7TH/8TH RANK WHEN THE C------------------------------< OPPONENT'S KING IS STILL ON THE 8TH. C 100 IF(CKINGL.GT.40) GO TO 300 DO 200 I=21,40 HRSCOR(I)=HRSCOR(I)+RANK78 200 CONTINUE 300 IF(HKINGL.LT.80) GO TO 500 DO 400 I=81,100 CRSCOR(I)=CRSCOR(I)+RANK78 400 CONTINUE C C------------------------------< SET THE ROOK CONTROL BOARD TO C------------------------------< DISCOURAGE ROOKS FROM MOVING TO C------------------------------< SQUARES ON THE EDGE (RIM) OF THE C------------------------------< BOARD WHERE THEY ARE RESTRICTED C------------------------------< AND SUBJECT TO BECOMING TRAPPED. C 500 IF(.NOT. END) GO TO 800 DO 600 I=23,28 CRSCOR(I)=CRSCOR(I)-R EDGE HRSCOR(I)=HRSCOR(I)-R EDGE CRSCOR(I+70)=CRSCOR(I+70)-R EDGE HRSCOR(I+70)=HRSCOR(I+70)-R EDGE 600 CONTINUE DO 700 I=22,92,10 CRSCOR(I)=CRSCOR(I)-R EDGE HRSCOR(I)=HRSCOR(I)-R EDGE CRSCOR(I+7)=CRSCOR(I+7)-R EDGE HRSCOR(I+7)=HRSCOR(I+7)-R EDGE 700 CONTINUE 800 RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETSQ(VALUE,SQ,SCORE) C C ************************************************************ C * * C * SETSQ IS USED BY THE PRE-ANALYZER TO SET UP THE * C * CONTROL BOARDS. IT SETS UP THE BOARD PASSED TO IT AS * C * AN ARGUMENT TO HAVE A VALUE OF 66 IN SQUARE 'SQ' AND * C * 8 LESS IN EACH RING AWAY FROM SQ USING THE DISTANCE * C * FORMULA. NORMALLY, SQ IS THE SQUARE THAT THE KING IS * C * LOCATED ON TO MAKE MOVES TOWARD THE KING GET A HIGHER * C * SCORE AND MOVES AWAY FROM THE KING GET A LOWER SCORE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) DIMENSION VALUE(10,10) COMMON /PHASE/ OPEN, MIDDLE, END LOGICAL OPEN, MIDDLE, END REAL A, SQRT KFILE=MOD(SQ,10) KRANK=((SQ-1)/10)+1 DO 2 J=3,10 DO 1 I=2,9 DIST=(I-KFILE)**2 + (J-KRANK)**2 IF(OPEN.AND.I.GT.5) * DIST=(I-KFILE-1)**2 + (J-KRANK)**2 A=FLOAT(DIST) A=SQRT(A) DIST=IFIX(A) VALUE(I,J)=(9-DIST)*SCORE 1 CONTINUE 2 CONTINUE RETURN END $CONTROL SEGMENT=SET SUBROUTINE SETTG C C ************************************************************ C * * C * SETTG IS USED TO SET THE PROGRAM UP FOR TOURNAMENT * C * PLAY WITH AS LITTLE HASSLE AS POSSIBLE. THE FOLLOWING * C * THINGS ARE SET UP AUTOMATICALLY: * C * * C * A) THE SEARCH DEPTH IS SET TO 5, THE DEFAULT * C * FORWARD PRUNING WIDTHS ARE SET TO 6,6,6,6,??, * C * THE MAXIMUM WIDTHS ARE SET TO 13,13,13,13,??. * C * * C * B) THE CLOCK IS TURNED ON AND SET FOR 40 MOVES * C * IN THE FIRST 2 HOURS AND 10 MOVES EACH 1/2 * C * HOUR AFTER THAT. * C * * C * C) THE QUERY CLOCK FLAG IS SET SO THE PROGRAM WILL * C * ASK ABOUT THE CHESS CLOCK. * C * * C * D) THE CLOCK IS SET TO USE ELAPSED TIME RATHER * C * THAN CPU TIME. * C * * C * E) THINK-AHEAD MODE IS TURNED ON * C * * C * F) PROGRAMMED COMMAND MODE IS SET AND A 'P' * C * COMMAND IS ENTERED TO AID THE OPERATOR IN * C * USING THINK-AHEAD. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /PC CM/ CMNDS(10,3), NCMNDS, PCMODE, EXMODE LOGICAL CLOCK,CQUERY,THNK AH,PCMODE,EXMODE,LOOK AH,MTCHED, *FOUND M, BRKFLG COMMON /CHR SET/ ALPHA(44) EQUIVALENCE (BLANK,ALPHA(44)),(P,ALPHA(16)) C C------------------------------< SET UP LOOKAHEAD/FORWARD PRUNING C DO 100 I=1,10 MIN(I)=6 MAX(I)=13 WIDTH(I)=MIN(I) 100 CONTINUE DEPTH=5 ORDER1=4 ORDER2=4 C C------------------------------< SET UP CHESS CLOCK C MOVES=40 GELAP=120*60 SMOVES=10 SELAP=30*60 CTYPE=2 CLOCK=.TRUE. CQUERY=.TRUE. OPTIME=15 C C------------------------------< TURN ON THINK-AHEAD MODE C THNK AH=.TRUE. LOOK AH=.FALSE. FOUND M=.FALSE. MTCHED=.FALSE. C C------------------------------< TURN ON PROGRAMMED COMMAND MODE AND C------------------------------< FORCE A 'P' (PREDICTED MOVE) COMMAND C PC MODE=.TRUE. CMNDS(1,1)=P CMNDS(1,2)=BLANK CMNDS(1,3)=BLANK NCMNDS=1 WRITE(6,200) 200 FORMAT(1X,'PROGRAM IS SET AT TOURNAMENT SETTING') RETURN END $CONTROL SEGMENT=CMND SUBROUTINE SRCMND C C ************************************************************ C * * C * THIS SUBROUTINE IS USED TO SET THE PERFORMANCE * C * RATING FOR THE OPPONENT. THIS IS USED IN DETERMINING * C * WHEN TO ACCEPT/REJECT A DRAW OR STALEMATE. IF THE * C * OPPONENT IS MUCH BETTER (2 CLASSES OR MORE), THE PRO- * C * WILL ALWAYS ACCEPT. IF ONLY 1 CLASS BETTER, IT WILL * C * ACCEPT UNLESS IT IS 1 1/2 PAWNS OR MORE AHEAD. IF * C * THE PROGRAM IS AS GOOD OR BETTER THAN IT'S OPPONENT, * C * IT WILL ONLY DRAW WHEN BEHIND. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /RATE CM/ CRATE, HRATE COMMON /BUFFER/ TEXT(30) COMMON /CHRSET/ ALPHA(44) EQUIVALENCE (D,ALPHA(4)) IF(TEXT(3).EQ.D) GO TO 30 WRITE(6,10) 10 FORMAT(1X,'ENTER OPPONENT''S PERFORMANCE RATING') CALL INPUT(TEMP) IF(TEMP.EQ.0) GO TO 20 HRATE=TEMP 20 RETURN 30 WRITE(6,40)CRATE,HRATE 40 FORMAT(1X,'BLITZ:',I5,3X,'OPPONENT:',I5) RETURN END $CONTROL SEGMENT=DSP SUBROUTINE STATS(DEVICE) C C ************************************************************ C * * C * STATS IS USED TO PROCESS THE 'S' COMMAND WHICH WILL * C * OUTPUT STATISTICS ABOUT THE GAME AND LAST MOVE SE- * C * LECTION. THE STATISTICS PRINTED ARE: * C * 1) NUMBER OF MOVES GENERATED BY THE MOVE GEN- * C * ERATORS FOR THE LAST MOVE. * C * 2) NUMBER OF NON-TERMINAL NODES IN THE MOVE TREE * C * FOR THE LAST MOVE. THIS IS THE NUMBER OF TIMES * C * THE MOVE GENERATOR WAS CALLED TO GENERATE ALL * C * LEGAL MOVES FOR A POSITION. * C * 3) NUMBER OF TERMINAL NODES IN THE TREE FOR THE * C * LAST MOVE. THIS IS THE NUMBER OF BOARD * C * POSITIONS OR VARIATIONS THAT WERE EXAMINED * C * DURING THE LAST MOVE SELECTION. * C * 4) NUMBER OF NODES EXAMINED AT EACH LEVEL IN THE * C * SEARCH. * C * 5) MINIMAXED SCORE FOR THE MOVE SELECTED. * C * 6) MAXIMUM LOOK-AHEAD INCLUDING MOVES LOOKED EX- * C * AMINED BY SUBROUTINE 'EXCHNG'. * C * 7) AVERAGE TIME/MOVE FOR THE HUMAN AND PROGRAM, * C * AND TIME FOR THE LAST MOVE FOR BOTH SIDES ALSO. * C * 8) NUMBER OF TIMES THE COMPUTER HAS CORRECTLY PRE- * C * DICTED THE OPPONENT'S MOVE WHEN IN 'THINK-AHEAD'* C * MODE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MATCH LOGICAL THNK AH, LOOK AH, FOUND M, MATCH COMMON /BOOK CM/ KEY, IN BOOK COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE LOGICAL IN BOOK, CLOCK, CQUERY COMMON /MOV CNT/ NCMOVS, NHMOVS COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 C1=(CELAP+CTOTAL)/NCMOVS H1=(HELAP+HTOTAL)/NHMOVS 600 IF(IN BOOK) GO TO 640 610 WRITE(DEVICE,620)MOVE 620 FORMAT(1X,'MOVE NUMBER ',I3) NTERM=0 LIM=DEPTH-1 DO 888 I=1,LIM NTERM=NTERM+NODES(I) 888 CONTINUE IF(.NOT. IN BOOK) WRITE(DEVICE,630) MAXPLY, NGEN, NTERM, * NODES(DEPTH), BACKUP(1),(NODES(I),I,I=1,DEPTH) 630 FORMAT( *1X,'MAXIMUM LOOK AHEAD WAS',I3,' PLY'/ *1X,'NUMBER OF MOVES GENERATED WAS',I7/ *1X,'NUMBER OF NON-TERMINAL NODES SEARCHED WAS',I6/ *1X,'NUMBER OF TERMINAL NODES SCORED WAS',I7/ *1X,'SCORE FOR SELECTED MOVE WAS',I6/ *1X,'NODES BY LEVEL',5(I6,'/',I1)/T16, *5(I6,'/',I1)) 640 WRITE(DEVICE,650)ELAPC,ELAPH,C1,H1 650 FORMAT( *1X,'TIME FOR MY LAST MOVE WAS',I5,' SECONDS'/ *1X,'TIME FOR YOUR LAST MOVE WAS',I4,' SECONDS'/ *1X,'I AM AVERAGING ',I4,' SECONDS PER MOVE'/ *1X,'YOU ARE AVERAGING ',I4,' SECONDS PER MOVE') MVS=NHMOVS IF(PRIGHT.GT.MVS) MVS=PRIGHT WRITE(DEVICE,660)PRIGHT,MVS 660 FORMAT(1X,'I HAVE PREDICTED ',I2,' OUT OF ',I2,' MOVES') RETURN END SUBROUTINE THINK(*,*) C C ************************************************************ C * * C * THINK IS THE DRIVER FOR THE 'THINK ON OPPONENT'S * C * TIME' ALGORITHM. BRIEFLY, THINK TAKES THE PREDICTED * C * MOVE, MAKES IT AND CALLS TO DETERMINE THE PRO- * C * RAMS RESPONSE TO IT. THIS MOVE IS SAVED AND IF THE * C * OPPONENT ACTUALLY MAKES THIS MOVE, THE PROGRAM HAS A * C * RESPONSE READY IMMEDIATELY. THE BREAK KEY MAY BE HIT * C * TO ENTER A MOVE OR COMMAND BEFORE THE PROGRAM HAS * C * FINISHED CALCULATION. IN THIS CASE ONE OF TWO ACTIONS * C * WILL BE TAKEN: * C * 1) IF A COMMAND IS ENTERED (OR A MOVE NOT IN THE * C * FORM DESCRIBED IN 2) BELOW) THE THINK-AHEAD * C * SEARCH IS ABORTED TO CARRY OUT THE COMMAND. * C * THE SEARCH WILL BE RE-STARTED FROM SCRATCH IF * C * A COMMAND IS ENTERED. * C * 2) IF A MOVE IS ENTERED IN IT'S FULLY QUALIFIED * C * FORM (IE P/K2-K4 RATHER THAN P-K4) THEN THE * C * PROGRAM WILL ABORT THE THINK-AHEAD ONLY IF * C * THE MOVE IS NOT IT'S PREDICTED MOVE. THIS * C * MEANS THAT WHATEVER TIME THE PROGRAM HAS USED * C * WHILE CALCULATING WILL NOT BE LOST. IF THE * C * FREE FORM OF INPUT (IE P-K4, ETC.) IS USED * C * THE SEARCH MUST BE RE-STARTED FROM SCRATCH * C * TO FIND THE RESPONSE, EVEN IF IT MATCHED THE * C * PREDICTED MOVE. (NOTE THAT THIS ONLY OCCURS * C * WHEN THE BUTTON IS HIT TO GET THE * C * PROGRAM'S ATTENTION. IF CALCULATION HAS BEEN * C * COMPLETED, THEN THE FREE FORM OF INPUT MAY BE * C * USED WITHOUT HINDERING THE PROGRAM. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /THAH CM/ THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG LOGICAL IN BOOK, THNK AH, LOOK AH, FOUND M, MTCHED, BRKFLG COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE COMMON /TRCE CM/ STRACE(20),TSCORE COMMON /P V MOVE/ PVMOVE, OVMOVE COMMON /THNK CM/ PTYPE8, PTO8, PFROM8 COMMON /MOV TIM/ MELAP, MSEC1, MSEC2 COMMON /BOOK CM/ KEY ,IN BOOK COMMON /PRED CM/ PTEXT(30) COMMON /BUFFER/ TEXT(30) COMMON /BOARD/ BOARD(120) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 IF(FOUNDM.OR.IN BOOK) RETURN C C------------------------------< REMEMBER PREDICTED MOVE C MOVE=MOVE+1 FROM8=STRACE(2) CALL EXTRCT FOUNDM=.FALSE. MTCHED=.FALSE. PTO8=TO8 PFROM8=FROM8 PTYPE8=TYPE8 C C------------------------------< IF NOT IN THINK-AHEAD MODE, RETURN; C------------------------------< OTHERWISE, MAKE THE PREDICTED MOVE C------------------------------< AND CALL TO CALCULATE A C------------------------------< RESPONSE. C IF(STRACE(2).EQ.0.OR..NOT. THNK AH) RETURN CALL OUTMOV(PFROM8,PTO8,PTYPE8,0,0,BOARD) DO 200 I=1,30 PTEXT(I)=TEXT(I) 200 CONTINUE CALL SAVE GB PLY=20 CALL PMOVER ON CONTROLY CALL BRK ON2 BRKFLG=.FALSE. C------------------------------< ACTUAL THINK-AHEAD STARTS HERE C LOOKAH=.TRUE. CALL PREANL IF(BRKFLG)GOTO 100 CALL CTIME(MSEC1) IF(BRKFLG) GOTO 100 CALL LOOK IF(BRKFLG) GOTO 100 CALL CTIME(MSEC2) MELAP=MSEC2-MSEC1 FOUNDM=.TRUE. CALL REST GB LOOKAH=.FALSE. IF(MTCHED) GO TO 300 RETURN C C------------------------------< OPERATOR HIT BREAK AND DID NOT C------------------------------< TYPE IN A FULLY QUALIFIED MOVE C------------------------------< (OR HE TYPED IN A COMMAND) SO C------------------------------< ABORT THE LOOK-AHEAD AND SEE C------------------------------< WHAT HE HAS ON HIS MIND. C 100 FOUNDM=.FALSE. LOOK AH=.FALSE. CALL REST GB RETURN 2 C C------------------------------< OPERATOR TYPED IN A FULLY QUALIFIED C------------------------------< MOVE WHICH MATCHED THE PREDICTED C------------------------------< RESPONSE, RETURN SKIPPING THE READ C------------------------------< SO HE DON'T GOTTA TYPE IT IN AGAIN. C 300 TO8=PTO8 FROM8=PFROM8 TYPE8=PTYPE8 RETURN 1 END SUBROUTINE TIMEX C C ************************************************************ C * * C * TIMER IS USED TO OBTAIN ELAPSED/CPU TIME FOR THE * C * PROGRAM. 'ETIME' IS THE ELAPSED TIME ENTRY POINT AND * C * 'CTIME' IS THE CPU TIME ENTRY POINT. IF THE CLOCK * C * TYPE HAS BEEN FORCED TO ELAPSED BY THE 'CT' COMMAND, * C * THE CPU TIME ROUTINE RETURNS ELAPSED TIME ALSO. * C * ALL TIMES ARE IN SECONDS. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) SYSTEM INTRINSIC TIMER, PROCTIME COMMON /INIT/ INITIM COMMON /CLOK CM/ CLOCK,CTYPE,CQUERY,GELAP,CELAP,HELAP, *ELAPC,ELAPH,MOVES,SMOVES,SELAP,CTOTAL,HTOTAL,OPTIME LOGICAL CLOCK, CQUERY DATA IELAP /0J/, I/500J/ ENTRY ETIME(TIME) 200 CONTINUE IELAP=TIMER/1000-INITIM TIME=IELAP RETURN ENTRY CTIME(TIME) GO TO (100,200),CTYPE 100 CONTINUE I=PROCTIME/1000 TIME=I RETURN END SUBROUTINE TSCORE C C ************************************************************ C * * C * TSCORE IS USED TO COMPUTE THE SCORE OF THE CURRENT * C * VARIATION OF MOVES. WHEN A TERMINAL NODE IS REACHED, * C * TSCORE IS CALLED TO MINIMAX THE PLAUSIBILITY SCORES OF * C * EACH MOVE IN THE CURRENT VARIATION. THIS SIMPLY MEANS * C * ADD UP THE SCORES FOR THE COMPUTER MOVES AND SUBTRACT * C * THE SCORES FOR THE HUMAN MOVES. IF THE LAST MOVE IN * C * THE VARIATION IS NOT A CASTLE, EXCHNG IS CALLED TO * C * ANALYZE THE EXCHANGE POTENTIAL OF THE LAST MOVE. THIS * C * PREVENTS THE PROGRAM FROM GIVING A GOOD SCORE TO A LINE * C * THAT LEAVE A PIECE OPEN TO CAPTURE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /MSCORE/ SCORE COMMON /MOVE CM/ FROMSQ, TOSQ, SIDE LOGICAL SIDE COMMON /STAT CM/ NODES(10), NGEN, MAXPLY, PRIGHT COMMON /TYPES/ NORMAL,CASTRT,CASTLF,ENPASS,PROMOTE SCORE=VALUE(1) C C------------------------------< MINIMAX THE SCORE FOR THE CURRENT C------------------------------< VARIATION UNDER ANALYSIS. C TOGGLE=-1 DO 1 I=2,PLY SCORE=SCORE+TOGGLE*VALUE(I) TOGGLE=-TOGGLE 1 CONTINUE C C------------------------------< IF THE LAST MOVE IS NOT A CASTLE C------------------------------< MOVE, CALL EXCHNG TO EVALUATE THE C------------------------------< EXCHANGE POSSIBILITIES FOR IT. C IF(TYPE8.EQ.CASTLF.OR.TYPE8.EQ.CASTRT) GO TO 3 C C------------------------------< IF THIS MOVE HAS AN EXCHNG SCORE C------------------------------< OF ZERO (0), THERE IS NO USE IN C------------------------------< EXAMINING FURTHER MOVES AT THIS C------------------------------< LEVEL SINCE THE HIGHEST SCORES C------------------------------< ARE ORDERED FIRST. SET THE LAST C------------------------------< MOVE POINTER TO THE CURRENT MOVE C------------------------------< AND RETURN. C TEMP=EXCHNG(TO8,SIDE) IF(TEMP.GT.0) GO TO 2 STOP(PLY)=WHICH(PLY) 2 SCORE=SCORE+TOGGLE*TEMP 3 RETURN END $CONTROL SEGMENT=CMND SUBROUTINE VCMND(DEVICE) C C ************************************************************ C * * C * VCMND IS USED TO PROCESS THE 'V' COMMAND WHICH OUT- * C * PUTS THE PRINCIPLE VARIATION FOR THE MACHINE'S CHOSEN * C * MOVE. THE MOVES ARE LISTED AS MACHINES CHOSEN MOVE, * C * HUMAN'S BEST RESPONSE, COMPUTER'S BEST RESPONSE, ETC. * C * FOR AS DEEP AS THE VARIATION GOES. OUTPUT MAY GO TO * C * THE USER TERMINAL OR THE LINE PRINTER. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /INFO/ TYPE8, VALUE8, TO8, FROM8 COMMON /TREE/ TREE(400),START(10),STOP(10),WHICH(10),BACKUP(10), *FROM(10),TO(10),VALUE(10),TYPE(10),PLY COMMON /PRUNE/ WIDTH(10), MIN(10), MAX(10), * DEPTH, ORDER1, ORDER2 COMMON /DATA/ CMOVE, SMOVE, HFROM8, HTO8, HTYPE8, MOVE COMMON /TRCE CM/ STRACE(20), TSCORE COMMON /BUFFER/ TEXT(30) COMMON /V CM/ VCMOVE C C------------------------------< IF NO VARIATION WAS FOUND, RETURN C IF(STRACE(2).EQ.0) GO TO 8 CALL SAVE GB C C------------------------------< UNMAKE PROGRAM'S LAST MOVE C FROM8=VCMOVE CALL EXTRCT PLY=1 CALL PUMVER 1 WRITE(DEVICE,2) 2 FORMAT(1X,'ORDER VALUE MOVE') C C------------------------------< DETERMINE DEPTH OF VARIATION C MAXD=9999-IABS(TSCORE) IF(MAXD.GT.DEPTH) MAXD=DEPTH 3 CONTINUE C C------------------------------< CONVERT MOVES AND OUTPUT WITH SCORES C 4 DO 6 PLY=1,MAXD FROM8=STRACE(PLY) CALL EXTRCT ETYPE8=0 IF(ABS(TSCORE).GT.7900.AND.PLY.EQ.MAXD) ETYPE8=3 CALL OUTMOV(FROM8,TO8,TYPE8,ETYPE8,PLY,BOARD) T=STRACE(PLY+10)+1 WRITE(DEVICE,5)T,VALUE8,TEXT 5 FORMAT(2X,I3,1X,I6,2X,30R1) 6 CALL MOVER WRITE(DEVICE,7)TSCORE 7 FORMAT(1X,'MINIMAXED SCORE: ',I5) CALL REST GB RETURN 8 WRITE(DEVICE,9) RETURN 9 FORMAT(1X,'NO VARIATION IS PRESENT') END INTEGER FUNCTION WORTH(SQUARE,SIDE) C C ************************************************************ C * * C * WORTH COMPUTES THE VALUE OR WORTH OF A PIECE ON A * C * GIVEN SQUARE FOR EITHER SIDE. THE VALUE IS THE VALUE * C * OF THE PIECE PLUS THE VALUE RETURNED BY THE SCORING * C * FUNCTION FOR THAT PIECE. * C * * C ************************************************************ C IMPLICIT INTEGER*4 (A-Z) COMMON /BOARD/ BOARD(120) COMMON /PIEC CM/ PVALUE(13), PINIT(13) LOGICAL SIDE C C------------------------------< COMPUTE MATERIAL VALUE OF PIECE C TEMP=BOARD(SQUARE) WORTH=PVALUE(TEMP) C C------------------------------< COMPUTE TACTICAL VALUE OF PIECE C TEMP=MOD(TEMP,7) GO TO (100,200,300,400,500,600,999, * 100,200,300,400,500,600,999),TEMP 100 WORTH=WORTH+PSCORE(SQUARE,SIDE) GO TO 999 200 WORTH=WORTH+NSCORE(SQUARE,SIDE) GO TO 999 300 WORTH=WORTH+BSCORE(SQUARE,SIDE) GO TO 999 400 WORTH=WORTH+RSCORE(SQUARE,SIDE) GO TO 999 500 WORTH=WORTH+QSCORE(SQUARE,SIDE) GO TO 999 600 WORTH=WORTH+KSCORE(SQUARE,SIDE) 999 RETURN END GO TO 999 500 WORTH=WORTH+QSCORE(SQUARE,SIDE) GO TO 999 600 WORTH=WORTH+KSCORE(SQUARE,SIDE) 999 RETURN END GO TO 999 500 WORTH=WORTH+QSCORE(SQUARE,SIDE) GO TO 999 600 WORTH=WORTH+KSCORE(SQUARE,SIDE) 999 RETURN END GO TO 999 500 WORTH=WORTH+QSCORE(SQUARE,SIDE) GO TO 999 600 WORTH=WORTH+KSCORE(SQUARE,SIDE) 999 RETURN END GO TO 999 500 WORTH=WORTH+QSCORE(SQUARE,SIDE)