xM4BAA

Note: This is xM4BAA.
The real driver for testing LegalMove is DM4BAA.
xM4BAA is just used for studying specific combinations.

DECLARE FUNCTION ExistsAValidMove% (c$)
DECLARE FUNCTION IsInCheck$ (c$)
DECLARE SUB SimShow (m$)
DECLARE SUB ShowBoard ()
DECLARE FUNCTION LegalMove% (Move AS STRING)
CLS : LOCATE 23, 1
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
'CONST Dull = -1' For dull display
CONST Dull = 0' For colorful display
'=============================================
DIM SHARED Board(8, 8) AS INTEGER' column, row
'1=K 2=Q 3=B 4=N 5=R 6=p (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)
'=============================================
DIM SHARED vBoard(8, 8) AS INTEGER
' If other parts of the system modify Board(),
' then vBoard must be also modified.
' contains result after a legal move
'=============================================
PRINT "Enter pieces like this: e2=K"
PRINT SPACE$(10); "KQBNRPIOA are the piece names"
PRINT SPACE$(10); "I means kIng that has moved"
PRINT SPACE$(10); "O means rOok that has moved"
PRINT SPACE$(10); "A means pAwn that can be taken en passent"
PRINT : PRINT "Enter null or space after the = to erase, like this: e2="
PRINT : PRINT "(Just press Enter when finished)"
PRINT : PRINT
INPUT "Press Enter to begin testing: ", x$
IF x$ <> "" THEN CLS : SYSTEM
1 :
DIM Entry AS STRING
DIM Mode AS INTEGER
DIM InLoop AS INTEGER
Mode = 1
DO
  CALL ShowBoard
  GOSUB PutEntry
LOOP WHILE Entry <> ""
Mode = 2
DO
  CALL ShowBoard
  GOSUB PutEntry
LOOP WHILE Entry <> ""
DO
  DO
    IF InLoop THEN
      LOCATE , , 1
      PRINT "Press N to test Next case";
      DO
        SLEEP: k$ = INKEY$
        IF k$ = CHR$(27) THEN CLS : SYSTEM
      LOOP WHILE UCASE$(k$) <> "N"
    ELSE
      InLoop = -1
    END IF
    CALL ShowBoard
    rrW$ = IsInCheck("White")
    rrB$ = IsInCheck("Black")
    IF ExistsAValidMove%("White") THEN vvW$ = "Yes" ELSE vvW$ = "No"
    IF ExistsAValidMove%("Black") THEN vvB$ = "Yes" ELSE vvB$ = "No"
    CALL ShowBoard
    PRINT
    PRINT "Value of IsInCheck White/Black: "; rrW$; "/"; rrB$
    PRINT "Exists a valid move White/Black: "; vvW$; "/"; vvB$
    PRINT "Enter move to test like this: e2-e4 ";
    PRINT "(Or enter ? to show the board again)"
    GOSUB GetMove
  LOOP WHILE Move$ = "?"
  IF Move$ = "" THEN EXIT DO
  rr$ = "Return from LegalMove: "
  SELECT CASE LegalMove(Move$)
  CASE 0: PRINT rr$; "Not possible"
  CASE 1: PRINT rr$; "Illegal (trying to trick opponent?)"
  CASE 2: PRINT rr$; "OK"
  CASE ELSE: PRINT rr$; "(Bug in LegalMove)"
  END SELECT
LOOP
PRINT : PRINT "Press any key except ESC to start all over"
SLEEP: IF INKEY$ <> CHR$(27) THEN RUN 1
CLS
SYSTEM

PutEntry:
PRINT : PRINT
IF Mode = 1 THEN PRINT "White";  ELSE PRINT "Black";
LINE INPUT " entry: ", Entry
IF Entry = "" THEN RETURN
Entry = LCASE$(Entry)
DIM zC AS INTEGER ' The col
DIM zR AS INTEGER ' The row
zC = INSTR("abcdefgh", MID$(Entry, 1, 1))
zR = INSTR("12345678", MID$(Entry, 2, 1))
IF zC = 0 THEN GOTO PutEntry
IF zR = 0 THEN GOTO PutEntry
IF MID$(Entry$, 3, 1) <> "=" THEN GOTO PutEntry
Entry = RTRIM$(Entry)
IF LEN(Entry$) = 3 THEN Board(zC, zR) = 0: RETURN
DIM zP AS INTEGER ' The piece
zP = INSTR("kqbnrpioa", MID$(Entry, 4, 1))
IF zP = 0 THEN GOTO PutEntry
SELECT CASE (Mode * 10) + zP
CASE 11: IF zC <> 5 OR zR <> 1 THEN zP = 7
CASE 15: IF NOT (zC = 1 OR zC = 8) OR zR <> 1 THEN zP = 8
CASE 21: IF zC <> 5 OR zR <> 8 THEN zP = 7
CASE 25:  IF NOT (zC = 1 OR zC = 8) OR zR <> 8 THEN zP = 8
END SELECT
IF Mode = 2 THEN zP = -zP
Board(zC, zR) = zP
RETURN

GetMove:
PRINT : LINE INPUT "Move: ", Move$
IF Move$ = "" THEN RETURN
IF Move$ = "?" THEN InLoop = 0: RETURN
Move$ = LCASE$(Move$)
IF LEN(Move$) <> 5 THEN GOTO GetMove
IF INSTR("abcdefgh", MID$(Move$, 1, 1)) = 0 THEN GOTO GetMove
IF INSTR("12345678", MID$(Move$, 2, 1)) = 0 THEN GOTO GetMove
IF MID$(Move$, 3, 1) <> "-" THEN GOTO GetMove
IF INSTR("abcdefgh", MID$(Move$, 4, 1)) = 0 THEN GOTO GetMove
IF INSTR("12345678", MID$(Move$, 5, 1)) = 0 THEN GOTO GetMove
RETURN

FUNCTION ExistsAValidMove% (c$)
SimShow "Simulating ExistsAValidMove"
SELECT CASE c$
CASE "White":
CASE "Black":
CASE ELSE: PRINT "Bug in calling program": STOP
END SELECT
PRINT "Does "; c$; " have any legal move?"
DO
  INPUT "yn: ", Ans$
  Ans$ = LCASE$(Ans$)
  IF Ans$ = "y" THEN ExistsAValidMove% = -1: EXIT FUNCTION
  IF Ans$ = "n" THEN ExistsAValidMove% = 0: EXIT FUNCTION
LOOP
END FUNCTION

FUNCTION IsInCheck$ (c$)
SimShow "Simulating IsInCheck"
SELECT CASE c$
CASE "White":
CASE "Black":
CASE ELSE: PRINT "Bug in calling program": STOP
END SELECT
PRINT "Is "; c$; " in check?"
DO
  INPUT "yn: ", Ans$
  Ans$ = LCASE$(Ans$)
  IF Ans$ = "y" THEN EXIT DO
  IF Ans$ = "n" THEN IsInCheck$ = "---": EXIT FUNCTION
LOOP
PRINT "Input three characters"
PRINT "   N-- = In check by a knight"
PRINT "   -L- = In check on the long diagonal"
PRINT "   -S- = In check on the short diagonal"
PRINT "   --R = In check on the rank"
PRINT "   --F = In check on the file"
PRINT "   -LF = (example multiple checks)"
DO
  LINE INPUT "???: "; Ans$
  IF LEN(Ans$) <> 3 THEN Ans$ = "???"
  Ans$ = UCASE$(Ans$)
  IF INSTR("N-", MID$(Ans$, 1, 1)) > 0 THEN
    IF INSTR("LS-", MID$(Ans$, 2, 1)) > 0 THEN
      IF INSTR("RF-", MID$(Ans$, 3, 1)) > 0 THEN
        IsInCheck$ = Ans$: EXIT FUNCTION
      END IF
    END IF
  END IF
LOOP
END FUNCTION

FUNCTION LegalMove% (Move AS STRING)
SimShow "Simulating LegalMove given " + Move
PRINT "Enter result:  0=Not possible 1=Illegal 2=Allowed. 012: ";
DO
  DO: k$ = INKEY$: LOOP WHILE k$ = ""
LOOP WHILE INSTR("012", k$) = 0
PRINT
LegalMove% = VAL(k$)
END FUNCTION

SUB ShowBoard
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
CLS
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF Dull THEN
      IF zP < 0 THEN zP = -zP: COLOR 0, 7
      IF zP = 0 THEN
        PRINT "-";
      ELSE
        PRINT MID$("KQBNRPkrp", zP, 1);
      END IF
      COLOR 7, 0: PRINT " ";
    ELSE
      COLOR 13 + SGN(zP) * 2, 7 - ((((zC MOD 2) XOR (zR MOD 2)) <> 0) AND 5)
      PRINT " "; MID$(" kQBNrPKRp", ABS(zP) + 1, 1);
    END IF
  NEXT zC
  IF Dull THEN
    PRINT zR
  ELSE
    COLOR 7, 0
    PRINT " "; CHR$(&H30 + zR)
  END IF
NEXT zR
IF NOT Dull THEN PRINT " ";
PRINT "a b c d e f g h"
END SUB

SUB SimShow (m$)
ShowBoard
p$ = "": GOSUB SlowMe
p$ = "": GOSUB SlowMe
p$ = STRING$(LEN(m$), "="): GOSUB SlowMe
p$ = m$: GOSUB SlowMe
p$ = STRING$(LEN(m$), "="): GOSUB SlowMe
EXIT SUB
SlowMe:
t = TIMER + .1: WHILE TIMER < t: WEND
PRINT p$
RETURN
END SUB