10 'QChess by Mike Weiblen [CIS: 72506,2072; Delphi: EKIM] 072485
20 DEFINTA-Z
30 DIMA(63),U(14),P(10):U=-8
40 CLS:PRINT"Model 100 QuikChess":PRINT:PRINT"Do you want to be white (Y/N) ";:GOSUB7000
60 IFNOT(IN=89ORIN=78)THEN40
70 FORX=0TO56STEP8:READA(X):A(X+7)=-A(X):A(X+1)=2:A(X+6)=-2:NEXTX
80 FORX=1TO10:READP(X):NEXTX
90 CLS:IFIN=89THENA(24)=9:A(32)=99:A(31)=-9:A(39)=-99:I=1:GOSUB5000:GOTO1500
92 A(24)=99:A(32)=9:A(31)=-99:A(39)=-9:I=-1:GOSUB5000:GOTO1000
500 U=U+8:U(U)=S:U(U+1)=X:U(U+2)=Y:U(U+3)=A:U(U+4)=B:U(U+5)=Q0:U(U+6)=A(A*8+B):A(A*8+B)=A(X*8+Y):A(X*8+Y)=0:RETURN
600 S=U(U):X=U(U+1):Y=U(U+2):A=U(U+3):B=U(U+4):Q0=U(U+5):A(X*8+Y)=A(A*8+B):A(A*8+B)=U(U+6):U=U-8:RETURN
700 Z=0:Y=Y+1:IFY>7THENY=0:X=X+1:Z=(X>7)
710 RETURN
1000 'Computer Move
1030 F=-9900:Q0=5:X=0:Y=0
1040 PRINT@102,CHR$(27);"KThinking "CHR$(X+65)CHR$(Y+49);:IFA(X*8+Y)<0THENGOSUB2000
1050 IFA(X*8+Y)=99THENX8=X:Y8=Y
1060 GOSUB700:IFZ=0THEN1040
1080 IFF<-900THENPRINT@102,"I Concede     ";:GOTO9000
1090 A(A0*8+B0)=A(X0*8+Y0):A(X0*8+Y0)=0:IFA(A0*8+B0)=-2ANDB0=0THENA(A0*8+B0)=-9
1095 PRINT@102,"My move: "CHR$(X0+65)CHR$(Y0+49)CHR$(A0+65)CHR$(B0+49);:X=X0:Y=Y0:GOSUB5500:X=A0:Y=B0:GOSUB5500
1100 V0=0:X=A0:Y=B0:Q0=1:GOSUB2000:IFV0>0THENPRINT@116,"Chk";
1500 'Player Move
1510 PRINT@182,CHR$(27);"KYour move? ";:GOSUB7100
1512 IFX=80THEN1000
1514 IFX=75THEN1710
1516 IFX=81THEN1730
1520 X=X-65:Y=Y-49:A=A-65:B=B-49:P9=0
1522 IFX<0ORY<0ORA<0ORB<0ORX>7ORY>7ORA>7ORB>7THEN1590
1525 IFA(X*8+Y)<1THEN1590
1527 IFA(X*8+Y)=2ANDA(A*8+B)=0ANDY=4ANDB=5ANDABS(X-A)=1THENP9=1:GOTO1530
1528 D=0:A0=A:B0=B:Q0=3:GOSUB2000:IFD=0THEN1590
1530 A=A0:B=B0:A(A*8+B)=A(X*8+Y):A(X*8+Y)=0:IFA(A*8+B)=2ANDB=7THENA(A*8+B)=9
1540 GOSUB5500:X=A:Y=B:GOSUB5500:IFP9=1THENY=B-1:A(X*8+Y)=0:GOSUB5500
1550 GOTO1000
1590 BEEP:GOTO1500
1700 'Castling
1710 IFA(32)=99ANDA(56)=7THENA(32)=0:A(56)=0:A(48)=99:A(40)=7:GOTO1747
1720 IFA(24)=99ANDA(0)=7THENA(24)=0:A(0)=0:A(8)=99:A(16)=7:GOTO1747
1725 GOTO1590
1730 IFA(32)=99ANDA(0)=7THENA(32)=0:A(0)=0:A(16)=99:A(24)=7:GOTO1747
1740 IFA(24)=99ANDA(56)=7THENA(24)=0:A(56)=0:A(40)=99:A(32)=7:GOTO1747
1745 GOTO1590
1747 GOSUB5000:GOTO1000
2000 'Scan Piece's Moves
2010 IFABS(A(X*8+Y))=99THEN2100
2020 ONABS(A(X*8+Y))-1GOTO2500,,2400,2300,,2200,,2200
2100 'King
2110 A=X-2
2120 B=Y-2:A=A+1
2130 B=B+1:GOSUB3200:IFB<Y+1THEN2130
2132 IFA<X+1THEN2120
2140 RETURN
2200 'Rook/Queen
2210 A=X:B=Y
2220 A=A+1:GOSUB3200:IFS=0THEN2220
2230 A=X
2240 A=A-1:GOSUB3200:IFS=0THEN2240
2250 A=X
2260 B=B+1:GOSUB3200:IFS=0THEN2260
2270 B=Y
2280 B=B-1:GOSUB3200:IFS=0THEN2280
2290 IFABS(A(X*8+Y))=7THENRETURN
2300 'Bishop/Queen
2310 A=X:B=Y
2320 A=A+1:B=B+1:GOSUB3200:IFS=0THEN2320
2330 A=X:B=Y
2340 A=A+1:B=B-1:GOSUB3200:IFS=0THEN2340
2350 A=X:B=Y
2360 A=A-1:B=B+1:GOSUB3200:IFS=0THEN2360
2370 A=X:B=Y
2380 A=A-1:B=B-1:GOSUB3200:IFS=0THEN2380
2390 RETURN
2400 'Knight
2410 A=X+2:B=Y+1:GOSUB3200:B=B-2:GOSUB3200:A=A-4:GOSUB3200:B=B+2:GOSUB3200
2420 A=A+1:B=B+1:GOSUB3200:B=B-4:GOSUB3200:A=A+2:GOSUB3200:B=B+4:GOTO3200
2500 'Player Pawn
2510 A=X:IFA(X*8+Y)<0THEN2600
2520 B=Y+1:GOSUB3000:IFY<2ANDS=0THENB=B+1:GOSUB3000
2530 B=Y+1:GOTO2630
2600 'Computer Pawn
2610 B=Y-1:GOSUB3000:IFY>5ANDS=0THENB=B-1:GOSUB3000
2620 B=Y-1
2630 A=X+1:GOSUB3100:A=A-2:GOTO3100
2640 'Move Range Check
3000 S=0:IFA(A*8+B)THENS=1:RETURN
3020 GOTO4000
3100 IFA<0ORA>7THENRETURN
3110 IFA(A*8+B)=0ORSGN(A(A*8+B))=SGN(A(X*8+Y))THENRETURN
3120 GOTO4000
3200 S=0:IFA<0ORA>7ORB<0ORB>7THENS=1:RETURN
3210 IFA(A*8+B)THENS=1
3220 IFSGN(A(A*8+B))=SGN(A(X*8+Y))THENRETURN
4000 'Reason for Scan
4010 ONQ0GOTO4100,4200,4300,4500,4600
4100 'Player's King Threatened?
4110 IFA(A*8+B)=99THENV0=V0+1
4120 RETURN
4200 'Comp Piece Protected?
4210 IFU(U+3)=AANDU(U+4)=BTHENP=0
4220 RETURN
4300 'Player Move Valid?
4310 IFA0=AANDB0=BTHEND=1
4320 RETURN
4500 'Comp Piece Threatened?
4510 IFA(A*8+B)>-1THENRETURN
4520 P=A(A*8+B):IFABS(P)>A(X*8+Y)THEN4580
4530 GOSUB500:Q0=2:X=0:Y=0
4550 IFA(X*8+Y)<0THENGOSUB2000:IFP=0THEN4570
4560 GOSUB700:IFZ=0THEN4550
4570 GOSUB600
4580 IFP<V0THENV0=P
4590 RETURN
4600 'Find Best Comp Move
4605 IFA(A*8+B)=99THENPRINT@102,"CheckMate     ";:GOTO9000
4610 GOSUB500:V0=0:Q0=4:X=0:Y=0
4630 IFA(X*8+Y)>0THENGOSUB2000
4640 GOSUB700:IFZ=0THEN4630
4650 X=U(U+3):Y=U(U+4):Q0=1:GOSUB2000:GOSUB600
4660 F9=RND(1)*10:F8=ABS(A*10-35)+ABS(B*10-35):F7=0:IFA(X*8+Y)>-10ANDA(X*8+Y)<-1THENF7=10-ABS(X8-A)-ABS(Y8-B)
4670 F9=F9+(100-F8)+F7+A(A*8+B)*100+V0*100:IFF9>FTHENF=F9:X0=X:Y0=Y:A0=A:B0=B
4680 RETURN
5000 FORY=7TO0STEP-1:PRINT@40*(7-Y),Y+1;:FORX=0TO7:GOSUB5500:NEXTX,Y:RETURN
5500 'Display piece
5520 PRINT@40*(7-Y)+X*2+4,"";:G6=A(X*8+Y):IFG6*I>0THENPRINTCHR$(27);"p";
5530 IFG6=0THENG6=3:IF(X+Y)MOD2=0THENG6=1
5540 IFABS(G6)=99THENG6=10
5570 PRINTCHR$(P(ABS(G6)));CHR$(27);"q";:RETURN
7000 PRINT" ";CHR$(8);
7010 IN=0:IN$=INKEY$:IFIN$>""THENIN=ASC(IN$)
7020 IFIN=0THEN7010
7030 IFIN=27THEN9010
7040 IFIN>90THENIN=IN-32
7050 PRINTCHR$(IN);:RETURN
7100 GOSUB7000:IFIN=8THENPRINT" ";:GOTO7100
7105 X=IN:IFX=80ORX=75ORX=81THENRETURN
7110 GOSUB7000:IFIN=8THEN7100
7120 Y=IN:GOSUB7000:IFIN=8THEN7110
7130 A=IN:GOSUB7000:IFIN=8THEN7120
7140 B=IN:RETURN
9000 BEEP:PRINT@262,"Hit any key";:GOSUB7000
9010 CALL7089:POKE63794,0:MENU
9100 DATA7,4,5,0,0,5,4,7
9200 DATA255,80,32,78,66,32,82,32,81,75