DM4BAA

DECLARE FUNCTION ExistsAValidMove% (c$)
DECLARE FUNCTION IsInCheck$ (c$)
DECLARE FUNCTION ispathblocked% (sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER, which AS INTEGER)
DECLARE FUNCTION isthreatened% (bi AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER)
DECLARE FUNCTION LegalMove% (movestr AS STRING)
CLS : PRINT "DM4BAA-Logic"
PRINT "---------------"
PRINT "This consists of 1) a driver which can be used to debug"
PRINT "the logic routines and 2) simulated logic routines"
PRINT "which can be used to debug the real calling program."
PRINT
'=============================================
DIM SHARED board(8, 8) AS INTEGER' column, row
DIM SHARED vBoard(8, 8) AS INTEGER' column, row

'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)
OPEN "DM4BAA.dat" FOR APPEND AS #1: CLOSE
OPEN "DM4BAA.dat" FOR INPUT AS #1
IF EOF(1) THEN
  PRINT "This test requires a data file: DM4BAA.dat"
  CLOSE : SYSTEM
END IF
DO WHILE NOT EOF(1)
  LINE INPUT #1, lo$: l$ = LCASE$(lo$) + " "
  GOSUB CheckIt
LOOP
CLOSE
PRINT "Number of tests made: "; CountTests
IF Errors THEN SYSTEM
OPEN "DM4BAA.dat" FOR INPUT AS #1
OPEN "DM4BAA.lst" FOR OUTPUT AS #2
WHILE NOT EOF(1): GOSUB DoIt: WEND
CLOSE
PRINT : PRINT "End of tests: ";
IF BadRun THEN
  PRINT "Unfortunately, there were errors!"
ELSE
  PRINT "* * *  S U C C E S S  * * *"
END IF
SYSTEM

DoIt:
LINE INPUT #1, lo$
IF LEFT$(lo$ + " ", 2) = "s " THEN GOSUB showboard: RETURN
c$ = " ": GOSUB DoIt2: PRINT #2, c$ + " " + lo$
IF c$ = "*" THEN BadRun = -1
RETURN

showboard:
CONST ColorBC = 7: 'Board Coordinate's 1-9, a-h
CONST ColorB = 16: 'Black Pieces
CONST ColorW = 15: 'White Pieces
COLOR ColorBC, 0: PRINT "   a b c d e f g h"
FOR y = 8 TO 1 STEP -1
  COLOR ColorBC, 0
  PRINT CHR$(&H30 + y); " ";
  FOR x = 1 TO 8
    i = board(x, y)
    IF i < 0 THEN cc1% = ColorB ELSE cc1% = ColorW
    cc2% = 7 - ((((x MOD 2) XOR (y MOD 2)) <> 1) AND 5)
    COLOR cc1%, cc2%
    PRINT " "; MID$(" kQBNrpKRP", ABS(i) + 1, 1);
  NEXT x
  COLOR ColorBC, 0
  PRINT " "; CHR$(&H30 + y)
NEXT y
PRINT "   a b c d e f g h"
PRINT
COLOR 7, 0
PRINT #2, "  "; lo$
LINE INPUT "Press Enter null=continue else=stop"; s$
IF s$ <> "" THEN STOP
RETURN

DoIt2:
l$ = LCASE$(lo$)
IF LEFT$(l$, 1) = " " THEN RETURN
IF LEFT$(l$, 1) = "#" THEN
  FOR i = 1 TO 8: FOR j = 1 TO 8: board(i, j) = 0: NEXT j: NEXT i
  RETURN
END IF
IF LEFT$(l$, 2) = "t1" THEN
  t = LegalMove(MID$(l$, 4, 5))
  IF t <> VAL(MID$(l$, 10, 1)) THEN c$ = "*"
  RETURN
END IF
IF LEFT$(l$, 2) = "t2" THEN
  IF MID$(l$, 4, 1) = "w" THEN CC$ = "White" ELSE CC$ = "Black"
  IF MID$(l$, 6, 1) = "-" THEN
    IF NOT ExistsAValidMove(CC$) THEN c$ = "*"
  ELSE
    IF ExistsAValidMove(CC$) THEN c$ = "*"
  END IF
  RETURN
END IF
IF LEFT$(l$, 2) = "t3" THEN
  IF MID$(l$, 4, 1) = "w" THEN CC$ = "White" ELSE CC$ = "Black"
  IF IsInCheck(CC$) <> MID$(lo$, 6, 3) THEN c$ = "*"
  RETURN
END IF
i = INSTR("abcdefgh", MID$(l$, 1, 1))
j = VAL(MID$(l$, 2, 1))
IF MID$(l$, 4, 1) = "." THEN
  board(i, j) = 0
ELSE
  IF MID$(l$, 4, 1) = "w" THEN
    board(i, j) = INSTR("kqbnrpioa", MID$(l$, 5, 1))
  ELSE
    board(i, j) = -INSTR("kqbnrpioa", MID$(l$, 5, 1))
  END IF
END IF
RETURN

CheckIt:
IF LEN(l$) = 1 THEN RETURN
c$ = LEFT$(l$, 1)
IF c$ = " " THEN RETURN
IF c$ = "s" THEN
  IF LEFT$(l$, 2) = "s " THEN RETURN
  PRINT "Illegal stop"; : GOTO CheckFail
END IF
IF c$ = "#" THEN
  IF LEFT$(l$, 2) = "# " THEN RETURN
  PRINT "Illegal Clear-Board command"; : GOTO CheckFail
END IF
IF c$ = "t" THEN
  CountTests = CountTests + 1
  IF LEN(l$) < 5 THEN PRINT "Illegal Test"; : GOTO CheckFail
  SELECT CASE MID$(l$, 2, 1)
  CASE "1":
    IF MID$(l$, 3, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("abcdefgh", MID$(l$, 4, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("123456789", MID$(l$, 5, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 6, 1) <> "-" THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("abcdefgh", MID$(l$, 7, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("123456789", MID$(l$, 8, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 9, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("012", MID$(l$, 10, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 11, 1) = " " THEN RETURN
  CASE "2":
    IF MID$(l$, 3, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("bw", MID$(l$, 4, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 5, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 6, 3) = "-1 " OR MID$(l$, 6, 2) = "0 " THEN RETURN
  CASE "3":
    IF MID$(l$, 3, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("bw", MID$(l$, 4, 1)) = 0 THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 5, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(l$, 9, 1) <> " " THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF MID$(lo$, 6, 3) = "N--" THEN RETURN
    IF MID$(lo$, 6, 1) <> "-" THEN PRINT "Illegal Test"; : GOTO CheckFail
    IF INSTR("LS-", MID$(lo$, 7, 1)) > 0 THEN
      IF INSTR("RF-", MID$(lo$, 8, 1)) > 0 THEN RETURN
    END IF
  END SELECT
  PRINT "Illegal Test"; : GOTO CheckFail
  RETURN
END IF
IF INSTR("abcdefgh", c$) = 0 THEN PRINT "Unrecognized"; : GOTO CheckFail
IF INSTR("12345678", MID$(l$, 2, 1)) = 0 THEN PRINT "Illegal placement"; : GOTO CheckFail
IF MID$(l$, 3, 1) <> "=" THEN PRINT "Illegal placement"; : GOTO CheckFail
IF MID$(l$, 4, 2) <> ".." THEN
  IF INSTR("bw", MID$(l$, 4, 1)) = 0 THEN PRINT "Illegal placement"; : GOTO CheckFail
  IF INSTR("kqbnrpioa", MID$(l$, 5, 1)) = 0 THEN PRINT "Illegal placement"; : GOTO CheckFail
END IF
IF MID$(l$, 6, 1) <> " " THEN PRINT "Illegal placement"; : GOTO CheckFail
RETURN

CheckFail:
PRINT " line: ["; lo$; "]"
Errors = -1
RETURN

FUNCTION ExistsAValidMove% (c$)
 'this function is more complex than it needs to be in an effort to have a
 'function that executes fast. This function is optimized for execution speed,
 'but but at the expense of being more complex.

 'funtion determines if a there are any legal moves for the color

 DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER
 DIM i AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER
 DIM source AS INTEGER

 IF c$ = "White" THEN dir = 1 ELSE dir = -1     'direction/color indicator
 n = 0  'assume no legal moves
 FOR cx = 1 TO 8
  FOR cy = 1 TO 8
   source = board(cx, cy)
   IF SGN(source) = dir THEN    ' one of my pieces?
'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)
    SELECT CASE ABS(source)
    CASE 2, 3, 5, 8     'queen/bishop/rook make linear moves
     FOR i = 0 TO 7     'test each direction
      x = cx: y = cy
      ix = ((i + 2) MOD 3) - 1  'formulas for step values
      iy = ((i * 4) \ 10) - 1
      DO        'loop for test lines
       x = x + ix: y = y + iy   'increment
       IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO 'bounds
       SELECT CASE ABS(source)
       CASE 3: IF (x = cx) OR (y = cy) THEN EXIT DO     'diagnols only
       CASE 5, 8: IF (x <> cx) AND (y <> cy) THEN EXIT DO  'ranks/files only
       END SELECT
       IF dir = SGN(board(x, y)) THEN EXIT DO   'blocked by one's own
       GOSUB dotest: IF n THEN EXIT FOR
       IF board(x, y) THEN EXIT DO      'blocked
      LOOP
     NEXT i
    CASE 6, 9   'pawn
     y = cy + dir: x = cx: GOSUB dotest '1 step
     IF (cy = 2 + (5 AND (dir = -1))) AND (NOT n) THEN y = cy + (dir * 2): x = cx: GOSUB dotest '2 steps
     IF (cx > 1) AND (NOT n) THEN y = cy + dir: x = cx - 1: GOSUB dotest 'left capture
     IF (cx < 8) AND (NOT n) THEN y = cy + dir: x = cx + 1: GOSUB dotest 'right capture
    CASE 1, 7   'king
     FOR i = 0 TO 7     'test 1 step in each direction
      x = cx + ((i + 2) MOD 3) - 1      'formulas
      y = cy + ((i * 4) \ 10) - 1
      IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN   'bounds
       GOSUB dotest: IF n THEN EXIT FOR
      END IF
     NEXT i
     IF (ABS(source) = 1) AND (NOT n) THEN
      y = cy: x = cx - 2: GOSUB dotest  'queen's side castle
      IF NOT n THEN x = cx + 2: GOSUB dotest    'king's side castle
     END IF
    CASE 4      'knight
     FOR i = 0 TO 7     'test 8 "L" shaped moves
      x = cx + (((i + 1) MOD 2) + 1) * (1 OR (i < 4))   'formulas
      y = cy + ((i MOD 2) + 1) * (1 OR (i < 2) OR (i > 5))
      IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN   'bounds
       GOSUB dotest: IF n THEN EXIT FOR
      END IF
     NEXT i
    END SELECT
   END IF
   IF n THEN EXIT FOR
  NEXT cy
  IF n THEN EXIT FOR
 NEXT cx
 
 ExistsAValidMove% = n
EXIT FUNCTION

dotest:
 IF LegalMove%(CHR$(cx + &H60) + CHR$(cy + &H30) + "-" + CHR$(x + &H60) + CHR$(y + &H30)) = 2 THEN n = -1
RETURN
END FUNCTION

FUNCTION IsInCheck$ (c$)
 'tests whether the king is in check

 DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER
 DIM i AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER
 DIM t AS STRING * 3

 IF c$ = "White" THEN dir = 1 ELSE dir = -1
 cx = 666 'in case there is no king
 DO
  FOR x = 1 TO 8
   FOR y = 1 TO 8
    SELECT CASE dir * board(x, y)
    CASE 1, 7: cx = x: cy = y: EXIT DO  'find king
    END SELECT
   NEXT y
  NEXT x
 LOOP UNTIL -1 'this loop exists only for the convenient EXIT DO, cheap substitute for GOTO

 n = 0  'assume not in check
 IF cx <> 666 THEN      'king exists
  FOR i = 0 TO 7        'test each linear direction
   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        'this select case block accomplishes the same thing
   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   'loop to test the lines
    x = x + ix: y = y + iy      'increment
    IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO    'bounds

'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)
 
    SELECT CASE board(x, y) * dir       'what's there?
    CASE IS > 0, -4: EXIT DO    'blocked by one of mine, or enemy knight
    CASE -1, -7: IF (ABS(x - cx) > 1) OR (ABS(y - cy) > 1) THEN EXIT DO ELSE GOSUB orit
    CASE -2: GOSUB orit
    CASE -3: IF (x = cx) OR (y = cy) THEN EXIT DO ELSE GOSUB orit
    CASE -5, -8: IF (x <> cx) AND (y <> cy) THEN EXIT DO ELSE GOSUB orit
    CASE -6, -9: IF (ABS(x - cx) <> 1) OR ((y - cy) <> dir) THEN EXIT DO ELSE GOSUB orit
    END SELECT
   LOOP
  NEXT i
  FOR i = 0 TO 7        '"L" shaped knight moves
   '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        'does the same as formula
   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      'bounds
    IF board(x, y) * dir = -4 THEN n = n OR 1   'enemy knight?
   END IF
  NEXT i
 END IF
 t = "---"      'create string
 IF n AND 1 THEN MID$(t, 1, 1) = "N"
 IF n AND 2 THEN MID$(t, 2, 1) = "L"
 IF n AND 4 THEN MID$(t, 2, 1) = "S"
 IF n AND 8 THEN MID$(t, 3, 1) = "R"
 IF n AND 16 THEN MID$(t, 3, 1) = "F"
IsInCheck$ = t
EXIT FUNCTION

orit:
 SELECT CASE i
 CASE 3, 4: n = n OR 8  'rank
 CASE 2, 5: n = n OR 16 'file
 CASE 0, 7: IF (cx > 4) XOR (cy > 4) THEN n = n OR 2 ELSE n = n OR 4    '\
 CASE 1, 6: IF (cx > 4) XOR (cy > 4) THEN n = n OR 4 ELSE n = n OR 2    '/
 END SELECT
RETURN
END FUNCTION

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!
 'if blocked by one's own, returns 1
 'if blocked by enemy, and not blocked by one's own, returns 2
 'if not blocked, returns 0

 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)   'set direction of move
 cnt = ABS(dx - sx) OR ABS(dy - sy)     'counter
 x = sx: y = sy
 FOR i = 1 TO cnt - 1
  x = x + ix: y = y + iy        'increment
  IF board(x, y) THEN
   'sensitive to color, because of "illegal" vs. "not possible"
   IF which <> SGN(board(x, y)) THEN n = 2 ELSE n = 1: EXIT FOR
  END IF
 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  'assume not threatened
 FOR i = 0 TO 7  ' tests each linear direction
  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    'test the lines
   x = x + ix: y = y + iy       'increment
   IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO     'bounds
  
'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       'which array are we working with?
    b = board(x, y)
   ELSE
    b = vboard(x, y)
   END IF
   SELECT CASE b * dir  'what do we have?
   CASE IS > 0, -4: EXIT DO 'blocked by one of my own, or enemy knight
   CASE -1, -7: IF (ABS(x - cx) > 1) OR (ABS(y - cy) > 1) THEN EXIT DO ELSE n = -1: EXIT FOR
   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        'test "L" shaped directions
   '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      'bounds
    IF bi = 0 THEN      'which array are we working with?
     b = board(x, y)
    ELSE
     b = vboard(x, y)
    END IF
    IF (b * dir) = -4 THEN n = -1: EXIT FOR     'enemy knight?
   END IF
  NEXT i
 END IF
 isthreatened% = n
END FUNCTION

FUNCTION LegalMove% (movestr AS STRING)
 'format "a1-h8"
 'returns 0 if not possible, 1 if illegal, 2 if legal

 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 AS INTEGER, block AS INTEGER

 why = 2        'assume legal

 sx = ASC(LEFT$(movestr, 1)) - &H60     'get coordinates from string
 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) 'piece to move
 IF source = 0 THEN why = 1: GOTO outnow        'trying to move nothing?
 dir = SGN(source)      'note the color of the piece
 IF SGN(board(dx, dy)) = dir THEN why = 1: GOTO outnow 'taking one's own piece
 FOR x = 1 TO 8
  FOR y = 1 TO 8
   vboard(x, y) = board(x, y)   'update vboard
   SELECT CASE dir * board(x, y)
   CASE 1, 7: kx = x: ky = y    'find king
   END SELECT
   IF ABS(board(x, y)) = 9 THEN
    vboard(x, y) = SGN(board(x, y)) * 6 'pawns no longer subject to en passant
   END IF
  NEXT y
 NEXT x
 vboard(sx, sy) = 0     'remove piece from starting square in vboard
 SELECT CASE ABS(source)
 CASE 1 'king that hasn't moved
  IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN 'not a normal move
   IF sy <> dy THEN why = 1: GOTO outnow 'illegal
   SELECT CASE dx
   CASE 3       'queen's side castle
    IF ABS(board(1, sy)) <> 5 THEN why = 1: GOTO outnow 'need unmoved rook
    block = ispathblocked%(sx, sy, 1, dy, dir)
    IF block = 1 THEN why = 1: GOTO outnow      'path blocked
    IF isthreatened%(0, 4, sy, dir) THEN why = 0: GOTO outnow 'crossing threat
    IF block THEN why = 0: GOTO outnow  'path blocked
    vboard(1, sy) = 0: vboard(4, sy) = dir * 8  'move rook in vBoard
   CASE 7       'kings's side caslte
    IF ABS(board(8, sy)) <> 5 THEN why = 1: GOTO outnow 'need unmoved rook
    block = ispathblocked%(sx, sy, 8, dy, dir)
    IF block = 1 THEN why = 1: GOTO outnow      'path blocked
    IF isthreatened%(0, 6, sy, dir) THEN why = 0: GOTO outnow 'crossing threat
    IF block THEN why = 0: GOTO outnow  'path blocked
    vboard(8, sy) = 0: vboard(6, sy) = dir * 8  'move rook in vBoard
   CASE ELSE: why = 1: GOTO outnow      'illegal
   END SELECT
   IF isthreatened%(0, sx, sy, dir) THEN why = 0: GOTO outnow 'can't castle if checked
  END IF
  source = dir * 7      'king has moved
  kx = dx: ky = dy      'new location
 CASE 7 'king that has moved
  IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN why = 1: GOTO outnow 'one square only
  kx = dx: ky = dy      'new location
 CASE 2 'queen
  IF (sx <> dx) AND (sy <> dy) AND (ABS(sx - dx) <> ABS(sy - dy)) THEN why = 1: GOTO outnow
  block = ispathblocked%(sx, sy, dx, dy, dir)
  IF block = 1 THEN why = 1: GOTO outnow        'blocked by same
  IF block THEN why = 0: GOTO outnow    'blocked by enemy
 CASE 3 'bishop
  IF ABS(sx - dx) <> ABS(sy - dy) THEN why = 1: GOTO outnow
  block = ispathblocked%(sx, sy, dx, dy, dir)
  IF block = 1 THEN why = 1: GOTO outnow        'blocked by same
  IF block THEN why = 0: GOTO outnow    'blocked by enemy
 CASE 4 'knight
  IF ((ABS(sx - dx) + ABS(sy - dy)) <> 3) OR (sx = dx) OR (sy = dy) THEN why = 1: GOTO outnow
 CASE 5, 8 'rook
  IF (sx <> dx) AND (sy <> dy) THEN why = 1: GOTO outnow
  block = ispathblocked%(sx, sy, dx, dy, dir)
  IF block = 1 THEN why = 1: GOTO outnow        'blocked by same
  IF block THEN why = 0: GOTO outnow    'blocked by enemy
  source = dir * 8      'rook has moved
 CASE 6, 1 'pawn
  IF SGN(dy - sy) <> dir THEN why = 1: GOTO outnow      'direction
  IF sx = dx THEN       'non-diagnol move
   SELECT CASE ABS(dy - sy)
   CASE 2
    IF (sy <> (2 + (5 AND (dir = -1)))) THEN why = 1: GOTO outnow 'only on 1st move
    SELECT CASE SGN(board(sx, (3 + (3 AND (dir = -1))))) 'trying to jump something?
    CASE dir: why = 1: GOTO outnow
    CASE 0 - dir: why = 0: GOTO outnow
    END SELECT
    source = dir * 9    'pawn subject to en passent
   CASE 1: source = dir * 6 'pawn not subject to en passent
   CASE ELSE: why = 1: GOTO outnow      'illegal
   END SELECT
   IF board(dx, dy) THEN why = 0: GOTO outnow   'can't capture with forward move
  ELSE  'not same x
   IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) <> 1) THEN why = 1: GOTO outnow 'illegal
   IF board(dx, dy) = 0 THEN    'trying en passent
    IF (board(dx, sy) <> (-9 * dir)) THEN
     why = 0: GOTO outnow       'not possible
    ELSE
     vboard(dx, sy) = 0 'successful en passent
    END IF
   END IF
   source = dir * 6     'pawn not subject to en passent
  END IF
 END SELECT
 vboard(dx, dy) = source        'update vBoard
 IF isthreatened%(1, kx, ky, dir) THEN why = 0: GOTO outnow 'can't be in check

outnow:
 LegalMove% = why
END FUNCTION