In theory, now fully compliant, but still needs major testing.

by

LegalMove 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
 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



    
This message has been edited by MCalkins from IP address 12.183.134.27 on Dec 21, 2005 4:11 PM
This message has been edited by MCalkins from IP address 12.183.134.27 on Dec 21, 2005 3:50 PM

Posted on Dec 21, 2005, 3:39 PM
from IP address 12.183.134.27

Respond to this message   

Return to Index