DM4BAB

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

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
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% (c$)
'  MakeMove cases:  1=Made move   2=Will move later   3=Game Over
IF NOT ExistsAValidMove%(c$) THEN
  IF IsInCheck$(c$) = "---" THEN
    WindowSub c$ + " cannot move - stalemate!"
  ELSE
    WindowSub c$ + " loses - checkmate!"
  END IF
  MakeMove% = 3: EXIT FUNCTION
END IF
Check$ = IsInCheck(c$)
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 c$ + " is in check " + Comment$

RetryThis:
Move$ = DisplayBoard(LEFT$(c$, 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$)
    SELECT CASE Ans$
    CASE "g": GOTO RetryThis
    CASE "r":
      PRINT c$ + " resigns!"
      MakeMove% = 3: WindowSub "Close": EXIT FUNCTION
    CASE "a":
      MakeMove% = 2: WindowSub "Close": EXIT FUNCTION
    END SELECT
  LOOP
END IF
SELECT CASE LegalMove("e1-e2")
CASE 0: WindowSub "Not possible": GOTO RetryThis
CASE 1: WindowSub "Illegal move": GOTO RetryThis
CASE 2:
CASE ELSE: STOP
END SELECT
SimShow "Need to debug this: update BOARD with results of move"
MakeMove% = 1
END FUNCTION

SUB ShowBoard (DoDis$)
IF DoDis$ = "Sleep" THEN
  PRINT "Press key to re-show board"
  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