home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of Select: Games 4
/
CD_1.iso
/
wingames
/
chessnet
/
f-chess.for
< prev
Wrap
Text File
|
1995-04-25
|
25KB
|
937 lines
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