C MODIFIED FOR CROMEMCO'S Z80 FORTRAN, 20/9/1978 DIMENSION NICT(16) COMMON/BOARD/JBOARD(120) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/BAL/MATBAL,LEV COMMON/KEY/KEY(8),NUMB(8),MEN(6),IA,IB,ID,IR,IO,IW,ISTR,MINUS LR=1 LP=1 WRITE(LP,101) 101 FORMAT(1X//1X,19HMIKES CHESS PROGRAM//) KECK=0 149 WRITE(LP,150) 150 FORMAT(1X,14HLEVEL 0 OR 1 ?) READ(LR,160)LEV 160 FORMAT(I1) IF(LEV.LT.0)GO TO 149 IF(LEV.GT.1)GO TO 149 MOVE=0 WRITE(LP,102) 102 FORMAT(1X,42HCOMPUTER TO PLAY WHITE (0) OR BLACK (1) ? ) READ(LR,103)KOLOR 103 FORMAT(I1) WRITE(LP,104) 104 FORMAT(1X) IF(KOLOR)20,20,11 20 CALL HEUR(MOVE) CALL TREE(MOV,MATE) IF(KECK)30,30,31 30 IF(MATE)15,15,37 31 IF(MATE)34,34,33 33 WRITE(LP,105) 105 FORMAT(1X,4HMATE/1X,16H YOU WERE LUCKY) GO TO 26 34 WRITE(LP,104) GO TO 32 15 WRITE(LP,104) 32 CALL MYGO(LSQ,NSQ,KAPT,MOV,KASTLE,IPROM,KECK) WRITE(LP,46)MOVE 46 FORMAT(1X,I2,2H. ,10HMY MOVE:- ) IF(KASTLE)55,57,56 55 WRITE(LP,106) 106 FORMAT(1X,4HO-OO) GO TO 24 56 WRITE(LP,107) 107 FORMAT(1X,3HO-O) GO TO 24 57 IF(KAPT)27,27,28 27 LD=MINUS GO TO 29 28 LD=ISTR 29 LSQ=LSQ-21 DO 41 IJ=1,8 IF(LSQ.LT.10)GO TO 42 LSQ=LSQ-10 41 CONTINUE 42 NSQ=NSQ-21 DO 43 KJ=1,8 IF(NSQ.LT.10)GO TO 44 NSQ=NSQ-10 43 CONTINUE 44 IF(KOLOR)71,71,70 70 IJ=9-IJ KJ=9-KJ 71 WRITE(LP,45)KEY(LSQ),IJ,LD,KEY(NSQ),KJ 45 FORMAT(1X,A1,I1,A1,A1,I1) IF(IPROM)24,24,23 23 WRITE(LP,108) 108 FORMAT(1X,24H PAWN PROMOTES TO QUEEN) 24 IF(KECK)35,35,36 35 IF(MATE)37,8,8 36 IF(MATE)38,39,39 37 WRITE(LP,109) 109 FORMAT(1X,11H STALEMATE) GO TO 26 38 WRITE(LP,110) 110 FORMAT(1X,11H CHECKMATE/1X,11H THANK YOU) GO TO 26 39 WRITE(LP,111) 111 FORMAT(1X,7H CHECK) 8 CONTINUE 11 WRITE(LP,47) 47 FORMAT(3X,12HYOUR MOVE:- ) READ(LR,48)L1,N1,IL,L2,N2 48 FORMAT(5A1) KASTLE=0 IF(L1.EQ.IB.AND.IL.EQ.IA.AND.L2.EQ.IR)GO TO 200 IF(L1.EQ.ID.AND.IL.EQ.IA.AND.L2.EQ.IW)GO TO 300 IF(L1.EQ.IO.AND.IL.EQ.IO)KASTLE=1 IF(KASTLE.EQ.1.AND.L2.EQ.IO)KASTLE=-1 IF(KASTLE)63,62,63 62 DO 401 IJ=1,8 IF(N1.EQ.NUMB(IJ))GO TO 402 401 CONTINUE GO TO 11 402 DO 403 KJ=1,8 IF(N2.EQ.NUMB(KJ))GO TO 404 403 CONTINUE GO TO 11 404 IF(KOLOR)73,73,72 72 IJ=9-IJ KJ=9-KJ 73 DO 49 I=1,8 IF(L1.EQ.KEY(I))GO TO 50 49 CONTINUE GO TO 11 50 LSQ=10*(IJ-1)+I+21 DO 51 I=1,8 IF(L2.EQ.KEY(I))GO TO 52 51 CONTINUE GO TO 11 52 NSQ=10*(KJ-1)+I+21 63 CALL ISGO(LSQ,NSQ,ILLEG,KASTLE,ILLCAS,IPROM,KECK) IF(IPROM)19,19,18 18 WRITE(LP,108) 19 IF(KECK)10,10,9 9 WRITE(LP,25) 25 FORMAT(3X,5HCHECK) 10 IF(ILLCAS)61,61,60 60 WRITE(LP,112) 112 FORMAT(1X,27H ILLEGAL ATTEMPT TO CASTLE) GO TO 11 61 IF(ILLEG)20,13,12 12 WRITE(LP,113) 113 FORMAT(1X,14H ILLEGAL MOVE) GO TO 11 13 WRITE(LP,114) 114 FORMAT(1X,25H ILLEGAL MOVE INTO CHECK) GO TO 11 200 WRITE(LP,104) IDOT=0 IF(KOLOR)201,201,202 201 WRITE(LP,115) 115 FORMAT(1X,33H H G F E D C B A) NUM=0 KL=1 GO TO 203 202 WRITE(LP,116) 116 FORMAT(1X,33H A B C D E F G H) NUM=9 KL=-1 203 DO 216 LINE=21,100,10 NUM=NUM+KL IDOT=1-IDOT DO 214 I=1,8 IPC=ISTR KOL=ISTR IDOT=IDOT+1 IF(IDOT-2)218,217,217 217 IDOT=0 IPC=MINUS KOL=MINUS 218 IF(KOLOR)223,223,224 223 IP=LINE+9-I GO TO 225 224 IP=LINE+I 225 JBI=JBOARD(IP) DO 207 IT=1,6 IF(JBI.EQ.MYVAL(IT))GO TO 208 IF(JBI.EQ.ISVAL(IT))GO TO 209 207 CONTINUE GO TO 212 208 IF(KOLOR)211,211,210 209 IF(KOLOR)210,210,211 210 KOL=IB GO TO 219 211 KOL=IW 219 IPC=MEN(IT) 212 NICT(2*I-1)=KOL NICT(2*I)=IPC 214 CONTINUE WRITE(LP,213)NUM,NICT,NUM 213 FORMAT(8X,I1,1X,8(1X,2A1),3X,I1) 216 CONTINUE IF(KOLOR)220,220,221 220 WRITE(LP,115) GO TO 222 221 WRITE(LP,116) 222 WRITE(LP,104) GO TO 11 300 IF(MATBAL+15)301,302,302 301 WRITE(LP,117) 117 FORMAT(1X,21H YES - O.K. ACCEPTED) GO TO 26 302 IF(MATBAL-70)303,304,304 303 WRITE(LP,118) 118 FORMAT(1X,21H NO - OFFER DECLINED) GO TO 11 304 WRITE(LP,119) 119 FORMAT(1X,20H YOU MUST BE JOKING) GO TO 11 26 CALL EXIT END BLOCKDATA COMMON/INCRE/INK(16) COMMON/BOARD/JBOARD(120) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/FIELD/KFLD(100),KENT(100),KPRI(6),IJK(10) COMMON/KEY/KEY(8),NUMB(8),MEN(6),IA,IB,ID,IR,IO,IW,ISTR,MINUS COMMON/LARGE/JBIG,JVBIG COMMON/NGAME/NGAME,LIMIT COMMON/BAL/MATBAL,LEV DATA INK/-9,-11,9,11,1,10,-1,-10,8,12,19,21,-8,-12,-19,-21/ DATA JBOARD/ + 1111,1111,1111,1111,1111,1111,1111,1111,1111,1111 + ,1111,1111,1111,1111,1111,1111,1111,1111,1111,1111 + ,1111, 50, 33, 35, 90, 900, 35, 33, 50,1111 + ,1111, 10, 10, 10, 10, 10, 10, 10, 10,1111 + ,1111, 0, 0, 0, 0, 0, 0, 0, 0,1111 + ,1111, 0, 0, 0, 0, 0, 0, 0, 0,1111 + ,1111, 0, 0, 0, 0, 0, 0, 0, 0,1111 + ,1111, 0, 0, 0, 0, 0, 0, 0, 0,1111 + ,1111, -10, -10, -10, -10, -10, -10, -10, -10,1111 + ,1111, -50, -33, -35, -90,-900, -35, -33, -50,1111 + ,1111,1111,1111,1111,1111,1111,1111,1111,1111,1111 + ,1111,1111,1111,1111,1111,1111,1111,1111,1111,1111/ DATA MYPCE/36,35,23,28,34,37,24,27,25,22,29,33,38,32,39,26/ DATA MYTYPE/6, 6, 4, 4, 6, 6, 3, 3, 1, 2, 2, 6, 6, 6, 6, 5/ DATA NUMB/2H1 ,2H2 ,2H3 ,2H4 ,2H5 ,2H6 ,2H7 ,2H8 / DATA MYMEN,MYQN,MYKG,MYVAL/16,1,1,90,50,35,33,900,10/ DATA ISPCE/86,85,93,98,84,87,94,97,95,92,99,83,88,82,89,96/ DATA ISTYPE/6, 6, 4, 4, 6, 6, 3, 3, 1, 2, 2, 6, 6, 6, 6, 5/ DATA ISMEN,ISQN,ISKG,ISVAL/16,1,1,-90,-50,-35,-33,-900,-10/ DATA KENT/ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + , 0, 0, 1, 2, 3, 3, 2, 1, 0, 0 + , 0, 1, 3, 4, 5, 5, 4, 3, 1, 0 + , 0, 2, 4, 6, 7, 7, 6, 4, 2, 0 + , 0, 3, 5, 7, 8, 8, 7, 5, 3, 0 + , 0, 3, 5, 7, 8, 8, 7, 5, 3, 0 + , 0, 2, 4, 6, 7, 7, 6, 4, 2, 0 + , 0, 1, 3, 4, 5, 5, 4, 3, 1, 0 + , 0, 0, 1, 2, 3, 3, 2, 1, 0, 0/ DATA KFLD/100*0/,KPRI/2,0,3,4,0,1/,IJK/10,8,2,7*0/ DATA KEY/2HA ,2HB ,2HC ,2HD ,2HE ,2HF ,2HG ,2HH / DATA MEN/2HQ ,2HR ,2HB ,2HN ,2HK ,2HP / DATA IA/2HA /,IB/2HB /,ID/2HD /,IR/2HR /,IO/2HO /,IW/2HW / +,ISTR/2H: /,MINUS/2H- / DATA NGAME/0/,LIMIT/1090/,MATBAL/0/,JBIG/10000/,JVBIG/30000/ END SUBROUTINE HEUR(MOVE) COMMON MOVES(100,4),MARK(100),NMOVE COMMON/BOARD/JBOARD(120) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/FIELD/KFLD(100),KENT(100),KPRI(6),IJK(10) COMMON/LARGE/JBIG,JVBIG COMMON/NGAME/NGAME,LIMIT MOVE=MOVE+1 IF(MOVE-9)8,7,44 7 KPRI(5)=1 KPRI(2)=2 KPRI(6)=3 44 IF(NGAME.EQ.1)GO TO 104 MYTOT=0 DO 100 I=1,MYMEN NJ=MYTYPE(I) 100 MYTOT=MYTOT+MYVAL(NJ) IF(MYTOT-LIMIT)103,103,101 101 ISTOT=0 DO 102 I=1,ISMEN NJ=ISTYPE(I) 102 ISTOT=ISTOT+ISVAL(NJ) IF(ISTOT+LIMIT)104,103,103 103 NGAME=1 KPRI(1)=1 KPRI(2)=1 KPRI(5)=4 KPRI(6)=0 104 DO 47 I=1,ISMEN IF(ISTYPE(I)-5)47,46,47 46 KI=ISPCE(I) GO TO 48 47 CONTINUE 48 KFLD(KI)=99 DO 71 KJ=1,10 IF(KI.LE.10)GO TO 72 KI=KI-10 71 CONTINUE 72 IPR=0 73 IPR=IPR+1 IF(IPR.GT.10)GO TO 8 I=KI-IPR IF(I.LE.0)GO TO 75 DO 74 L=1,10 LP=10*(L-1)+I 74 KFLD(LP)=IJK(IPR) 75 I=KI+IPR IF(I.GT.10)GO TO 77 DO 76 L=1,10 LP=10*(L-1)+I 76 KFLD(LP)=IJK(IPR) 77 J=KJ-IPR IF(J.LE.0)GO TO 79 DO 78 L=1,10 LP=10*(J-1)+L 78 KFLD(LP)=IJK(IPR) 79 J=KJ+IPR IF(J.GT.10)GO TO 73 DO 80 L=1,10 LP=10*(J-1)+L 80 KFLD(LP)=IJK(IPR) GO TO 73 8 NMOVE=0 CALL MYCAS MAN=0 1 CALL WMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NX,IP,MORE,0) IF(MORE)3,3,2 2 NMOVE=NMOVE+1 MOVES(NMOVE,1)=JV MOVES(NMOVE,2)=LSQ MOVES(NMOVE,3)=NSQ MOVES(NMOVE,4)=KON JT=MYTYPE(MAN) MARK(NMOVE)=KPRI(JT)*(KENT(NSQ)-KENT(LSQ)+KFLD(NSQ)-KFLD(LSQ)) IBON=0 IF(JT-6)6,4,4 4 IF(KON)35,19,35 19 IF(NSQ-56)24,20,24 20 IF(LSQ-36)22,21,22 21 IBON=30 IF(JBOARD(65).EQ.ISVAL(6).OR.JBOARD(67).EQ.ISVAL(6))IBON=5 GO TO 5 22 IF(LSQ-46)5,28,5 24 IF(NSQ-55)29,25,29 25 IF(LSQ-35)27,26,27 26 IBON=20 IF(JBOARD(64).EQ.ISVAL(6).OR.JBOARD(66).EQ.ISVAL(6))IBON=5 GO TO 5 27 IF(LSQ-45)5,28,5 28 IBON=2 GO TO 5 29 IF(LSQ-32)30,31,30 30 IF(LSQ-39)39,31,39 31 IBON=-5 GO TO 5 39 IF(LSQ-35)52,51,52 52 IF(LSQ-36)5,51,5 51 IBON=10 GO TO 5 35 IF(MARK(NMOVE))36,37,37 36 IBON=-5 GO TO 38 37 IBON=5 38 IF(JBOARD(NSQ-10).EQ.MYVAL(6))IBON=IBON-10 IF(JBOARD(NSQ+10).EQ.MYVAL(6))IBON=IBON-10 GO TO 5 6 IF(MOVE.GE.9)GO TO 40 IF(JT.EQ.4.AND.(NSQ.EQ.42.OR.NSQ.EQ.49))IBON=-15 IF(NSQ.EQ.45.AND.JBOARD(35).EQ.MYVAL(6))IBON=-50 IF(NSQ.EQ.46.AND.JBOARD(36).EQ.MYVAL(6))IBON=-50 IF(JT.EQ.3.AND.LSQ.EQ.27)IBON=IBON+2 IF(JT.EQ.4.AND.LSQ.EQ.28)IBON=IBON+2 GO TO 50 5 IF(MOVE.LT.9)GO TO 50 40 M2=0 41 CALL WMOVE(M2,JV2,LSQ2,NSQ2,KON2,IPT2,IFN2,KC2,NX2,IP2,MOR2,0) IF(MOR2)45,45,42 42 IBON=IBON+1 GO TO 41 45 IF(LSQ.EQ.44.AND.JBOARD(34).EQ.MYVAL(6))IBON=IBON+5 IF(LSQ.EQ.47.AND.JBOARD(37).EQ.MYVAL(6))IBON=IBON+5 IF(NGAME)50,50,105 105 IF(JT.NE.6)GO TO 50 IBON=IBON+10 IF(NSQ-LSQ.EQ.20)IBON=IBON+5 50 MARK(NMOVE)=MARK(NMOVE)+IBON GO TO 1 3 DO 14 I=1,NMOVE JB=-JBIG DO 12 J=I,NMOVE IF(MARK(J)-JB)12,12,11 11 IP=J JB=MARK(J) 12 CONTINUE DO 13 K=1,4 INTER=MOVES(I,K) MOVES(I,K)=MOVES(IP,K) 13 MOVES(IP,K)=INTER MARK(IP)=MARK(I) 14 CONTINUE RETURN END SUBROUTINE MYCAS COMMON MOVES(100,4),MARK(100),NMOVE COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BOARD/JBOARD(120) IF(MYQN)10,10,1 1 DO 3 I=23,25 IF(JBOARD(I))10,3,10 3 CONTINUE MAN=0 4 CALL BMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NX,IP,MORE,0) IF(MORE)6,10,5 5 IF(NSQ.GE.24.AND.NSQ.LE.26)MORE=0 GO TO 4 6 NMOVE=NMOVE+1 MOVES(NMOVE,1)=-1 MARK(NMOVE)=40 10 IF(MYKG)20,20,11 11 DO 12 I=27,28 IF(JBOARD(I))20,12,20 12 CONTINUE MAN=0 13 CALL BMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NX,IP,MORE,0) IF(MORE)15,20,14 14 IF(NSQ.GE.26.AND.NSQ.LE.28)MORE=0 GO TO 13 15 NMOVE=NMOVE+1 MOVES(NMOVE,1)=0 MARK(NMOVE)=90 20 RETURN END C CREATE AND SEARCH MOVE TREE SUBROUTINE TREE(MOV,MATE) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/BAL/MATBAL,LEV COMMON/LARGE/JBIG,JVBIG MATE=0 IJ=1 IK=1 C ADJUST DEPTH TO SUIT COMPUTER SPEED C LEV=0 FOR SLOW COMPUTERS; LEV=1 FOR FASTER COMPUTERS MYKING=MYVAL(5) ISKING=ISVAL(5) JAB1=-JVBIG MOR1=1 NM=0 11 CALL FMOVE(JV1,LSQ1,NSQ1,KON1,NM,KAS,IP1,MOR1) IF(MOR1)10,10,41 41 JAB2=JVBIG M2=0 12 CALL BMOVE(M2,JV2,LSQ2,NSQ2,KON2,IPT2,IFN2,KC2,NX2,IP2,MOR2,0) IF(MOR2)8,9,42 42 IF(KON2-MYKING)61,60,61 60 MOR2=0 IJ=M2 GO TO 12 61 JAB3=JAB1 M3=0 13 CALL WMOVE(M3,JV3,LSQ3,NSQ3,KON3,IPT3,IFN3,KC3,NX3,IP3,MOR3,0) IF(MOR3)6,7,43 43 IF(KON3-ISKING)63,62,63 62 MOR3=0 IK=M3 GO TO 13 63 JAB4=JAB2 M4=0 IF(MATBAL-JAB4)21,22,22 21 JAB4=MATBAL 22 IF(JAB4.LE.JAB3)GO TO 5 14 CALL BMOVE(M4,JV4,LSQ4,NSQ4,KON4,IPT4,IFN4,KC4,NX4,IP4,MOR4,1) IF(MOR4)4,5,44 44 IF(KON4-MYKING)70,69,70 69 JAB4=-JBIG GO TO 3 70 JAB5=JAB3 M5=0 IF(MATBAL-JAB5)24,24,23 23 JAB5=MATBAL 24 IF(JAB5.GE.JAB4)GO TO 3 15 CALL WMOVE(M5,JV5,LSQ5,NSQ5,KON5,IPT5,IFN5,KC5,NX5,IP5,MOR5,1) IF(MOR5)2,3,45 45 IF(LEV)46,46,101 46 IF(MATBAL-JAB5)26,26,120 120 JAB5=MATBAL GO TO 26 101 IF(KON5-ISKING)103,102,103 102 JAB5=JBIG GO TO 26 103 JAB6=JAB4 M6=0 IF(MATBAL-JAB6)104,105,105 104 JAB6=MATBAL 105 IF(JAB6.LE.JAB5)GO TO 26 106 CALL BMOVE(M6,JV6,LSQ6,NSQ6,KON6,IPT6,IFN6,KC6,NX6,IP6,MOR6,1) IF(MOR6)25,26,107 107 IF(KON6-MYKING)109,108,109 108 JAB6=-JBIG GO TO 117 109 JAB7=JAB5 M7=0 IF(MATBAL-JAB7)111,111,110 110 JAB7=MATBAL 111 IF(JAB7.GE.JAB6)GO TO 117 112 CALL WMOVE(M7,JV7,LSQ7,NSQ7,KON7,IPT7,IFN7,KC7,NX7,IP7,MOR7,1) IF(MOR7)116,117,113 113 IF(MATBAL-JAB7)115,115,114 114 JAB7=MATBAL 115 IF(JAB7.GE.JAB6)MOR7=0 GO TO 112 116 JAB6=JAB7 117 IF(JAB6.LE.JAB5)MOR6=0 GO TO 106 25 JAB5=JAB6 26 IF(JAB5.GE.JAB4)MOR5=0 GO TO 15 2 JAB4=JAB5 3 IF(JAB4.LE.JAB3)MOR4=0 GO TO 14 4 JAB3=JAB4 IK=M3 5 IF(JAB3.GE.JAB2)MOR3=0 GO TO 13 6 JAB2=JAB3 IJ=M2 7 IN3=MYPCE(IK) IN4=MYTYPE(IK) 33 IF(IK.EQ.1)GO TO 34 IK1=IK-1 MYPCE(IK)=MYPCE(IK1) MYTYPE(IK)=MYTYPE(IK1) IK=IK1 GO TO 33 34 MYPCE(1)=IN3 MYTYPE(1)=IN4 IF(JAB2.LE.JAB1)MOR2=0 GO TO 12 8 JAB1=JAB2 MOV=NM 9 IN1=ISPCE(IJ) IN2=ISTYPE(IJ) 31 IF(IJ.EQ.1)GO TO 32 IJ1=IJ-1 ISPCE(IJ)=ISPCE(IJ1) ISTYPE(IJ)=ISTYPE(IJ1) IJ=IJ1 GO TO 31 32 ISPCE(1)=IN1 ISTYPE(1)=IN2 GO TO 11 10 IF(JAB1.EQ.-JVBIG)MATE=1 IF(JAB1.EQ.JVBIG)MATE=-1 RETURN END SUBROUTINE FMOVE(JV,LSQ,NSQ,KON,NM,KASTLE,IPROM,MORE) COMMON MOVES(100,4),MARK(100),NMOVE COMMON/BOARD/JBOARD(120) COMMON/BAL/MATBAL,LEV COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG IF(MORE)4,4,5 5 IF(NM)2,2,1 1 IF(KASTLE)28,29,27 27 JBOARD(26)=MYVAL(5) JBOARD(27)=0 JBOARD(28)=0 JBOARD(29)=MYVAL(2) DO 30 I=1,MYMEN IF(MYPCE(I).EQ.28)MYPCE(I)=26 IF(MYPCE(I).EQ.27)MYPCE(I)=29 30 CONTINUE GO TO 2 28 JBOARD(22)=MYVAL(2) JBOARD(24)=0 JBOARD(25)=0 JBOARD(26)=MYVAL(5) DO 31 I=1,MYMEN IF(MYPCE(I).EQ.24)MYPCE(I)=26 IF(MYPCE(I).EQ.25)MYPCE(I)=22 31 CONTINUE GO TO 2 29 DO 23 MAN=1,MYMEN IF(MYPCE(MAN).EQ.NSQ)GO TO 24 23 CONTINUE 24 IF(IPROM)25,25,26 26 MATBAL=MATBAL-MYVAL(1)+MYVAL(6) JV=MYVAL(6) MYTYPE(MAN)=6 25 MYPCE(MAN)=LSQ JBOARD(LSQ)=JV JBOARD(NSQ)=KON MATBAL=MATBAL+KON 2 NM=NM+1 IF(NM-NMOVE)4,4,3 3 MORE=-1 GO TO 7 4 IPROM=0 KASTLE=0 JV=MOVES(NM,1) IF(JV)10,9,8 9 KASTLE=1 JBOARD(26)=0 JBOARD(27)=MYVAL(2) JBOARD(28)=MYVAL(5) JBOARD(29)=0 DO 11 I=1,MYMEN IF(MYPCE(I).EQ.26)MYPCE(I)=28 IF(MYPCE(I).EQ.29)MYPCE(I)=27 11 CONTINUE GO TO 7 10 KASTLE=-1 JBOARD(22)=0 JBOARD(24)=MYVAL(5) JBOARD(25)=MYVAL(2) JBOARD(26)=0 DO 12 I=1,MYMEN IF(MYPCE(I).EQ.26)MYPCE(I)=24 IF(MYPCE(I).EQ.22)MYPCE(I)=25 12 CONTINUE GO TO 7 8 LSQ=MOVES(NM,2) NSQ=MOVES(NM,3) KON=MOVES(NM,4) DO 33 MAN=1,MYMEN IF(MYPCE(MAN).EQ.LSQ)GO TO 34 33 CONTINUE 34 IF(MYTYPE(MAN)-6)6,21,21 21 IF(NSQ-90)6,22,22 22 MATBAL=MATBAL+MYVAL(1)-MYVAL(6) JV=MYVAL(1) MYTYPE(MAN)=1 IPROM=1 6 MYPCE(MAN)=NSQ JBOARD(LSQ)=0 JBOARD(NSQ)=JV MATBAL=MATBAL-KON 7 RETURN END C GENERATE A WHITE MOVE SUBROUTINE WMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NEXT,IP,MORE,KP) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BOARD/JBOARD(120) COMMON/BAL/MATBAL,LEV COMMON/INCRE/INK(16) IF(MAN)86,86,81 86 IP=0 MORE=1 GO TO 82 81 IF(IP)65,65,64 64 MATBAL=MATBAL-MYVAL(1)+MYVAL(6) JV=MYVAL(6) MYTYPE(MAN)=6 IP=0 65 MYPCE(MAN)=LSQ JBOARD(LSQ)=JV JBOARD(NSQ)=KON MATBAL=MATBAL+KON IF(MORE)38,38,83 83 IF(NEXT)16,24,29 82 MAN=MAN+1 IF(MAN-MYMEN)84,84,85 85 MORE=-1 GO TO 38 84 LSQ=MYPCE(MAN) JV=JBOARD(LSQ) NAME=MYTYPE(MAN) IF(JV-MYVAL(NAME))82,7,82 7 GO TO(41,8,9,17,18,40),NAME C QUEEN,ROOK OR BISHOP MOVE 41 IPT=0 IFN=8 GO TO 12 8 IPT=4 IFN=8 GO TO 12 9 IPT=0 IFN=4 12 NEXT=-1 10 IPT=IPT+1 IF(IPT.GT.IFN)GO TO 82 KC=INK(IPT) NSQ=LSQ 11 NSQ=NSQ+KC KON=JBOARD(NSQ) IF(KON)37,36,10 16 IF(KON)10,11,10 C KING OR KNIGHT MOVE 17 IPT=8 IFN=16 GO TO 19 18 IPT=0 IFN=8 19 NEXT=0 24 IPT=IPT+1 IF(IPT.GT.IFN)GO TO 82 NSQ=LSQ+INK(IPT) KON=JBOARD(NSQ) IF(KON)37,36,24 C PAWN MOVE 40 NEXT=1 IPT=0 29 IPT=IPT+1 IF(IPT.GT.4)GO TO 82 IF(IPT-2)27,31,30 27 NSQ=LSQ+10 KON=JBOARD(NSQ) IF(KON)28,43,28 43 IF(NSQ-90)36,51,51 28 IPT=2 GO TO 29 31 IF(LSQ-40)32,32,29 32 NSQ=LSQ+20 KON=JBOARD(NSQ) IF(KON)29,36,29 30 NSQ=LSQ+INK(IPT) KON=JBOARD(NSQ) IF(KON)44,29,29 44 IF(NSQ-90)37,51,51 36 IF(KP)37,37,83 51 MATBAL=MATBAL+MYVAL(1)-MYVAL(6) JV=MYVAL(1) MYTYPE(MAN)=1 IP=1 37 MYPCE(MAN)=NSQ JBOARD(LSQ)=0 JBOARD(NSQ)=JV MATBAL=MATBAL-KON 38 RETURN END C GENERATE A BLACK MOVE SUBROUTINE BMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NEXT,IP,MORE,KP) COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/BOARD/JBOARD(120) COMMON/BAL/MATBAL,LEV COMMON/INCRE/INK(16) IF(MAN)86,86,81 86 IP=0 MORE=1 GO TO 82 81 IF(IP)65,65,64 64 MATBAL=MATBAL-ISVAL(1)+ISVAL(6) JV=ISVAL(6) ISTYPE(MAN)=6 IP=0 65 ISPCE(MAN)=LSQ JBOARD(LSQ)=JV JBOARD(NSQ)=KON MATBAL=MATBAL+KON IF(MORE)38,38,83 83 IF(NEXT)16,24,29 82 MAN=MAN+1 IF(MAN-ISMEN)84,84,85 85 MORE=-1 GO TO 38 84 LSQ=ISPCE(MAN) JV=JBOARD(LSQ) NAME=ISTYPE(MAN) IF(JV-ISVAL(NAME))82,7,82 7 GO TO(41,8,9,17,18,40),NAME C QUEEN,ROOK OR BISHOP MOVE 41 IPT=0 IFN=8 GO TO 12 8 IPT=4 IFN=8 GO TO 12 9 IPT=0 IFN=4 12 NEXT=-1 10 IPT=IPT+1 IF(IPT.GT.IFN)GO TO 82 KC=INK(IPT) NSQ=LSQ 11 NSQ=NSQ+KC KON=JBOARD(NSQ) IF(KON)10,36,15 15 IF(KON-1000)37,10,10 16 IF(KON)10,11,10 C KING OR KNIGHT MOVE 17 IPT=8 IFN=16 GO TO 19 18 IPT=0 IFN=8 19 NEXT=0 24 IPT=IPT+1 IF(IPT.GT.IFN)GO TO 82 NSQ=LSQ+INK(IPT) KON=JBOARD(NSQ) IF(KON)24,36,25 25 IF(KON-1000)37,24,24 C PAWN MOVE 40 NEXT=1 IPT=0 29 IPT=IPT+1 IF(IPT.GT.4)GO TO 82 IF(IPT-2)27,31,30 27 NSQ=LSQ-10 KON=JBOARD(NSQ) IF(KON)28,43,28 43 IF(NSQ-30)51,51,36 28 IPT=2 GO TO 29 31 IF(LSQ-80)29,32,32 32 NSQ=LSQ-20 KON=JBOARD(NSQ) IF(KON)29,36,29 30 NSQ=LSQ-INK(IPT) KON=JBOARD(NSQ) IF(KON)29,29,42 42 IF(KON-1000)44,29,29 44 IF(NSQ-30)51,51,37 36 IF(KP)37,37,83 51 MATBAL=MATBAL+ISVAL(1)-ISVAL(6) JV=ISVAL(1) ISTYPE(MAN)=1 IP=1 37 ISPCE(MAN)=NSQ JBOARD(LSQ)=0 JBOARD(NSQ)=JV MATBAL=MATBAL-KON 38 RETURN END SUBROUTINE MYGO(LSQ,NSQ,KAPT,MOV,KASTLE,IPROM,KECK) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG CALL FMOVE(JV,LSQ,NSQ,KON1,MOV,KASTLE,IPROM,0) KAPT=0 KECK=0 MAN=0 1 CALL WMOVE(MAN,JV,LSQ2,NSQ2,KON2,IPT,IFN,KC,NX,IP,MORE,1) IF(MORE)3,3,2 2 IF(KON2.EQ.ISVAL(5))KECK=1 GO TO 1 3 IF(KASTLE)12,13,12 12 MYQN=0 MYKG=0 GO TO 11 13 IF(LSQ.EQ.22)MYQN=0 IF(LSQ.EQ.29)MYKG=0 IF(LSQ-26)16,15,16 15 MYQN=0 MYKG=0 16 IF(KON1)7,11,11 7 IF(NSQ.EQ.92)ISQN=0 IF(NSQ.EQ.99)ISKG=0 IJ=0 KAPT=1 DO 10 I=1,ISMEN IJ=IJ+1 IF(ISPCE(I)-NSQ)9,8,9 8 IJ=IJ-1 GO TO 10 9 ISPCE(IJ)=ISPCE(I) ISTYPE(IJ)=ISTYPE(I) 10 CONTINUE ISMEN=ISMEN-1 11 RETURN END SUBROUTINE ISGO(LSQ,NSQ,ILLEG,KASTLE,ILLCAS,IPROM,KECK) COMMON/WHITE/MYPCE(16),MYTYPE(16),MYVAL(6),MYMEN,MYQN,MYKG COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG KECK=0 ILLEG=-1 ILLCAS=0 IF(KASTLE)20,23,20 20 CALL ISCAS(KASTLE,ILLCAS) IF(ILLCAS)21,21,19 21 ISQN=0 ISKG=0 GO TO 8 23 M1=0 1 CALL BMOVE(M1,JV1,LSQ1,NSQ1,KON1,IPT,IFN,KC,NX1,IPROM,MORE,0) IF(MORE)3,7,2 2 IF(LSQ1.EQ.LSQ.AND.NSQ1.EQ.NSQ)GO TO 4 GO TO 1 3 ILLEG=1 GO TO 19 4 M2=0 5 CALL WMOVE(M2,JV2,LSQ2,NSQ2,KON2,IPT,IFN,KC,NX2,IP2,MORE,1) IF(MORE)8,1,6 6 IF(KON2.EQ.ISVAL(5))MORE=0 GO TO 5 7 ILLEG=0 GO TO 19 8 M2=0 9 CALL BMOVE(M2,JV2,LSQ2,NSQ2,KON2,IPT,IFN,KC,NX2,IP2,MORE,1) IF(MORE)14,14,10 10 IF(KON2.EQ.MYVAL(5))KECK=1 GO TO 9 14 IF(KASTLE)19,22,19 22 IF(LSQ.EQ.92)ISQN=0 IF(LSQ.EQ.99)ISKG=0 IF(LSQ-96)25,24,25 24 ISQN=0 ISKG=0 25 IF(KON1)19,19,15 15 IF(NSQ.EQ.22)MYQN=0 IF(NSQ.EQ.29)MYKG=0 IJ=0 DO 18 I=1,MYMEN IJ=IJ+1 IF(MYPCE(I)-NSQ)17,16,17 16 IJ=IJ-1 GO TO 18 17 MYPCE(IJ)=MYPCE(I) MYTYPE(IJ)=MYTYPE(I) 18 CONTINUE MYMEN=MYMEN-1 19 RETURN END SUBROUTINE ISCAS(KASTLE,ILLCAS) COMMON/BLACK/ISPCE(16),ISTYPE(16),ISVAL(6),ISMEN,ISQN,ISKG COMMON/BOARD/JBOARD(120) IF(KASTLE)1,20,10 1 IF(ISQN)9,9,3 3 DO 5 I=93,95 IF(JBOARD(I))9,5,9 5 CONTINUE MAN=0 6 CALL WMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NX,IP,MORE,0) IF(MORE)30,9,7 7 IF(NSQ.GE.94.AND.NSQ.LE.96)MORE=0 GO TO 6 30 JBOARD(92)=0 JBOARD(94)=ISVAL(5) JBOARD(95)=ISVAL(2) JBOARD(96)=0 DO 31 I=1,ISMEN IF(ISPCE(I).EQ.96)ISPCE(I)=94 IF(ISPCE(I).EQ.92)ISPCE(I)=95 31 CONTINUE GO TO 20 10 IF(ISKG)9,9,11 11 DO 13 I=97,98 IF(JBOARD(I))9,13,9 13 CONTINUE MAN=0 14 CALL WMOVE(MAN,JV,LSQ,NSQ,KON,IPT,IFN,KC,NX,IP,MORE,0) IF(MORE)40,9,15 15 IF(NSQ.GE.96.AND.NSQ.LE.98)MORE=0 GO TO 14 40 JBOARD(96)=0 JBOARD(97)=ISVAL(2) JBOARD(98)=ISVAL(5) JBOARD(99)=0 DO 41 I=1,ISMEN IF(ISPCE(I).EQ.96)ISPCE(I)=98 IF(ISPCE(I).EQ.99)ISPCE(I)=97 41 CONTINUE GO TO 20 9 ILLCAS=1 20 RETURN END