um, code so far...

by

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

Posted on Dec 21, 2005, 1:12 AM
from IP address 12.183.134.54

Respond to this message   

Return to Index