updated codebyEliminated DEFINT, because I know the main section won't use it, and the only alternative would have been for me to put one on each function. Therefore, I just use "%" and AS INTEGER now. This new code seems to work with the new driver. I fixed a few bugs/issues in the functions and the test code. 1 problem in my old test code was that I had the green and white squares wrong. The white queen is supposed to be on a white square. I fixed this in my test code, but the COLOR statement you copied into the driver still contains my mistake. Sorry. Could you please change: COLOR 13 + SGN(zP) * 2, 7 - ((((zC MOD 2) XOR (zR MOD 2)) <> 0) AND 5) in the driver to: COLOR 13 + SGN(zP) * 2, 7 - ((((zC MOD 2) XOR (zR MOD 2)) <> 1) AND 5) Thanks. I can't be sure, but the functions now seem to be fairly bug free. :-). Only time will tell... btw, in case this helps you when you write the main program: after LegalMove% is used on a correct move, the vboard array contains exactly what the board should look like if the move were made. (this was accomplished with only a handful of extra lines in LegalMove. impact on execution time is minimal). If anything, comparing the two can be a test of the main program. My own test code is compared with vboard for test purposes. Regards, Michael P.S. the test code and functions, by themselves, are a fully functional 2-player chess game... :-D Although if they were meant soley for that purpose, they could be optimized by removing Kriegspeil compliance. Also, certain portions of my test code are downright lousy, because I wrote them quickly, knowing they won't end up in the final product. DEFSTR A-Z 'Mac style debugging :-) DECLARE FUNCTION LegalMove% (movestr AS STRING) DECLARE FUNCTION isthreatened% (bi AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER) DECLARE FUNCTION ispathblocked% (sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER, which AS INTEGER) DIM SHARED board(1 TO 8, 1 TO 8) AS INTEGER DIM SHARED vboard(1 TO 8, 1 TO 8) AS INTEGER 'the precedeing is code that must be included 'the following is test/demo code: DIM turn AS INTEGER, x AS INTEGER, y AS INTEGER, gameover AS INTEGER DIM turndone AS INTEGER, sx AS INTEGER, sy AS INTEGER, dx AS INTEGER DIM dy AS INTEGER, source AS INTEGER, dir AS INTEGER, why2 AS INTEGER DIM kx AS INTEGER, ky AS INTEGER, check AS INTEGER, i AS INTEGER DIM x1 AS INTEGER, y1 AS INTEGER, n AS INTEGER CLS GOSUB initboard 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 COLOR 15 - ((turn AND 4)), 0 IF turn THEN PRINT "Black: "; ELSE PRINT "White: "; COLOR 7, 0 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 CLS ELSE LOCATE 11, 1 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) IF (dir = 0) OR (turn XOR (dir = -1)) THEN why2 = 1 ELSE why2 = LegalMove%(movestr$) END IF SELECT CASE why2 CASE 2 SELECT CASE ABS(source) CASE 1, 7: source = 7 * dir IF (ABS(dx - sx) > 1) OR (ABS(dy - sy) > 1) THEN 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 END IF 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 ELSEIF (ABS(dy - sy) > 1) THEN source = dir * 9 ELSE IF sx <> dx THEN IF board(dx, dy) = 0 THEN board(dx, sy) = 0 END IF END IF CASE 9: source = dir * 6 END SELECT 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 CASE 9, -9: IF (x <> dx) OR (y <> dy) THEN board(x, y) = SGN(board(x, y)) * 6 END SELECT NEXT y NEXT x check = 0 IF isthreatened%(0, kx, ky, 0 - dir) THEN LOCATE 11, 1: PRINT "Check!": check = -1 turndone = -1 FOR x = 1 TO 8 FOR y = 1 TO 8 IF board(x, y) <> vboard(x, y) THEN BEEP PRINT "Discrepency between board and vboard:" PRINT "x="; x, "y="; y PRINT "board(x,y)="; board(x, y) PRINT "vboard(x,y)="; vboard(x, y) DO: LOOP UNTIL INKEY$ <> "" END IF NEXT y NEXT x CASE 0: PRINT "not possible "; CASE 1: PRINT "illegal move "; END SELECT END IF LOOP UNTIL gameover OR turndone RETURN initboard: FOR y = 1 TO 8 STEP 7 board(1, y) = 5 * (1 OR (y = 8)) board(8, y) = 5 * (1 OR (y = 8)) board(2, y) = 4 * (1 OR (y = 8)) board(7, y) = 4 * (1 OR (y = 8)) board(3, y) = 3 * (1 OR (y = 8)) board(6, y) = 3 * (1 OR (y = 8)) board(4, y) = 2 * (1 OR (y = 8)) board(5, y) = 1 * (1 OR (y = 8)) NEXT y FOR x = 1 TO 8 board(x, 2) = 6 board(x, 7) = -6 NEXT x RETURN showboard: LOCATE 1, 1 COLOR 9, 0: PRINT " a b c d e f g h" FOR y = 8 TO 1 STEP -1 COLOR 9, 0 PRINT CHR$(&H30 + y); " "; FOR x = 1 TO 8 i = board(x, y) COLOR 13 + SGN(i) * 2, 7 - ((((x MOD 2) XOR (y MOD 2)) <> 1) AND 5) PRINT " "; MID$(" kQBNrpKRP", 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 IF SGN(board(x1, y1)) <> dir THEN cmdstr$ = CHR$(x + &H60) + CHR$(y + &H30) + "-" + CHR$(x1 + &H60) + CHR$(y1 + &H30) IF LegalMove%(cmdstr$) = 2 THEN n = -1: GOTO okaynow END IF NEXT y1 NEXT x1 END IF NEXT y NEXT x okaynow: IF n = 0 THEN GOSUB showboard LOCATE 20, 1 IF check THEN PRINT "Checkmate" ELSE PRINT "Stalemate" END IF gameover = -1 END IF RETURN FUNCTION ispathblocked% (sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER, which AS INTEGER) '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 AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER) '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) '9=P if the pawn can be taken en passent '-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, 9, -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, -9: 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 AS INTEGER 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) '9=P if the pawn can be taken en passent '-1=K .... (Black) source = board(sx, sy) IF source = 0 THEN why2 = 1: GOTO outnow dir = SGN(source) IF SGN(board(dx, dy)) = dir THEN 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 IF ABS(board(x, y)) = 9 THEN vboard(x, y) = SGN(board(x, y)) * 6 END IF 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 why2 = 0: GOTO outnow IF sy <> dy THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why2 = 0: GOTO outnow SELECT CASE dx CASE 3 IF ABS(board(1, sy)) <> 5 THEN why2 = 1: GOTO outnow IF isthreatened%(0, 4, sy, dir) THEN why2 = 0: GOTO outnow vboard(1, sy) = 0: vboard(4, sy) = dir * 8 CASE 7 IF ABS(board(8, sy)) <> 5 THEN why2 = 1: GOTO outnow IF isthreatened%(0, 6, sy, dir) THEN why2 = 0: GOTO outnow vboard(8, sy) = 0: vboard(6, sy) = dir * 8 CASE ELSE: why2 = 1: GOTO outnow END SELECT END IF source = dir * 7 kx = dx: ky = dy CASE 7 'king IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN 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 why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why2 = 0: GOTO outnow CASE 3 'bishop IF ABS(sx - dx) <> ABS(sy - dy) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why2 = 0: GOTO outnow CASE 4 'night IF ((ABS(sx - dx) + ABS(sy - dy)) <> 3) OR (sx = dx) OR (sy = dy) THEN why2 = 1: GOTO outnow CASE 5, 8 'rook IF (sx <> dx) AND (sy <> dy) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, dir) THEN why2 = 1: GOTO outnow IF ispathblocked(sx, sy, dx, dy, 0 - dir) THEN why2 = 0: GOTO outnow source = dir * 8 CASE 6, 1 IF SGN(dy - sy) <> dir THEN why2 = 1: GOTO outnow IF sx = dx THEN IF board(dx, dy) THEN why2 = 0: GOTO outnow SELECT CASE dy - sy CASE IS > 2, IS < -2: why2 = 1: GOTO outnow CASE 2 IF (sy <> 2) THEN why2 = 1: GOTO outnow SELECT CASE SGN(board(sx, 3)) CASE dir: why2 = 1: GOTO outnow CASE 0 - dir: why2 = 0: GOTO outnow END SELECT source = dir * 9 CASE -2 IF (sy <> 7) THEN why2 = 1: GOTO outnow SELECT CASE SGN(board(sx, 6)) CASE dir: why2 = 1: GOTO outnow CASE 0 - dir: why2 = 0: GOTO outnow END SELECT source = dir * 9 CASE 1, -1: source = dir * 6 END SELECT ELSE IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) <> 1) THEN why2 = 1: GOTO outnow IF (board(dx, dy) = 0) THEN IF (board(dx, sy) <> (-9 * dir)) THEN why2 = 0: GOTO outnow ELSE vboard(dx, sy) = 0 END IF END IF source = dir * 6 END IF END SELECT vboard(dx, dy) = source IF isthreatened%(1, kx, ky, dir) THEN why2 = 0: GOTO outnow outnow: LegalMove% = why2 END FUNCTION
from IP address 12.183.134.2 |
| Response Title | Author and Date |
| Making progress :-) | on Dec 22 |
| Started new thread | on Dec 23 |