In theory, now fully compliant, but still needs major testing.byLegalMove should now return 0 for not possible, 1 for illegal move, and 2 for okay. I have done very little testing on the changes. Regards, Michael DECLARE FUNCTION LegalMove% (movestr AS STRING) DECLARE FUNCTION isthreatened% (i%, cx%, cy%, dir%) DECLARE FUNCTION ispathblocked% (sy%, sy%, dx%, dy%, which%) DIM SHARED board(1 TO 8, 1 TO 8) AS INTEGER DIM SHARED vboard(1 TO 8, 1 TO 8) AS INTEGER DIM SHARED turn AS INTEGER'0 for white's turn,non-zero for black's turn DIM SHARED pawnspec AS INTEGER 'if a pawn has just moved 2 steps forward, its x, otherwise -1 'the precedeing is code that must be included 'the following is test/demo code: DEFINT A-Z DIM SHARED why AS INTEGER 'WIDTH 40, 25 CLS GOSUB initboard GOSUB showboard turn = 0 DO GOSUB prompt turn = NOT turn GOSUB anylegal 'very crude endgame detection LOOP UNTIL gameover SYSTEM prompt: turndone = 0 DO GOSUB showboard LOCATE 12, 1 IF turn THEN PRINT "Black: "; ELSE PRINT "White: "; LINE INPUT movestr$ CLS GOSUB showboard movestr$ = LTRIM$(LCASE$(movestr$)) IF LEN(movestr$) = 4 THEN movestr$ = LEFT$(movestr$, 2) + "-" + MID$(movestr$, 3) IF LEN(movestr$) < 5 THEN PRINT "Quit? " IF LCASE$(INPUT$(1)) = "y" THEN gameover = -1 ELSE LOCATE 11, 1 SELECT CASE LegalMove(movestr$) CASE 2 sx = ASC(LEFT$(movestr$, 1)) - &H60 sy = ASC(MID$(movestr$, 2, 1)) - &H30 dx = ASC(MID$(movestr$, 4, 1)) - &H60 dy = ASC(MID$(movestr$, 5, 1)) - &H30 source = board(sx, sy) dir = SGN(source) SELECT CASE ABS(source) CASE 1, 7: source = 7 * dir SELECT CASE dx CASE 3: board(1, sy) = 0: board(4, sy) = 8 * dir CASE 7: board(8, sy) = 0: board(6, sy) = 8 * dir END SELECT CASE 5: source = 8 * dir CASE 6 IF (dy - 1) = (7 AND (turn = 0)) THEN PRINT "Promote to?" DO SELECT CASE LCASE$(INKEY$) CASE "q": source = 2 * dir: EXIT DO CASE "b": source = 3 * dir: EXIT DO CASE "n": source = 4 * dir: EXIT DO CASE "r": source = 8 * dir: EXIT DO END SELECT LOOP ELSE IF sx <> dx THEN IF (board(dx, dy) = 0) THEN board(pawnspec, sy) = 0 END IF END IF END SELECT IF (ABS(dy - sy) > 1) AND (ABS(source) = 6) THEN pawnspec = sx ELSE pawnspec = -1 board(sx, sy) = 0: board(dx, dy) = source kx = -1 FOR x = 1 TO 8 FOR y = 1 TO 8 SELECT CASE (0 - dir) * board(x, y) CASE 1, 7: kx = x: ky = y: EXIT FOR END SELECT NEXT y IF kx > -1 THEN EXIT FOR NEXT x check = 0 IF isthreatened(0, kx, ky, 0 - dir) THEN LOCATE 11, 1: PRINT "Check!": check = -1 turndone = -1 CASE 0: PRINT "not possible "; SELECT CASE why CASE 1: PRINT "Invalid source" CASE 2: PRINT "You cannot capture your own piece" CASE 3: PRINT "Invalid move" CASE 4: PRINT "Your path is blocked" CASE 5: PRINT "That rook has been moved" CASE 6: PRINT "You cannot castle while in check" CASE 7: PRINT "King cannot jump threatened squares" CASE 8: PRINT "King would be in check" CASE 9: PRINT "Parameters out of range" END SELECT CASE 1: PRINT "illegal move "; SELECT CASE why CASE 1: PRINT "Invalid source" CASE 2: PRINT "You cannot capture your own piece" CASE 3: PRINT "Invalid move" CASE 4: PRINT "Your path is blocked" CASE 5: PRINT "That rook has been moved" CASE 6: PRINT "You cannot castle while in check" CASE 7: PRINT "King cannot jump threatened squares" CASE 8: PRINT "King would be in check" CASE 9: PRINT "Parameters out of range" END SELECT END SELECT END IF LOOP UNTIL gameover OR turndone RETURN initboard: board(1, 1) = 5 board(8, 1) = 5 board(2, 1) = 4 board(7, 1) = 4 board(3, 1) = 3 board(6, 1) = 3 board(4, 1) = 2 board(5, 1) = 1 board(1, 8) = -5 board(8, 8) = -5 board(2, 8) = -4 board(7, 8) = -4 board(3, 8) = -3 board(6, 8) = -3 board(4, 8) = -2 board(5, 8) = -1 FOR x = 1 TO 8 board(x, 2) = 6 board(x, 7) = -6 NEXT x RETURN showboard: LOCATE 1, 1 FOR y = 8 TO 1 STEP -1 FOR x = 1 TO 8 i = board(x, y) COLOR 13 + SGN(i) * 2, 7 - ((((x MOD 2) XOR (y MOD 2)) <> 0) AND 5) PRINT " "; MID$(" kQBNrPKR", ABS(i) + 1, 1); NEXT x COLOR 9, 0 PRINT " "; CHR$(&H30 + y) NEXT y PRINT " a b c d e f g h" COLOR 7, 0 RETURN anylegal: 'very crude and inefficient. Needs to be replaced n = 0 IF turn THEN dir = -1 ELSE dir = 1 FOR x = 1 TO 8 FOR y = 1 TO 8 IF SGN(board(x, y)) = dir THEN FOR x1 = 1 TO 8 FOR y1 = 1 TO 8 cmdstr$ = CHR$(x + &H60) + CHR$(y + &H30) + "-" + CHR$(x1 + &H60) + CHR$(y1 + &H30) IF LegalMove(cmdstr$) = 2 THEN n = -1: GOTO okaynow NEXT y1 NEXT x1 END IF NEXT y NEXT x okaynow: IF n = 0 THEN LOCATE 20, 1 IF check THEN PRINT "Checkmate" ELSE PRINT "Stalemate" END IF gameover = -1 END IF RETURN FUNCTION ispathblocked (sx, sy, dx, dy, which) 'line must be a valid linear move. Input is assumed to be valid! DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, cnt AS INTEGER DIM n AS INTEGER, i AS INTEGER ix = SGN(sx - dx): iy = SGN(sy - dy) cnt = ABS(dx - sx) OR ABS(dy - sy) x = dx: y = dy FOR i = 1 TO cnt - 1 x = x + ix: y = y + iy SELECT CASE board(x, y) CASE IS < 0: IF which <= 0 THEN n = -1: EXIT FOR CASE IS > 0: IF which >= 0 THEN n = -1: EXIT FOR END SELECT NEXT i ispathblocked = n END FUNCTION FUNCTION isthreatened (bi, cx, cy, dir) 'this function assumes valid input DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER DIM i AS INTEGER, b AS INTEGER n = 0 FOR i = 0 TO 7 x = cx: y = cy 'ix = ((i + 2) MOD 3) - 1 'could be replaced with a SELECT CASE 'iy = ((i * 4) \ 10) - 1 'not sure which would be more efficient SELECT CASE i CASE 0: ix = 1: iy = -1 CASE 1: ix = -1: iy = -1 CASE 2: ix = 0: iy = -1 CASE 3: ix = 1: iy = 0 CASE 4: ix = -1: iy = 0 CASE 5: ix = 0: iy = 1 CASE 6: ix = 1: iy = 1 CASE 7: ix = -1: iy = 1 END SELECT DO x = x + ix: y = y + iy IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO '1=K 2=Q 3=B 4=N 5=R 6=pawn (White) '7=K 8=R if the piece has moved (re: Castling) '-1=K .... (Black) IF bi = 0 THEN b = board(x, y) ELSE b = vboard(x, y) END IF SELECT CASE b * dir CASE 2 TO 6, 8, -4: EXIT DO CASE -2: n = -1: EXIT FOR CASE -3: IF (x = cx) OR (y = cy) THEN EXIT DO ELSE n = -1: EXIT FOR CASE -5, -8: IF (x <> cx) AND (y <> cy) THEN EXIT DO ELSE n = -1: EXIT FOR CASE -6: IF (ABS(x - cx) <> 1) OR ((y - cy) <> dir) THEN EXIT DO ELSE n = -1: EXIT FOR END SELECT LOOP NEXT i IF NOT n THEN FOR i = 0 TO 7 'x = cx + (((i + 1) MOD 2) + 1) * (1 OR (i < 4)) 'y = cy + ((i MOD 2) + 1) * (1 OR (i < 2) OR (i > 5)) SELECT CASE i CASE 0: x = cx - 2: y = cy - 1 CASE 1: x = cx - 1: y = cy - 2 CASE 2: x = cx - 2: y = cy + 1 CASE 3: x = cx - 1: y = cy + 2 CASE 4: x = cx + 2: y = cy + 1 CASE 5: x = cx + 1: y = cy + 2 CASE 6: x = cx + 2: y = cy - 1 CASE 7: x = cx + 1: y = cy - 2 END SELECT IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN IF bi = 0 THEN b = board(x, y) ELSE b = vboard(x, y) END IF IF (b * dir) = -4 THEN n = -1: EXIT FOR END IF NEXT i END IF isthreatened = n END FUNCTION FUNCTION LegalMove (movestr AS STRING) 'format "a1-h8" DIM sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER DIM source AS INTEGER, why2 AS INTEGER, x AS INTEGER, y AS INTEGER DIM kx AS INTEGER, ky AS INTEGER, dir why = 0 'temporary!!! why2 = 2 sx = ASC(LEFT$(movestr, 1)) - &H60 sy = ASC(MID$(movestr, 2, 1)) - &H30 dx = ASC(MID$(movestr, 4, 1)) - &H60 dy = ASC(MID$(movestr, 5, 1)) - &H30 '1=K 2=Q 3=B 4=N 5=R 6=pawn (White) '7=K 8=R if the piece has moved (re: Castling) '-1=K .... (Black) 'IF (sx < 1) OR (sx > 8) OR (sy < 1) OR (sy > 8) OR (dx < 1) OR (dx > 8) OR (dy < 1) OR (dy > 8) THEN why = 9: GOTO outnow source = board(sx, sy) IF turn THEN IF source >= 0 THEN why = 1: why2 = 1: GOTO outnow ELSE IF source <= 0 THEN why = 1: why2 = 1: GOTO outnow END IF dir = SGN(source) IF SGN(board(dx, dy)) = dir THEN why = 2: why2 = 1: GOTO outnow FOR x = 1 TO 8 FOR y = 1 TO 8 vboard(x, y) = board(x, y) SELECT CASE dir * board(x, y) CASE 1, 7: kx = x: ky = y END SELECT NEXT y NEXT x vboard(sx, sy) = 0 SELECT CASE ABS(source) CASE 1 'king IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN IF isthreatened(0, sx, sy, dir) THEN why = 6: why2 = 0: GOTO outnow IF sy <> dy THEN why = 3: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why = 4: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why = 4: why2 = 0: GOTO outnow SELECT CASE dx CASE 3 IF ABS(board(1, sy)) <> 5 THEN why = 5: why2 = 1: GOTO outnow IF isthreatened(1, 4, sy, dir) THEN why = 7: why2 = 0: GOTO outnow vboard(1, sy) = 0: vboard(4, sy) = dir * 8 CASE 7 IF ABS(board(8, sy)) <> 5 THEN why = 5: why2 = 1: GOTO outnow IF isthreatened(1, 6, sy, dir) THEN why = 7: why2 = 0: GOTO outnow vboard(8, sy) = 0: vboard(6, sy) = dir * 8 CASE ELSE: why = 3: why2 = 1: GOTO outnow END SELECT END IF source = dir * 7 kx = dx: ky = dy CASE 7 'king IF (ABS(sx - dx) + ABS(sy - dy)) > 1 THEN why = 3: why2 = 1: GOTO outnow kx = dx: ky = dy CASE 2 'queen IF (sx <> dx) AND (sy <> dy) AND (ABS(sx - dx) <> ABS(sy - dy)) THEN why = 3: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why = 4: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why = 4: why2 = 0: GOTO outnow CASE 3 'bishop IF ABS(sx - dx) <> ABS(sy - dy) THEN why = 3: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why = 4: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why = 4: why2 = 0: GOTO outnow CASE 4 'night IF ((ABS(sx - dx) + ABS(sy - dy)) <> 3) OR (sx = dx) OR (sy = dy) THEN why = 3: why2 = 1: GOTO outnow CASE 5, 8 'rook IF (sx <> dx) AND (sy <> dy) THEN why = 3: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why = 4: why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why = 4: why2 = 0: GOTO outnow source = dir * 8 CASE 6 IF SGN(dy - sy) <> dir THEN why = 3: why2 = 1: GOTO outnow IF sx = dx THEN IF board(dx, dy) THEN why = 3: why2 = 0: GOTO outnow SELECT CASE dy - sy CASE IS > 2, IS < -2: why = 3: why2 = 1: GOTO outnow CASE 2 IF (turn <> 0) OR (sy <> 2) THEN why = 3: why2 = 1: GOTO outnow SELECT CASE SGN(board(sx, 3)) CASE dir: why = 4: why2 = 1: GOTO outnow CASE 0 - dir: why = 4: why2 = 0: GOTO outnow END SELECT CASE -2 IF (turn = 0) OR (sy <> 7) THEN why = 3: why2 = 1: GOTO outnow SELECT CASE SGN(board(sx, 6)) CASE dir: why = 4: why2 = 1: GOTO outnow CASE 0 - dir: why = 4: why2 = 0: GOTO outnow END SELECT END SELECT ELSE IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) <> 1) THEN why = 3: why2 = 1: GOTO outnow IF (board(dx, dy) = 0) THEN IF (pawnspec <> dx) THEN why = 3: why2 = 0: GOTO outnow ELSE vboard(pawnspec, sy) = 0 END IF END IF END IF END SELECT vboard(dx, dy) = source IF isthreatened(1, kx, ky, dir) THEN why = 8: why2 = 0: GOTO outnow outnow: LegalMove = why2 END FUNCTION
from IP address 12.183.134.27 |