updated code

by

Eliminated 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"
 PRINT
 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



    
This message has been edited by MCalkins from IP address 12.183.134.2 on Dec 22, 2005 4:58 PM
This message has been edited by MCalkins from IP address 12.183.134.2 on Dec 22, 2005 4:56 PM

Posted on Dec 22, 2005, 4:50 PM
from IP address 12.183.134.2

Respond to this message   

Return to Index


Response TitleAuthor and Date
Making progress :-) on Dec 22
 Started new thread on Dec 23