'QChess by Mike Weiblen [CIS: 72506,2072; Delphi: EKIM] 072485 DIM AZ(63), UZ(14), PZ(10): U = -8 40 CLS : PRINT "Portfolio QuikChess v1.0": PRINT : PRINT "Do you want to be white (Y/N) "; : GOSUB 7000 IF NOT ((IN = 89) OR (IN = 78)) THEN 40 FOR x = 0 TO 56 STEP 8: READ AZ(x): AZ(x + 7) = -AZ(x): AZ(x + 1) = 2: AZ(x + 6) = -2: NEXT x FOR x = 1 TO 10: READ PZ(x): NEXT x CLS : IF IN = 89 THEN AZ(24) = 9: AZ(32) = 99: AZ(31) = -9: AZ(39) = -99: I = 1: GOSUB 5000: GOTO 1500 AZ(24) = 99: AZ(32) = 9: AZ(31) = -99: AZ(39) = -9: I = -1: GOSUB 5000: GOTO 1000 500 U = U + 8: UZ(U) = S: UZ(U + 1) = x: UZ(U + 2) = y: UZ(U + 3) = A: UZ(U + 4) = B: UZ(U + 5) = Q0: UZ(U + 6) = AZ(A * 8 + B): AZ(A * 8 + B) = AZ(x * 8 + y): AZ(x * 8 + y) = 0: RETURN 600 S = UZ(U): x = UZ(U + 1): y = UZ(U + 2): A = UZ(U + 3): B = UZ(U + 4): Q0 = UZ(U + 5): AZ(x * 8 + y) = AZ(A * 8 + B): AZ(A * 8 + B) = UZ(U + 6): U = U - 8: RETURN 700 Z = 0: y = y + 1: IF y > 7 THEN y = 0: x = x + 1: Z = (x > 7) RETURN 1000 'Computer Move F = -9900: Q0 = 5: x = 0: y = 0 1040 PRINT@102,"Thinking "; CHR$(x + 65); CHR$(y + 49); : IF AZ(x * 8 + y) < 0 THEN GOSUB 2000 IF AZ(x * 8 + y) = 99 THEN X8 = x: Y8 = y GOSUB 700: IF Z = 0 THEN 1040 1080 IF F < -900 THEN PRINT@102 "I Concede "; : GOTO 9000 1090 AZ(A0 * 8 + B0) = AZ(X0 * 8 + Y0): AZ(X0 * 8 + Y0) = 0: IF AZ(A0 * 8 + B0) = -2 AND B0 = 0 THEN AZ(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: GOSUB 5500: x = A0: y = B0: GOSUB 5500 1100 V0 = 0: x = A0: y = B0: Q0 = 1: GOSUB 2000: IF V0 > 0 THEN PRINT@116,"Chk"; 1500 'Player Move 1510 PRINT@182," "; PRINT@182,"Your move? "; : GOSUB 7100 IF x = 80 THEN 1000: REM P - pass IF x = 75 THEN 1710: REM k - castle right IF x = 81 THEN 1730: REM q - castle left x = x - 65: y = y - 49: A = A - 65: B = B - 49: P9 = 0 1522 IF x < 0 OR y < 0 OR A < 0 OR B < 0 OR x > 7 OR y > 7 OR A > 7 OR B > 7 THEN 1590 1525 IF AZ(x * 8 + y) < 1 THEN 1590 1527 IF AZ(x * 8 + y) = 2 AND AZ(A * 8 + B) = 0 AND y = 4 AND B = 5 AND ABS(x - A) = 1 THEN P9 = 1: GOTO 1530 1528 D = 0: A0 = A: B0 = B: Q0 = 3: GOSUB 2000: IF D = 0 THEN 1590 1530 A = A0: B = B0: AZ(A * 8 + B) = AZ(x * 8 + y): AZ(x * 8 + y) = 0: IF AZ(A * 8 + B) = 2 AND B = 7 THEN AZ(A * 8 + B) = 9 1540 GOSUB 5500: x = A: y = B: GOSUB 5500: IF P9 = 1 THEN y = B - 1: AZ(x * 8 + y) = 0: GOSUB 5500 1550 GOTO 1000 1590 BEEP: GOTO 1500 1700 'Castling 1710 IF AZ(32) = 99 AND AZ(56) = 7 THEN AZ(32) = 0: AZ(56) = 0: AZ(48) = 99: AZ(40) = 7: GOTO 1747 1720 IF AZ(24) = 99 AND AZ(0) = 7 THEN AZ(24) = 0: AZ(0) = 0: AZ(8) = 99: AZ(16) = 7: GOTO 1747 1725 GOTO 1590 1730 IF AZ(32) = 99 AND AZ(0) = 7 THEN AZ(32) = 0: AZ(0) = 0: AZ(16) = 99: AZ(24) = 7: GOTO 1747 1740 IF AZ(24) = 99 AND AZ(56) = 7 THEN AZ(24) = 0: AZ(56) = 0: AZ(40) = 99: AZ(32) = 7: GOTO 1747 1745 GOTO 1590 1747 GOSUB 5000: GOTO 1000 2000 'Scan Piece's Moves 2010 IF ABS(AZ(x * 8 + y)) = 99 THEN 2100 2020 ON ABS(AZ(x * 8 + y)) - 1 GOTO 2500, 9999, 2400, 2300, 9999, 2200, 9999, 2200 2100 'King 2110 A = x - 2 2120 B = y - 2: A = A + 1 2130 B = B + 1: GOSUB 3200: IF B < y + 1 THEN 2130 2132 IF A < x + 1 THEN 2120 2140 RETURN 2200 'Rook/Queen 2210 A = x: B = y 2220 A = A + 1: GOSUB 3200: IF S = 0 THEN 2220 2230 A = x 2240 A = A - 1: GOSUB 3200: IF S = 0 THEN 2240 2250 A = x 2260 B = B + 1: GOSUB 3200: IF S = 0 THEN 2260 2270 B = y 2280 B = B - 1: GOSUB 3200: IF S = 0 THEN 2280 2290 IF ABS(AZ(x * 8 + y)) = 7 THEN RETURN 2300 'Bishop/Queen 2310 A = x: B = y 2320 A = A + 1: B = B + 1: GOSUB 3200: IF S = 0 THEN 2320 2330 A = x: B = y 2340 A = A + 1: B = B - 1: GOSUB 3200: IF S = 0 THEN 2340 2350 A = x: B = y 2360 A = A - 1: B = B + 1: GOSUB 3200: IF S = 0 THEN 2360 2370 A = x: B = y 2380 A = A - 1: B = B - 1: GOSUB 3200: IF S = 0 THEN 2380 2390 RETURN 2400 'Knight 2410 A = x + 2: B = y + 1: GOSUB 3200: B = B - 2: GOSUB 3200: A = A - 4: GOSUB 3200: B = B + 2: GOSUB 3200 2420 A = A + 1: B = B + 1: GOSUB 3200: B = B - 4: GOSUB 3200: A = A + 2: GOSUB 3200: B = B + 4: GOTO 3200 2500 'Player Pawn 2510 A = x: IF AZ(x * 8 + y) < 0 THEN 2600 2520 B = y + 1: GOSUB 3000: IF y < 2 AND S = 0 THEN B = B + 1: GOSUB 3000 2530 B = y + 1: GOTO 2630 2600 'Computer Pawn 2610 B = y - 1: GOSUB 3000: IF y > 5 AND S = 0 THEN B = B - 1: GOSUB 3000 2620 B = y - 1 2630 A = x + 1: GOSUB 3100: A = A - 2: GOTO 3100 2640 'Move Range Check 3000 S = 0: IF AZ(A * 8 + B) THEN S = 1: RETURN 3020 GOTO 4000 3100 IF A < 0 OR A > 7 THEN RETURN IF AZ(A * 8 + B) = 0 OR SGN(AZ(A * 8 + B)) = SGN(AZ(x * 8 + y)) THEN RETURN GOTO 4000 3200 S = 0: IF A < 0 OR A > 7 OR B < 0 OR B > 7 THEN S = 1: RETURN IF AZ(A * 8 + B) THEN S = 1 IF SGN(AZ(A * 8 + B)) = SGN(AZ(x * 8 + y)) THEN RETURN 4000 'Reason FOR Scan ON Q0 GOTO 4100, 4200, 4300, 4500, 4600 4100 'Player's King Threatened? IF AZ(A * 8 + B) = 99 THEN V0 = V0 + 1 RETURN 4200 'Comp Piece Protected? IF UZ(U + 3) = A AND UZ(U + 4) = B THEN P = 0 RETURN 4300 'Player Move Valid? IF A0 = A AND B0 = B THEN D = 1 RETURN 4500 'Comp Piece Threatened? IF AZ(A * 8 + B) > -1 THEN RETURN P = AZ(A * 8 + B): IF ABS(P) > AZ(x * 8 + y) THEN 4580 GOSUB 500: Q0 = 2: x = 0: y = 0 4550 IF AZ(x * 8 + y) < 0 THEN GOSUB 2000: IF P = 0 THEN 4570 GOSUB 700: IF Z = 0 THEN 4550 4570 GOSUB 600 4580 IF P < V0 THEN V0 = P RETURN 4600 'Find Best Comp Move IF AZ(A * 8 + B) = 99 THEN PRINT@102, "CheckMate "; : GOTO 9000 GOSUB 500: V0 = 0: Q0 = 4: x = 0: y = 0 4630 IF AZ(x * 8 + y) > 0 THEN GOSUB 2000 GOSUB 700: IF Z = 0 THEN 4630 x = UZ(U + 3): y = UZ(U + 4): Q0 = 1: GOSUB 2000: GOSUB 600 F9 = RND * 10: F8 = ABS(A * 10 - 35) + ABS(B * 10 - 35): F7 = 0: IF AZ(x * 8 + y) > -10 AND AZ(x * 8 + y) < -1 THEN F7 = 10 - ABS(X8 - A) - ABS(Y8 - B) F9 = F9 + (100 - F8) + F7 + AZ(A * 8 + B) * 100 + V0 * 100: IF F9 > F THEN F = F9: X0 = x: Y0 = y: A0 = A: B0 = B RETURN 5000 FOR y = 7 TO 0 STEP -1: LOCATE (8 - y), y + 1: FOR x = 0 TO 7: GOSUB 5500: NEXT x:next y: RETURN 5500 'Display piece 5520 LOCATE (8 - y), x * 2 + 4: g6 = AZ(x * 8 + y): IF g6 * I > 0 THEN PRINT ""; : REM CHR$(27); "p"; IF g6 = 0 THEN g6 = 3: IF (x + y) % 2 = 0 THEN g6 = 1 IF g6 = 99 THEN g6 = 10 ELSE IF g6 = -99 THEN g6 = -10 IF (x + y) % 2 = 0 THEN bj$ = CHR$(219) ELSE bj$ = " " IF g6 > 0 THEN PRINT CHR$(PZ(ABS(g6))); bj$;: RETURN: REM CHR$(27); "q"; : RETURN PRINT CHR$(32 + PZ(ABS(g6))); bj$;: RETURN 7000 PRINT " "; : LOCATE (CSRLIN), (POS(0) - 1): REM CHR$(8); 7010 IN = 0: IN$ = INKEY$: IF IN$ <> "" THEN IN = ASC(IN$) IF IN = 0 THEN 7010 IF IN = 27 THEN 9010 IF IN > 90 THEN IN = IN - 32 IF IN = 8 THEN LOCATE CSRLIN, POS(0) - 1: RETURN PRINT CHR$(IN); : RETURN 7100 GOSUB 7000: IF IN = 8 THEN PRINT " "; : GOTO 7100 7105 x = IN: IF x = 80 OR x = 75 OR x = 81 THEN RETURN 7110 GOSUB 7000: IF IN = 8 THEN 7100 7120 y = IN: GOSUB 7000: IF IN = 8 THEN 7110 A = IN: GOSUB 7000: IF IN = 8 THEN 7120 B = IN: RETURN 9000 BEEP:PRINT@262,"Hit any key"; : GOSUB 7000 9010 LOCATE 8, 39: if isrun then run "menu" else END 9100 DATA 7,4,5,0,0,5,4,7 9200 DATA 219,80,32,78,66,32,82,32,81,75 9999 Print "Internal Error":end