10 MEMSET:CLEAR
20 WIDTH81,26:SCROLL9,0
30 'CHESS C.4 FROM "CREATIVE COMPUTING", DEC.1981, PAGE 276
40 'ENTERED AND ALTERED BY MIKE STAFFORD
50 DEFINTA-Z
60 DIMC(64)
70 A=0
80 B=0
90 X=0
100 Y=0
110 S=0
120 A0=0
130 T=0
140 A8=0
150 A1=0
160 A2=0
170 A3=0
180 A4=0
190 B1=0
200 B6!=0
210 H=0
220 M=0
230 N=0
240 P=0
250 W=0
260 A5=0
270 I=1
280 CLS
290 INPUT"DO YOU WANT INSTRUCTIONS ";IN$
300 IN$=LEFT$(IN$,1)
310 IFN$>="a"ANDIN$<="z"THENIN$=CHR$(ASC(IN$)-32)
320 IFIN$="Y"THENGOSUB3230
330 CL$="N"
340 CLS
350 INPUT"YOUR NAME IS ";B$
360 IFB$=""THENB$=" HUMAN   "ELSEB$=LEFT$(B$,9)
370 CLS
380 INPUT" LEVEL OF PLAY";B8!
390 IFB8!=0THENB8!=1:B7!=1+RND/2ELSEB7!=(B8!+1+RND)/2
400 CLS
410 PRINT" DO YOU WANT WHITE ";B$;" ";
420 INPUTC$
430 GOSUB2640
440 IFLEFT$(C$,1)<>"N"THENGOSUB2790:GOTO770
450 GOSUB3480
460 IFCL$="Y"THENLOCATE64,5:PRINT"START ";TIME$;:LOCATE64,6:PRINTSTRING$(14," ");
470 F!=-99
480 A0=0
490 FORJ=1TO8
500 FORK=1TO8
510 IFA(J,K)=99THENA6=J:A7=K
520 NEXTK
530 NEXTJ
540 FORX=1TO8
550 FORY=1TO8
560 IFA(X,Y)<0THENGOSUB940:IFF!>=B7!THEN610
570 NEXTY
580 NEXTX
590 IFF!>=-9THEN610ELSEGOSUB2790
600 LOCATE64,4:PRINT"I CONCEDE";:GOTO4280
610 A(R,U)=A(E,Q)
620 A(E,Q)=1
630 IFA(R,U)=-2ANDU=1THENA(R,U)=-9
640 X=R
650 Y=U
660 A0=4
670 GOSUB940
680 LOCATE64,4:PRINT"IS MY MOVE     ";:LOCATE64,3:PRINTCHR$(E+64);Q;"- ";CHR$(R+64);U;
690 IFCL$="Y"THENLOCATE64,6:PRINT"STOP ";TIME$;
700 X=E
710 Y=Q
720 GOSUB2900
730 X=R
740 Y=U
750 GOSUB2900
760 IFC=1THENLOCATE64,4:PRINT"CHECK ";B$;:C=0
770 IFX$="S"THENGOSUB3830:B7!=3*RND:LOCATE64,1:PRINT"SELF PLAYING";:GOSUB4470:GOTO470ELSELOCATE64,2:PRINT"MOVE ";B$;:GOSUB3550:D=0:B4=A:B9=B:B5=0:IFA(X,Y)=2ANDY=5ANDB=6ANDA(A,B)=1ANDABS(A-X)=1THENB5=1:GOTO800
780 IFX$="K"ORX$="Q"THENGOSUB2790:LOCATE65,2:PRINTSTRING$(14," ");:GOTO470
790 IFX$="S"THENCL$="N":GOTO770ELSEA0=3:GOSUB930:IFD=0THENLOCATE64,3:PRINT"ILLEGAL";:GOTO770
800 LOCATE64,2:PRINT"OK            ";
810 A=B4
820 B=B9
830 A(A,B)=A(X,Y)
840 A(X,Y)=1
850 GOSUB2900
860 X=A
870 Y=B
880 GOSUB2900
890 IFN$="N"THENGOSUB2790:N$=" "
900 IFA(A,B)=2ANDB=8THENLOCATE64,2:PRINT"WHAT PIECE";:GOSUB4390:X=A:Y=B:GOSUB2900:LOCATE64,2:PRINTSTRING$(14," ");:LOCATE64,3:PRINTSTRING$(14," ");
910 IFB5=1THENA(A,B-1)=1:X=A:Y=B-1:GOSUB2900
920 GOTO470
930 LOCATE76,1:PRINT"$";:ONA(X,Y)GOTO10,1560,10,1310,1100,10,950,10,1100:GOTO1500
940 ON-A(X,Y)GOTO10,1680,10,1310,1100,10,950,10,1100:GOTO1500
950 B=Y
960 FORA=X+1TO8
970 GOSUB2090
980 IFS=0THENNEXT
990 FORA=X-1TO1STEP-1
1000 GOSUB2090
1010 IFS=0THENNEXT
1020 A=X
1030 FORB=Y+1TO8
1040 GOSUB2090
1050 IFS=0THENNEXT
1060 FORB=Y-1TO1STEP-1
1070 GOSUB2090
1080 IFS=0THENNEXT
1090 RETURN
1100 B=Y
1110 FORA=X+1TO8
1120 B=B+1
1130 GOSUB2090
1140 IFS=0THENNEXT
1150 B=Y
1160 FORA=X-1TO1STEP-1
1170 B=B-1
1180 GOSUB2090
1190 IFS=0THENNEXT
1200 B=Y
1210 FORA=X-1TO1STEP-1
1220 B=B+1
1230 GOSUB2090
1240 IFS=0THENNEXT
1250 B=Y
1260 FORA=X+1TO8
1270 B=B-1
1280 GOSUB2090
1290 IFS=0THENNEXT
1300 IFABS(A(X,Y))=9THEN950ELSERETURN
1310 A=X+2
1320 B=Y+1
1330 IFA<9ANDB<9THENGOSUB2110
1340 B=B-2
1350 IFB>0ANDA<9THENGOSUB2110
1360 A=A-4
1370 IFA>0ANDB>0THENGOSUB2110
1380 B=B+2
1390 IFB<9ANDA>0THENGOSUB2110
1400 A=A+1
1410 B=B+1
1420 IFA>0ANDA<9ANDB<9THENGOSUB2110
1430 B=B-4
1440 IFB>0ANDA>0ANDA<9THENGOSUB2110
1450 A=A+2
1460 IFA>0ANDA<9ANDB>0THENGOSUB2110
1470 B=B+4
1480 IFB<9ANDA>0ANDA<9THENGOSUB2110
1490 RETURN
1500 FORA=X-1TOX+1
1510 FORB=Y-1TOY+1
1520 IFA(A,B)<>0THENGOSUB2110
1530 NEXT
1540 NEXT
1550 RETURN
1560 A=X
1570 IFY>2THEN1600
1580 B=Y+1
1590 IFA(A,B)=1THENGOSUB2120:B=B+1:IFA(A,B)=1THENGOSUB2120:GOTO1620ELSEGOTO1620ELSEGOTO1620
1600 B=Y+1
1610 IFA(A,B)=1THENGOSUB2120
1620 A=X+1
1630 B=Y+1
1640 IFA(A,B)<0THENGOSUB2120
1650 A=A-2
1660 IFA(A,B)<0THENGOSUB2120
1670 RETURN
1680 A=X
1690 IFY<7THEN1720
1700 B=Y-1
1710 IFA(A,B)=1THENGOSUB2120:B=B-1:IFA(A,B)=1THENGOSUB2120:GOTO1740ELSEGOTO1740ELSEGOTO1740
1720 B=Y-1
1730 IFA(A,B)=1THENGOSUB2120
1740 A=X-1
1750 B=Y-1
1760 IFA(A,B)>1THENGOSUB2120
1770 A=A+2
1780 IFA(A,B)>1THENGOSUB2120
1790 RETURN
1800 T=A(A,B)
1810 IFT=-99THENB1=T:RETURN
1820 A5=S
1830 IFABS(T)<=A(X,Y)THENA(A,B)=A(X,Y):A(X,Y)=1:GOTO1870
1840 IFT<B1 THENB1=T
1850 S=A5
1860 RETURN
1870 A1=X
1880 A2=Y
1890 A3=A
1900 A4=B
1910 A8=T
1920 A0=2
1930 FORX=1TO8
1940 FORY=1TO8
1950 IFA(X,Y)<0THENGOSUB940:IFT=0THEN1980
1960 NEXT
1970 NEXT
1980 X=A1
1990 Y=A2
2000 A=A3
2010 B=A4
2020 A0=5
2030 A(X,Y)=A(A,B)
2040 A(A,B)=A8
2050 GOTO1840
2060 '*
2070 '* THIS SUBROUTINE CHECKS THE LEGALITY OF A MOVE
2080 '*
2090 S=0
2100 IFA(A,B)=1THEN2120ELSEIFA(A,B)=0THENS=1:RETURNELSEIFSGN(A(A,B))=SGN(A(X,Y))THENS=1:RETURNELSES=1:GOTO2120
2110 IFA(A,B)=1THENGOTO2120ELSEIFSGN(A(A,B))=SGN(A(X,Y))THENRETURN
2120 LOCATE76,1:PRINT"  ";:ONA0 GOTO2140,2160,2180,2200,2220
2130 GOTO2230
2140 IFA6=A ANDA7=B THENB1=B1+1
2150 RETURN
2160 IFA3=A ANDA4=B THENT=0
2170 RETURN
2180 IFB4=A ANDB9=B THEND=1
2190 RETURN
2200 IFA6=A ANDA7=B THENC=1
2210 RETURN
2220 IFA(A,B)<0THEN1800ELSERETURN
2230 B3=S
2240 W=X
2250 M=Y
2260 N=A
2270 H=B
2280 P=A(A,B)
2290 A(A,B)=A(X,Y)
2300 A(X,Y)=1
2310 B1=0
2320 A0=5
2330 FORX=1TO8
2340 FORY=1TO8
2350 IFA(X,Y)>1THENGOSUB930
2360 NEXTY
2370 NEXTX
2380 X=N
2390 Y=H
2400 A0=1
2410 GOSUB940
2420 A0=0
2430 S=B3
2440 X=W
2450 Y=M
2460 A=N
2470 B=H
2480 A(X,Y)=A(A,B)
2490 A(A,B)=P
2500 B6!=1/(ABS(4.5-A)+ABS(4.5-B)+1)
2510 IFA(X,Y)<-2ANDA(X,Y)>-9THENB6!=B6!+1/(ABS(A6-A)+ABS(A7-B)+5)+RND/15
2520 G!=P+B1+B6!
2530 IFP=99THENGOSUB2790:LOCATE64,4:PRINT"MATE ";B$;GOTO4280
2540 IFG!<=F!THENRETURN
2550 F!=G!
2560 E=X
2570 Q=Y
2580 R=A
2590 U=B
2600 RETURN
2610 '*
2620 '*  INITIALIZE POSITIONS ON BOARD
2630 '*
2640 CLS
2650 FORY=1TO8
2660 FORX=1TO8
2670 READA(X,Y)
2680 NEXTX
2690 NEXTY
2700 DATA 7,4,5,9,99,5,4,7
2710 DATA 2,2,2,2,2,2,2,2
2720 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
2730 DATA -2,-2,-2,-2,-2,-2,-2,-2
2740 DATA -7,-4,-5,-9,-99,-5,-4,-7
2750 RETURN
2760 '*
2770 '*  DRAWS BOARD AND PIECES
2780 '*
2790 FORY=1TO8
2800 FORX=1TO8
2810 GOSUB2900
2820 NEXTX
2830 NEXTY
2840 GOSUB4130
2850 RETURN
2860 '*
2870 '*  SUBROUTINE TO DRAW A SQUARE AND THE PIECE ON IT.
2880 '*  SQUARE IS IDENTIFIED BY THE COORDINATES X,Y
2890 '*
2900 IFI=-1THEN2930
2910 IF(INT((X+Y)/2))*2=X+Y THENSQ$=CHR$(140)ELSESQ$=CHR$(139)
2920 GOTO2940
2930 IF(INT((X+Y)/2))*2=X+Y THENSQ$=CHR$(139)ELSESQ$=CHR$(140)
2940 YC=24-3*Y
2950 XC=2+7*(X-1)
2960 TEMP=ABS(A(X,Y))
2970 FORYS=1TO3
2980 FORXS=1TO7
2990 SQCH$=SQ$
3000 IFXS<>4THEN3140
3010 IFA(X,Y)=1THENGOTO3140
3020 IFYS=1ANDTEMP<9THEN3140
3030 IFI*A(X,Y)<0THENCOLOR0,1
3040 IFYS<>1THEN3070
3050 IFTEMP=9THENSQCH$=CHR$(151)ELSESQCH$=CHR$(149)
3060 GOTO3140
3070 IFYS=3THEN3130
3080 IFTEMP=2THENSQCH$=CHR$(154):GOTO3140
3090 IFTEMP=7THENSQCH$=CHR$(150):GOTO3140
3100 IFTEMP=4THENSQCH$=CHR$(152):GOTO3140
3110 IFTEMP=5THENSQCH$=CHR$(153):ELSESQCH$=CHR$(144)
3120 GOTO3140
3130 IFTEMP=2THENSQCH$=CHR$(143)ELSESQCH$=CHR$(144)
3140 LOCATEXC+XS,YC+YS
3150 PRINTSQCH$;
3160 COLOR1,0
3170 NEXTXS
3180 NEXTYS
3190 RETURN
3200 '*
3210 '*  INSTRUCTIONS
3220 '*
3230 CLS
3240 PRINT" 1. SPECIAL COMMANDS DURING PLAYER'S MOVE ARE:"
3250 PRINT"     'K' - TO CASTLE KING SIDE."
3260 PRINT"     'Q' - TO CASTLE QUEEN SIDE."
3270 PRINT"     'X' - TO EXCHANGE PIECES AND LET COMPUTER PLAY."
3280 PRINT"     'S' - TO LET THE COMPUTER PLAY BY ITSELF."
3290 PRINT"     'M' - TO MODIFY THE BOARD ENTER THE SQUARE FOLLOWED NY 'C','P',"
3300 PRINT"             OR 'E' FOR COMPUTER, PLAYER OR EMPTY AND 'S', 'P', 'N', 'B',"
3310 PRINT"             'R', 'Q', OR 'K' FOR SQUARE, PAWN, KNIGHT, BISHOP, ROOK, QUEEN,"
3320 PRINT"             OR QUEEN."
3330 PRINT"     'Z' - TO ESCAPE FROM MODIFY AND LET THE COMPUTER MOVE."
3340 PRINT"     'I' - TO GET INSTRUCTIONS AGAIN."
3350 PRINT"     'L' - TO LOOK AT OR CHANGE LEVEL OF PLAY."
3360 PRINT"             OR KING."
3370 PRINT" 2. TO PROMTE TO P, N, B, R, OR Q ENTER THE LETTER WHEN PROMOTED."
3380 PRINT" 3. TO CAPTURE 'EN PASSANT' SPECIFY THE 'FROM' - 'TO' SQUARES."
3390 PRINT" 4. LEVELS OF PLAY ARE FROM 01 TO 24."
3400 PRINT" 5. COMPUTER ASSUMES MATE IF KING IS LEFT IN CHECK, SO BE SURE TO WATCH FOR"
3410 PRINT"     THE CHECK MESSAGE."
3420 PRINT" 6. IF A MOVE IS ILLEGAL OR AN ENTRY ERROR IS MADE SIMPLY TYPE IN A NEW MOVE."
3430 PRINT"     A MOVE MAY BE STARTED OVER BY FORCING AN ERROR (E.G. '9')."
3440 PRINT" 7. YOU HAVE A CHOICE OF WHITE OR BLACK.  THE COMPUTER WILL ALWAYS BE AT THE"
3450 PRINT"     TOP OF THE SCREEN."
3460 INPUT"HIT ENTER TO CONTINUE";EN$
3470 RETURN
3480 I=-1
3490 A(4,1)=99
3500 A(5,1)=9
3510 A(4,8)=-99
3520 A(5,8)=-9
3530 GOSUB2790
3540 RETURN
3550 LOCATE64,1:PRINTSTRING$(14," ");
3560 X$=INKEY$
3570 IFX$="N"THENN$=X$
3580 IFX$>="A"ANDX$<="H"THENX=VAL(CHR$(ASC(X$)-16)):GOTO3700
3590 IFX$="N"THEN4130
3600 IFX$="K"ANDA(5,1)=99ANDA(8,1)=7THENA(5,1)=1:A(8,1)=1:A(7,1)=99:A(6,1)=7:GOTO3790
3610 IFX$="Q"ANDA(5,1)=99ANDA(1,1)=7THENA(5,1)=1:A(1,1)=1:A(3,1)=99:A(4,1)=7:GOTO3790
3620 IFX$="K"ANDA(4,1)=99ANDA(1,1)=7THENA(4,1)=1:A(1,1)=1:A(2,1)=99:A(3,1)=7:GOTO3790
3630 IFX$="Q"ANDA(4,1)=99ANDA(8,1)=7THENA(4,1)=1:A(8,1)=1:A(6,1)=99:A(5,1)=7:GOTO3790
3640 IFX$="X"THENGOSUB3830:LOCATE64,1:PRINT"EXCHANGING   ";:GOSUB4470:IFCL$="Y"THENLOCATE60,5:PRINT"START ";TIME$;:GOTO470ELSEGOTO470
3650 IFX$="S"THEN3820
3660 IFX$="M"THENGOSUB3870
3670 IFX$="I"THENGOSUB3230:CLS:GOSUB2790:LOCATE64,1:PRINT"MOVE ";B$;
3680 IFX$="L"THENGOSUB4180
3690 GOTO3560
3700 LOCATE65,1:PRINTX$;
3710 Y=VAL(INKEY$):IFY=0THEN3710
3720 LOCATE66,1:PRINTY;
3730 LOCATE69,1:PRINT"-";
3740 IFA(X,Y)<2ORA(X,Y)>99THENLOCATE64,4:PRINT"ENTRY ERROR  ";:GOTO3550
3750 A$=INKEY$:IFA$<"A"ORA$>"H"THEN3750ELSEA=VAL(CHR$(ASC(A$)-16))
3760 LOCATE71,1:PRINTA$
3770 B=VAL(INKEY$)
3780 IFB=0THEN3770ELSELOCATE72,1:PRINTB;
3790 IFX$="K"ORX$="Q"THENLOCATE64,1:PRINT"CSTL. ";X$;"-SIDE";
3800 GOSUB3830
3810 IFCL$="Y"THENLOCATE64,5:PRINT"START ";TIME$;
3820 RETURN
3830 FORJ=2TO7
3840 LOCATE64,J:PRINTSTRING$(16," ");
3850 NEXTJ
3860 RETURN
3870 GOSUB3830
3880 LOCATE64,1:PRINT"MODIFYING     ";
3890 GOSUB4100
3900 IFM$<"A"0RM$>"H"THEN3890
3910 X=VAL(CHR$(ASC(M$)-16))
3920 LOCATE64,2:PRINTM$;
3930 M$=INKEY$:IFM$<"1"ORM$>"8"THEN3930
3940 Y=VAL(M$)
3950 LOCATE66,2:PRINTM$;" = ";
3960 M$=INKEY$:IFM$="C"ORM$="P"ORM$="E"THENS1$=M$:LOCATE70,2:PRINTM$;ELSEGOTO3960
3970 M$=INKEY$:IFM$="S"ORM$="P"ORM$="N"ORM$="B"ORM$="R"ORM$="Q"ORM$="K"THENV$=M$:LOCATE72,2:PRINTM$;ELSEGOTO3970
3980 IFV$="P"THENV1=2
3990 IFV$="N"THENV1=4
4000 IFV$="B"THENV1=5
4010 IFV$="R"THENV1=7
4020 IFV$="Q"THENV1=9
4030 IFV$="K"THENV1=99
4040 IFV$="S"THENV1=1
4050 IFS1$="C"ANDV1<>1THENV1=-V1
4060 A(X,Y)=V1
4070 IFS1$="E"THENA(X,Y)=1
4080 GOSUB2900
4090 GOTO3870
4100 M$=INKEY$:IFM$="N"THENGOSUB4130:GOTO4100ELSEIFM$="Z"THENGOSUB3830:LOCATE64,1:PRINTSTRING$(14," ");:GOSUB2790ELSERETURN
4110 IFCL$="Y"THENLOCATE60,5:PRINT"START ";TIME$;
4120 GOTO470
4130 FORJ=1TO8
4140 LOCATE1,(J*3)-1:PRINTRIGHT$(STR$(9-J),1);
4150 LOCATE(J*7)-1,25:PRINTCHR$(J+64);
4160 NEXTJ
4170 RETURN
4180 GOSUB3830
4190 LOCATE64,1:PRINT"LEVEL=";B8!;"   ";
4200 LOCATE64,2:PRINT"CHANGE LEVELS?";
4210 C$=INKEY$:IFC$="N"THEN4270ELSEIFC$="Y"THENLOCATE71,1:PRINTSTRING$(7," ");:GOSUB3830ELSEGOTO4210
4220 L1$=INKEY$:IFL1$=""THEN4220ELSEIFL1$>="0"ANDL1$<="9"THENLOCATE71,1:PRINTL1$ELSEGOTO4220
4230 L2$=INKEY$:IFL2$=""THEN4230ELSEIFL2$<"0"ORL2$>"9"THENL2$=L1$:L1$="0"
4240 B8!=VAL(L1$)*10+VAL(L2$)
4250 B7!=B8!/2
4260 LOCATE71,1:PRINTL1$;L2$
4270 GOSUB3830:LOCATE64,1:PRINTSTRING$(14," ");:LOCATE64,2:PRINT"MOVE ";B$;:RETURN
4280 IFCL$="Y"THENLOCATE64,6:PRINT"STOP ";TIME$;
4290 LOCATE62,9:PRINT"HIT 'P' TO PLAY";
4300 LOCATE62,10:PRINT"OR 'B' FOR BASIC.";
4310 A$=INKEY$:IFA$=""THEN4310ELSEIFA$="B"THENCLS:ENDELSEIFA$="P"THENRUNELSEGOTO4310
4320 GOSUB3830
4330 LOCATE64,1:PRINTSTRING$(14," ");
4340 LOCATE64,2:PRINT"MOVE ";B$;
4350 RETURN
4360 '*
4370 '*  PROMOTION ROUTINE
4380 '*
4390 LOCATE64,3:PRINT"P, N, B, R, Q";
4400 Z$=INKEY$:IFZ$="P"THENA(A,B)=2:GOTO4460
4410 IFZ$="N"THENA(A,B)=4:GOTO4460
4420 IFZ$="B"THENA(A,B)=5:GOTO4460
4430 IFZ$="R"THENA(A,B)=7:GOTO4460
4440 IFZ$="Q"THENA(A,B)=9:GOTO4460
4450 GOTO4400
4460 RETURN
4470 I=-1
4480 GOSUB4510
4490 GOSUB2790
4500 RETURN
4510 L=0
4520 FORJ=1TO8
4530 FORK=1TO8
4540 L=L+1
4550 IFA(J,K)<>1THENC(L)=-A(J,K)ELSEC(L)=A(J,K)
4560 NEXTK
4570 NEXTJ
4580 L=65
4590 FORJ=1TO8
4600 FORK=1TO8
4610 L=L-1
4620 A(J,K)=C(L)
4630 NEXTK
4640 NEXTJ
4650 RETURN
4660 END