DM4BAB

CONST UseDefaults = 0: ' See Certification tests
CLS : LOCATE 23, 1
PRINT "DM4BAB-Make Move"
PRINT "---------------"
PRINT "This consists of 1) a driver which can be used to debug"
PRINT "MakeMove and 2) attendent simulated logic routines"
PRINT
'CONST Dull = -1' For dull display
CONST Dull = 0' For colorful display
DEFSTR A-Z ' Debugging
'=============================================
DIM SHARED Board(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)
'=============================================
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
Mode = 1
DO
  CALL ShowBoard("")
  GOSUB PutEntry
LOOP WHILE Entry <> ""
Mode = 2
DO
  CALL ShowBoard("")
  GOSUB PutEntry
LOOP WHILE Entry <> ""
DO
  IF c$ = "White" THEN c$ = "Black" ELSE c$ = "White"
  tt% = MakeMove(c$)
  PRINT : PRINT : PRINT "Test complete. Result was ";
  SELECT CASE tt%
  CASE 1: PRINT "1 - Made move"
  CASE 2: PRINT "2 - Will move later"
  CASE 3: PRINT "3 - Game Over"
  CASE ELSE: STOP
  END SELECT
LOOP WHILE tt% = 1
PRINT : PRINT "Press R to Re-start program, any other key to quit"
SLEEP: IF UCASE$(INKEY$) = "R" 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
  IF MID$(Entry, 4, 1) <> "0" THEN GOTO PutEntry
END IF
IF Mode = 2 THEN zP = -zP
Board(zC, zR) = zP
RETURN

SUB AnnounceMove (c$)
DIM Row AS INTEGER, Col AS INTEGER: 'Row/Col of pawn
DIM RowT AS INTEGER, ColT AS INTEGER: ' Row/Col of target
FOR Col = 1 TO 8
  FOR Row = 2 TO 7
      SELECT CASE Board(Col, Row)
      CASE 6: IF c$ = "White" THEN GOSUB WTest
      CASE -6: IF c$ = "Black" THEN GOSUB BTest
      END SELECT
  NEXT Row
NEXT Col
WindowSub c$ + " to move"
EXIT SUB
WTest:
IF Col = 1 THEN
  ColT = 2: RowT = Row + 1
  IF Board(ColT, RowT) < 0 THEN GOTO TryMove
  IF Board(ColT, Row) = -9 THEN GOTO TryMove
ELSEIF Col = 8 THEN
  ColT = 7: RowT = Row + 1
  IF Board(ColT, RowT) < 0 THEN GOTO TryMove
  IF Board(ColT, Row) = -9 THEN GOTO TryMove
ELSE
  ColT = Col - 1: RowT = Row + 1
  IF Board(ColT, RowT) < 0 THEN GOTO TryMove
  IF Board(ColT, Row) = -9 THEN GOTO TryMove
  ColT = Col + 1: RowT = Row + 1
  IF Board(ColT, RowT) < 0 THEN GOTO TryMove
  IF Board(ColT, Row) = -9 THEN GOTO TryMove
END IF
RETURN
BTest:
IF Col = 1 THEN
  ColT = 2: RowT = Row - 1
  IF Board(ColT, RowT) > 0 THEN GOTO TryMove
  IF Board(ColT, Row) = 9 THEN GOTO TryMove
ELSEIF Col = 8 THEN
  ColT = 7: RowT = Row - 1
  IF Board(ColT, RowT) > 0 THEN GOTO TryMove
  IF Board(ColT, Row) = 9 THEN GOTO TryMove
ELSE
  ColT = Col - 1: RowT = Row - 1
  IF Board(ColT, RowT) > 0 THEN GOTO TryMove
  IF Board(ColT, Row) = 9 THEN GOTO TryMove
  ColT = Col + 1: RowT = Row - 1
  IF Board(ColT, RowT) > 0 THEN GOTO TryMove
  IF Board(ColT, Row) = 9 THEN GOTO TryMove
END IF
RETURN
TryMove:
t$ = MID$("abcdefgh", Col, 1) + MID$("12345678", Row, 1) + "-"
t$ = t$ + MID$("abcdefgh", ColT, 1) + MID$("12345678", RowT, 1)
SELECT CASE LegalMove(t$)
CASE 0: RETURN
CASE 2:
  WindowSub c$ + " to move with possible pawn capture(s)"
CASE ELSE: STOP: 'bug
END SELECT
END SUB

SUB Cheat
DIM x AS INTEGER, y AS INTEGER, i AS INTEGER
CLS
CONST ColorBC = 7: 'Board Coordinate's 1-9, a-h
CONST ColorB = 16: 'Black Pieces
CONST ColorW = 15: 'White Pieces
COLOR ColorBC, 0: PRINT "   1 2 3 4 5 6 7 8"
FOR y = 1 TO 8
  COLOR ColorBC, 0
  PRINT MID$("abcdefgh", y, 1); " ";
  FOR x = 1 TO 8
    i = Board(y, x)
    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 " "; MID$("abcdefgh", y, 1)
NEXT y
PRINT "   1 2 3 4 5 6 7 8"
COLOR 7, 0: PRINT
LINE INPUT "Hit Enter"; e$
END SUB

FUNCTION DisplayBoard$ (Mode$)
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
SimShow "Simulating DisplayBoard"
SELECT CASE Mode$
CASE "W": GOSUB White: GOSUB GetMove
CASE "B": GOSUB Black: GOSUB GetMove
CASE "BW": GOSUB Both
CASE "w": GOSUB White
CASE "b": GOSUB Black
END SELECT
EXIT FUNCTION

Both:
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    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 " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "a b c d e f g h"
RETURN

White:
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF zP < 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      PRINT MID$("KQBNRPKRP", zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "a b c d e f g h"
RETURN

Black:
FOR zR = 1 TO 8
  FOR zC = 8 TO 1 STEP -1
    zP = Board(zC, zR)
    IF zP > 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      COLOR 0, 7
      PRINT MID$("KQBNRPKRP", -zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "h g f e d c b a"
RETURN

GetMove:
CALL ShowBoard("Sleep")
DO
  IF Mode$ = "B" THEN PRINT "Black";  ELSE PRINT "White";
  LINE INPUT "'s move: "; xxx$
  IF LCASE$(xxx$) = "break" THEN MacBreak% = -1
LOOP WHILE LCASE$(xxx$) = "break"
DisplayBoard$ = xxx$
IF xxx$ = "" THEN DisplayBoard$ = "Resign": RETURN
IF NOT (LEN(xxx$) = 5 AND MID$(xxx$, 3, 1) = "-") THEN
  INPUT "Really?"; r$
  IF UCASE$(r$) <> "Y" THEN GOTO GetMove ELSE RETURN
END IF
MacTemp LEFT$(xxx$, 2), zAH%, z18%
IF zAH% = 0 THEN GOTO MacGoof
SELECT CASE Board(zAH%, z18%)
CASE 0: GOTO MacGoof
CASE IS > 0: IF Mode$ = "B" THEN GOTO MacGoof
CASE IS < 0: IF Mode$ = "W" THEN GOTO MacGoof
END SELECT
MacTemp RIGHT$(xxx$, 2), yAH%, y18%
IF yAH% = 0 THEN GOTO MacGoof
IF MacBreak% THEN STOP
RETURN
MacGoof: PRINT "Try again, Mac": GOTO GetMove
END FUNCTION

FUNCTION ExistsAValidMove% (c$)
CALL ShowBoard("Sleep")
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 MacTemp (Code$, zAH%, z18%)
IF LEN(Code$) <> 2 THEN STOP
tAH% = INSTR("abcdefgh", LEFT$(Code$, 1))
zAH% = tAH%
IF tAH% = 0 THEN EXIT SUB
t18% = VAL(RIGHT$(Code$, 1))
z18% = t18%
IF t18% = 0 THEN zAH% = 0
END SUB

FUNCTION MakeMove% (c1$)
IF c1$ = "White" THEN
  FOR i% = 1 TO 8
    IF Board(i%, 4) = 9 THEN Board(i%, 4) = 6
  NEXT i%
ELSEIF c1$ = "Black" THEN
  FOR i% = 1 TO 8
    IF Board(i%, 5) = -9 THEN Board(i%, 5) = -6
  NEXT i%
ELSE
  STOP: 'Bug
END IF

GetMove2:
Move$ = DisplayBoard(LEFT$(c1$, 1))
IF MID$(Move$, 3, 1) <> "-" THEN
  WindowSub "Open"
  PRINT "What do you want to do? r=resign a=adjourn g=go back to board"
  DO
    LINE INPUT "r/a/g: ", Ans$: Ans$ = LCASE$(Ans$)
    IF INSTR("ragc", Ans$) > 0 THEN
      WindowSub "Close --"
      COLOR 7, 0: CLS
      IF Ans$ = "r" THEN
        PRINT "You elected to resign!"
        DO
          LINE INPUT "Is that correct? y/n: "; A$
          IF LCASE$(A$) = "y" THEN
            PRINT "OK - Let opponent confirm this"
            MakeMove% = 3: EXIT FUNCTION
          END IF
        LOOP WHILE LCASE$(A$) <> "n"
      END IF
      IF Ans$ = "a" THEN MakeMove% = 2: PRINT "Adjourned": EXIT FUNCTION
      IF Ans$ = "c" THEN Cheat
      COLOR 7, 1: CLS
      GOTO GetMove2
    END IF
  LOOP
END IF
IF NOT UseDefaults THEN
  SELECT CASE LegalMove(Move$)
  CASE 0: WindowSub "Not possible": GOTO GetMove2
  CASE 1: WindowSub "Illegal move": GOTO GetMove2
  CASE 2:
  CASE ELSE: STOP
  END SELECT
END IF

' Actually make the move on the board
zAH% = INSTR("abcdefgh", MID$(Move$, 1, 1))
z18% = VAL(MID$(Move$, 2, 1))
zPiece% = Board(zAH%, z18%)
Board(zAH%, z18%) = 0
yAH% = INSTR("abcdefgh", MID$(Move$, 4, 1))
y18% = VAL(MID$(Move$, 5, 1))
yPiece% = Board(yAH%, y18%)
' 123456 78 9
' kqbnrp kr p (kr moved, p can be taken en passent)
SELECT CASE ABS(zPiece%)
CASE 1: ' King moved
  IF zPiece% = 1 THEN Board(yAH%, y18%) = 7 ELSE Board(yAH%, y18%) = -7
  IF ABS(zAH% - yAH%) = 2 THEN
    IF yAH% = 3 THEN
      Board(1, y18%) = 0
      IF zPiece% = 1 THEN Board(4, 1) = 8 ELSE Board(4, 8) = -8
    ELSE
      Board(8, y18%) = 0
      IF zPiece% = 1 THEN Board(6, 1) = 8 ELSE Board(6, 8) = -8
    END IF
  END IF
CASE 2, 3, 4, 7, 8:
  Board(yAH%, y18%) = zPiece%
CASE 5:
  IF zPiece% = 5 THEN Board(yAH%, y18%) = 8 ELSE Board(yAH%, y18%) = -8
CASE 6:
  IF z18% - y18% = 2 THEN
    IF zPiece% = 6 THEN Board(yAH%, y18%) = 9 ELSE Board(yAH%, y18%) = -9
  ELSE
    Board(yAH%, y18%) = zPiece%
  END IF
CASE ELSE: STOP: ' bug
END SELECT

' Show board and comment
m$ = DisplayBoard(LCASE$(LEFT$(c1$, 1)))
SELECT CASE ABS(yPiece%)
CASE 0:
  IF (ABS(zPiece%) = 6) AND (zAH% <> yAH%) THEN
    IF (y18% = 3 AND Board(yAH%, 4) <> 0) THEN
      Board(yAH%, 4) = 0: WindowSub "Pawn gone" + "|" + STR$(yAH%) + STR$(4) + STR$(6)
    ELSEIF (y18% = 6 AND Board(yAH%, 5) <> 0) THEN
      Board(yAH%, 5) = 0: WindowSub "Pawn gone" + "|" + STR$(yAH%) + STR$(5) + STR$(-6)
    ELSE
      STOP: 'bug
    END IF
  ELSE
    WindowSub "Legal Move"
  END IF
CASE 2, 3, 4, 5, 8: WindowSub "Piece gone" + "|" + STR$(yAH%) + STR$(y18%) + STR$(yPiece%)
CASE 6, 9: WindowSub "Pawn gone" + "|" + STR$(yAH%) + STR$(y18%) + STR$(yPiece%)
CASE ELSE: STOP: 'bug
END SELECT

IF (zPiece% = 6 AND y18% = 8) OR (zPiece% = -6 AND y18% = 1) THEN
  WindowSub c1$ + " promotes"
  WindowSub "Open"
  DO
    LINE INPUT "Enter (QBNR) desired piece: "; p$
    IF LEN(p$) = 1 THEN p$ = LCASE$(p$) ELSE p$ = "x"
    temp% = 1 + INSTR("qbnr", p$)
  LOOP WHILE temp% < 2
  WindowSub "Close -c"
  IF temp% = 5 THEN temp% = 8
  IF zPiece% = -6 THEN temp% = -temp%
  Board(yAH%, y18%) = temp%
  m$ = DisplayBoard(LCASE$(LEFT$(c1$, 1)))
END IF

IF c1$ = "White" THEN c2$ = "Black" ELSE c2$ = "White"
IF UseDefaults THEN GOTO RetryThis
'  MakeMove cases:  1=Made move   2=Will move later   3=Game Over
IF NOT ExistsAValidMove%(c2$) THEN
  IF IsInCheck$(c2$) = "---" THEN
    WindowSub c2$ + " cannot move - stalemate!"
  ELSE
    WindowSub c2$ + " loses - checkmate!"
  END IF
  MakeMove% = 3: EXIT FUNCTION
END IF
Check$ = IsInCheck(c2$)
IF Check$ = "---" THEN GOTO RetryThis
IF MID$(Check$, 1, 1) = "N" THEN Comment$ = "by a Knight" ELSE Comment$ = ""
IF MID$(Check$, 2, 1) = "L" THEN
  IF Comment$ <> "" THEN Comment$ = Comment$ + " and "
  Comment$ = Comment$ + "on the long diagonal"
END IF
IF MID$(Check$, 2, 1) = "S" THEN
  IF Comment$ <> "" THEN Comment$ = Comment$ + " and "
  Comment$ = Comment$ + "on the short diagonal"
END IF
IF MID$(Check$, 3, 1) = "R" THEN
  IF Comment$ <> "" THEN Comment$ = Comment$ + " and "
  Comment$ = Comment$ + "on the rank"
END IF
IF MID$(Check$, 3, 1) = "F" THEN
  IF Comment$ <> "" THEN Comment$ = Comment$ + " and "
  Comment$ = Comment$ + "on the file"
END IF
WindowSub c2$ + " is in check " + Comment$

RetryThis:
CALL AnnounceMove(c2$) ' with pawn captures or not

MakeMove% = 1
END FUNCTION

SUB ShowBoard (DoDis$)
IF DoDis$ = "Sleep" THEN
  PRINT "Press key to show the full board (For DM4BAB debugging)"
  SLEEP
  FOR uR% = 1 TO 10000
    k$ = INKEY$: IF k$ = CHR$(27) THEN DoDat% = -1
  NEXT uR%
END IF

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"
IF DoDat% THEN STOP
END SUB

SUB SimShow (m$)
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

SUB WindowSub (msg$)
CONST ww = ">>(WindowSub would "
STATIC status AS INTEGER
SELECT CASE msg$
CASE "Close --": GOSUB CloseIt
CASE "Close w-": GOSUB CloseIt
CASE "Close -c": GOSUB CloseIt
CASE "Close wc": GOSUB CloseIt
CASE "Open":
  SimShow "Simulating WindowSub Open function"
  status = 1
CASE ELSE:
  IF status <> 0 THEN STOP: 'bug in program
  SimShow "Simulating WindowSub Quick-Print function"
  PRINT msg$
  PRINT ww; "wait for player to acknowledge"
  GOSUB MySleep
  PRINT ww; "clear the window"
END SELECT
EXIT SUB
CloseIt:
IF status <> 1 THEN STOP: 'bug in program
status = 0
IF MID$(msg$, 7, 1) = "w" THEN PRINT ww; "wait for player to acknowledge lines since Open)": GOSUB MySleep
IF MID$(msg$, 8, 1) = "c" THEN
  PRINT ww; "clear everything printed since Open)"
ELSE
  PRINT ww; "leave printed stuff in window until next call)"
END IF
RETURN
MySleep:
WHILE INKEY$ <> "": WEND: SLEEP
FOR uR% = 1 TO 10000
  k$ = INKEY$: IF k$ = "s" THEN STOP: EXIT FOR
NEXT uR%
RETURN
END SUB