um, code so far...byShould be mostly compliant with your instructions, except that the value returned by LegalMove is 0 if the move is legal, and a number from 1 to 9 otherwise. Contained is some demo/text code, which was written quickly and some of which is very very inefficient. It needs much more testing, and probably more debugging, but I can't do more tonight, I will look at it more tomorrow. Copy out the 3 functions, as well as the 4 shared arrays/variables. Regards, Michael DECLARE FUNCTION LegalMove% (movestr AS STRING) DECLARE FUNCTION isthreatened% (i%, cx%, cy%, dir%) DECLARE FUNCTION ispathblocked% (sy%, sy%, dx%, dy%) 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 '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 0 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 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 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$) = 0 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) '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(dx - sx): iy = SGN(dy - sy) cnt = ABS(dx - sx) OR ABS(dy - sy) x = sx: y = sy FOR i = 1 TO cnt - 1 x = x + ix: y = y + iy IF board(x, y) THEN n = -1: EXIT FOR 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) OR (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" 'currently returns 0 if legal, an error code if illegal. 'This will need to be changed to meet your criteria DIM sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER DIM source AS INTEGER, why AS INTEGER, x AS INTEGER, y AS INTEGER DIM kx AS INTEGER, ky AS INTEGER, dir 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: GOTO outnow ELSE IF source <= 0 THEN why = 1: GOTO outnow END IF dir = SGN(source) IF SGN(board(dx, dy)) = dir THEN why = 2: 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: GOTO outnow IF sy <> dy THEN why = 3: GOTO outnow IF ispathblocked(sx, sy, dx, dy) THEN why = 4: GOTO outnow SELECT CASE dx CASE 3 IF ABS(board(1, sy)) <> 5 THEN why = 5: GOTO outnow IF isthreatened(1, 4, sy, dir) THEN why = 7: GOTO outnow vboard(1, sy) = 0: vboard(4, sy) = dir * 8 CASE 7 IF ABS(board(8, sy)) <> 5 THEN why = 5: GOTO outnow IF isthreatened(1, 6, sy, dir) THEN why = 7: GOTO outnow vboard(8, sy) = 0: vboard(6, sy) = dir * 8 CASE ELSE: why = 3: 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: 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: GOTO outnow IF ispathblocked(sx, sy, dx, dy) THEN why = 4: GOTO outnow CASE 3 'bishop IF ABS(sx - dx) <> ABS(sy - dy) THEN why = 3: GOTO outnow IF ispathblocked(sx, sy, dx, dy) THEN why = 4: GOTO outnow CASE 4 'night IF ((ABS(sx - dx) + ABS(sy - dy)) <> 3) OR (sx = dx) OR (sy = dy) THEN why = 3: GOTO outnow CASE 5, 8 'rook IF (sx <> dx) AND (sy <> dy) THEN why = 3: GOTO outnow IF ispathblocked(sx, sy, dx, dy) THEN why = 4: GOTO outnow source = dir * 8 CASE 6 IF SGN(dy - sy) <> dir THEN why = 3: GOTO outnow IF sx = dx THEN IF board(dx, dy) THEN why = 3: GOTO outnow SELECT CASE dy - sy CASE IS > 2, IS < -2: why = 3: GOTO outnow CASE 2 IF (turn <> 0) OR (sy <> 2) THEN why = 3: GOTO outnow IF board(sx, 3) THEN why = 4: GOTO outnow CASE -2 IF (turn = 0) OR (sy <> 7) THEN why = 3: GOTO outnow IF board(sx, 6) THEN why = 4: GOTO outnow END SELECT ELSE IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) <> 1) THEN why = 3: GOTO outnow IF (board(dx, dy) = 0) THEN IF (pawnspec <> dx) THEN why = 3: 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: GOTO outnow outnow: 'You will need to insert some code here? LegalMove = why END FUNCTION from IP address 12.183.134.54 |