DM3BB

CLS
PRINT "DM3BB-The Display Routines."
PRINT "---------------------------"
PRINT "This consists of 1) a driver which can be used to debug"
PRINT "the display routines and 2) actual display routines"
PRINT
' =============================================
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 WBoard(8, 8) AS INTEGER' column, row
DIM SHARED BBoard(8, 8) AS INTEGER' column, row
' Put pieces on the board for display
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
zR = 8
FOR zC = 1 TO 8
  board(zC, zR) = -VAL(MID$("54321345", zC, 1))
  board(zC, zR - 1) = -6
NEXT zC
zR = 1
FOR zC = 1 TO 8
  board(zC, zR) = VAL(MID$("54321345", zC, 1))
  board(zC, zR + 1) = 6
NEXT zC
LINE INPUT "Press Enter to test whole board as seen by White: "; e$
Move$ = DisplayBoard("BW-W")
LINE INPUT "Now press Enter to test whole board as seen by Black: "; e$
Move$ = DisplayBoard("BW-B")
LINE INPUT "Now press Enter to do tests: "; e$: CLS
PRINT "Test procedure:"
PRINT " - Make moves (any move is legal)"
PRINT " - Place an opponent piece at some point to see if it remains"
PRINT " - Finally, refuse to move by pressing Enter"
PRINT "": PRINT "You will test White, then Black"
LINE INPUT "Press Enter to continue: "; e$: CLS
DO: c$ = "W": GOSUB DoMove: LOOP WHILE Move$ <> ""
WindowSub "Now the same for Black"
DO: c$ = "B": GOSUB DoMove: LOOP WHILE Move$ <> ""

' ===================================
CLS
PRINT "Now for a quick test to ensure that"
PRINT " - King that has moved is handled correctly"
PRINT " - Rook that has moved is handled correctly"
PRINT " - Pawn that can be taken en passent is handled correctly"
LINE INPUT "Press Enter to continue: "; e$: CLS
FOR zR = 1 TO 8: FOR zC = 1 TO 8
    board(zC, zR) = 0: BBoard(zC, zR) = 0: WBoard(zC, zR) = 0
NEXT zC: NEXT zR
board(5, 1) = 7: board(5, 8) = -7' Place kings that have moved
board(1, 1) = 8: board(1, 8) = -8' Place rooks that have moved
board(3, 3) = 9: board(6, 6) = -9' Place pawns subject to en passent
DO: c$ = "W": GOSUB DoMove: LOOP WHILE Move$ <> ""
WindowSub "Now the same for Black"
DO: c$ = "B": GOSUB DoMove: LOOP WHILE Move$ <> ""

' ======
CLS
PRINT "Will now test WindowSub functions"
PRINT "1) You will see the Windowsub test case before WindowSub CLOSE"
PRINT "2) You press 'c' to continue with the CLOSE"
PRINT "3) You watch the results"
PRINT "   - If it supposed to wait, you should see a flashing cursor"
PRINT "     at the bottom left corner for two seconds"
PRINT "     Otherwise there should be no delay"
PRINT "   - If it supposed to clear the lower screen, the message"
PRINT "     should disappear"
PRINT "     Otherwise the original display should still be there"
PRINT "4) You press 'c' to continue to the next case to be tested."
PRINT
LINE INPUT "Press Enter to continue: "; e$: CLS
Move$ = DisplayBoard("BW-W")
WindowSub "Open"
PRINT "Testing Close --: No wait no clear"
GOSUB Pause: WindowSub "Close --": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close w-: Wait, no clear"
GOSUB Pause: WindowSub "Close w-": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close -c: No wait, clear window"
GOSUB Pause: WindowSub "Close -c": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close wc: Wait, Clear window"
GOSUB Pause: WindowSub "Close wc": GOSUB Pause
WindowSub "That's all the tests!"
CLS
SYSTEM

Pause:
WHILE INKEY$ <> "": WEND
DO
  k$ = UCASE$(INKEY$)
  IF k$ = "C" THEN RETURN
  IF k$ = "Q" THEN SYSTEM
  IF k$ = CHR$(27) THEN STOP
LOOP
RETURN

DoMove:
Move$ = DisplayBoard(LCASE$(c$))
WindowSub "Open"
IF c$ = "W" THEN
  PRINT : PRINT SPACE$(10); "White to move"
ELSE
  PRINT : PRINT SPACE$(10); "Black to move"
END IF
WindowSub "Close --"
Move$ = DisplayBoard(c$)
WindowSub "Move returned was [" + Move$ + "]"
Good1 = 1
IF INSTR("abcdefgh", MID$(Move$, 1, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 2, 1)) = 0 THEN Good1 = 0
IF MID$(Move$, 3, 1) <> "-" THEN Good1 = 0
IF INSTR("abcdefgh", MID$(Move$, 4, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 5, 1)) = 0 THEN Good1 = 0
IF Good1 = 0 THEN Move$ = ""
RETURN
' =============================================
DIM SHARED TM%, LM%: TM% = 2: LM% = 3
' =============================================
DTM:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00

' =============================================

SUB BOARDMAP (B$, OLDX%, OLDY%, x%, y%)
REM MAP BOUNDRIES
IF (x% - TM%) >= 0 AND (x% - TM%) < 16 AND y% >= LM% AND y% - LM% < 40 THEN
ELSE
B$ = "OUTOFBOUNDS"
END IF
END SUB

FUNCTION DisplayBoard$ (OrigMode$)
STATIC Blue AS INTEGER
IF NOT Blue OR LEN(OrigMode$) > 1 THEN COLOR 7, 1: CLS : Blue = -1
Mode$ = UCASE$(OrigMode$)
STATIC ToldPlayer AS INTEGER
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
GOSUB board
SELECT CASE OrigMode$
CASE "W": GOSUB tablepieces: GOSUB White: GOSUB GetMove
CASE "B": GOSUB tablepieces: GOSUB Black: GOSUB GetMove

CASE "BW-W", "BW-B"
GOSUB Both
COLOR 7, 1: LOCATE 22, 2: PRINT "";
CASE "w": GOSUB tablepieces: GOSUB White
CASE "b": GOSUB tablepieces: GOSUB Black
CASE ELSE: STOP: 'bug
END SELECT
EXIT FUNCTION

Both:
COLOR 0, 6

IF OrigMode$ = "BW-W" THEN
FOR zR = 8 TO 1 STEP -1
FOR zC = 1 TO 8
zP = board(zC, zR)
IF zP < 0 THEN zP = -zP: COLOR 0, 6 ELSE COLOR 7, 1
IF zP = 0 THEN
ELSE
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
END IF
NEXT zC
NEXT zR
ELSE
FOR zR = 1 TO 8 STEP 1
FOR zC = 8 TO 1 STEP -1
zP = board(zC, zR)
IF zP < 0 THEN zP = -zP: COLOR 0, 6 ELSE COLOR 7, 1
IF zP = 0 THEN
ELSE
LOCATE TM% - 1 + (0 * 2) + (zR * 2), 43 - (LM% - 3 + zC * 5 - 1)
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
END IF
NEXT zC
NEXT zR
END IF
COLOR 7, 1
RETURN

White:
COLOR 7, 1
FOR zR = 8 TO 1 STEP -1
FOR zC = 1 TO 8
zP = board(zC, zR)
IF zP > 0 THEN
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
ELSE
zP = WBoard(zC, zR): IF zP > 0 THEN STOP: 'bug
IF zP < 0 THEN
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
COLOR 0, 6
PRINT " " + MID$("KQBNRPKRP", -zP, 1) + " ";
COLOR 7, 1
END IF
END IF
NEXT zC
NEXT zR
COLOR 7, 1
RETURN

Black:
COLOR 0, 6
FOR zR = 1 TO 8
FOR zC = 8 TO 1 STEP -1
zP = board(zC, zR)
IF zP < 0 THEN
LOCATE TM% - 1 + (zR * 2), (LM% + 8 * 5) - (LM% - 3 + zC * 5 - 1), 1
PRINT " " + MID$("KQBNRPKRP", -zP, 1) + " ";
ELSE
zP = BBoard(zC, zR): IF zP < 0 THEN STOP: 'bug
IF zP > 0 THEN
LOCATE TM% - 1 + (zR * 2), (LM% + 8 * 5) - (LM% - 3 + zC * 5 - 1), 1
COLOR 7, 1
PRINT " " + MID$("KQBNRPKRP", zP, 1) + " ";
COLOR 0, 6
END IF
END IF
NEXT zC
NEXT zR
COLOR 7, 1
RETURN

GetMove:
textloc% = POS(1)
CALL KEYBOARD(B$, x%, y%, xxx$, Mode$, textloc%, board%())
IF B$ = CHR$(27) THEN xxx$ = "resign"
DisplayBoard$ = xxx$
RETURN

board:
LM% = 3: TM% = 3: LEVEL% = 1
LOCATE TM%, LM%, 0
FOR H = 1 TO 8
FOR J = 1 TO 2
FOR i = 1 TO 8
IF H / 2 = H \ 2 THEN
IF i / 2 = i \ 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
ELSE
IF i / 2 = i \ 2 THEN COLOR 7, 0 ELSE COLOR 0, 7
END IF
PRINT SPACE$(5);
NEXT i
IF H = 8 AND J = 2 THEN  ELSE PRINT : LOCATE , LM%
NEXT J
NEXT H
REM BORDER
COLOR 7, 0
LOCATE TM% - 1, LM% - 1
PRINT CHR$(218); STRING$(40, 196); CHR$(191)
LOCATE , LM% - 1
FOR i = 1 TO 17
PRINT CHR$(179)
LOCATE , LM% - 1
NEXT i
LOCATE TM%, LM% - 1
FOR i = 1 TO 17
LOCATE , 40 + LM%
PRINT CHR$(179)
NEXT i
LOCATE TM% - 2 + 18, LM% - 1
PRINT CHR$(192); STRING$(40, 196); CHR$(217)

REM NUMBERING
COLOR 7, 1
LOCATE TM% + 17, LM% + 2
IF Mode$ = "W" OR Mode$ = "BW-W" THEN
FOR i% = 1 TO 8
PRINT LCASE$(CHR$(64 + i%)) + SPACE$(4);
NEXT i%
ELSE
FOR i% = 1 TO 8
PRINT LCASE$(CHR$(73 - i%)) + SPACE$(4);
NEXT i%
END IF
LOCATE TM% + 1, 40 + LM% + 2
IF Mode$ = "W" OR Mode$ = "BW-W" THEN
FOR i% = 1 TO 8
PRINT CHR$(57 - i%);
LOCATE CSRLIN + 2, 40 + LM% + 2
NEXT i%
ELSE
FOR i% = 1 TO 8
PRINT CHR$(48 + i%);
LOCATE CSRLIN + 2, 40 + LM% + 2
NEXT i%
END IF
RETURN

tablepieces:
COLOR 7, 0
LOCATE 3, 50
PRINT CHR$(218); STRING$(25, 196); CHR$(191)
LOCATE , 50
FOR i% = 1 TO 3
PRINT CHR$(179) + SPACE$(25)
LOCATE , 50
NEXT i%
LOCATE 4, 50
FOR i% = 1 TO 3
LOCATE , 25 + 51
PRINT CHR$(179)
NEXT i%
LOCATE 7, 50
PRINT CHR$(192); STRING$(25, 196); CHR$(217)
IF Mode$ = "W" THEN COLOR 0, 6 ELSE COLOR 7, 1
A$ = "KQRBNP"
LOCATE 5, 52
FOR i% = 1 TO LEN(A$)
PRINT " " + MID$(A$, i%, 1) + " "; : LOCATE , POS(1) + 1
NEXT i%
COLOR 7, 1
LOCATE 9, 50: PRINT "Mouse Operation:";
LOCATE 11, 50: PRINT "Control an opponent piece by";
LOCATE 12, 50: PRINT "using Right-Click. Control";
LOCATE 13, 50: PRINT "your pieces with Left-Click.";
LOCATE 15, 50: PRINT "Options:";
CALL Options(1)
RETURN
END FUNCTION

SUB KEYBOARD (B$, x%, y%, xxx$, Mode$, textloc%, board%())
LOCATE , , 0
DO
EX% = 1: CALL MDRIVER(EX%, B$, x%, y%, Mode$, board%())
DO
B$ = INKEY$
EX% = 2: CALL MDRIVER(EX%, B$, x%, y%, Mode$, board%())
IF B$ = CHR$(27) THEN EXIT DO: REM RESIGN
IF B$ = "OUTOFBOUNDS" THEN B$ = ""
LOOP UNTIL B$ <> ""
EX% = -1: CALL MDRIVER(EX%, B$, x%, y%, Mode$, board%())
IF B$ = CHR$(27) AND MOVESTAT% <> 0 THEN x% = OLDX%: y% = OLDY%: GOSUB CANCELMOVE
IF B$ = "L-CLICK" THEN
CALL SNAPTOCENTER(x%, y%)
IF MOVESTAT% = 0 THEN
LOCATE x%, y%
OLDX% = x%: OLDY% = y%
Piece$ = CHR$(SCREEN(x%, y%))
IF Piece$ <> CHR$(32) THEN
COLORIT% = SCREEN(x%, y%, 1)
IF COLORIT% = 23 THEN
IF Mode$ = "B" THEN Piece$ = CHR$(32)
ELSEIF COLORIT% = 96 THEN
IF Mode$ = "W" THEN Piece$ = CHR$(32)
ELSE
STOP: 'bug: color other than 23 and 96
END IF
END IF
IF Piece$ = CHR$(32) THEN
B$ = "": REM DO OVER EMPTY SQUARE
ELSE
COLOR COLORIT% MOD 16 + 16, COLORIT% \ 16
PRINT Piece$;
COLOR 7, 1: B$ = ""
GOSUB COORDERNATES
CALL Options(2)
LOCATE 23, textloc%: PRINT OLDALPHA$ + OLDNUMBER$ + "-";
IF COLORIT% = 23 THEN MOVESTAT% = 1 ELSE MOVESTAT% = -1
END IF
ELSE
IF OLDX% = x% AND OLDY% = y% THEN
CALL Options(1)
GOSUB CANCELMOVE
ELSE
CALL Options(4)
GOSUB COORDERNATES
xxx$ = OLDALPHA$ + OLDNUMBER$ + "-" + NEWALPHA$ + NEWNUMBER$
LOCATE 23, textloc%: PRINT xxx$; : SLEEP 1
LOCATE OLDX%, OLDY% - 1: COLOR COLORIT% MOD 16, COLORIT% \ 16: PRINT " " + Piece$ + " ";
COLOR 7, 1
EXIT DO
END IF
END IF
END IF
IF B$ = CHR$(27) THEN EXIT DO
LOOP
LOCATE , , 1
EXIT SUB

COORDERNATES:
IF Mode$ = "B" THEN
OLDNUMBER$ = LTRIM$(STR$(1 + INT((OLDX% - TM% + 1) / 2.1)))
OLDALPHA$ = LCASE$(CHR$(72 - INT((OLDY% - LM% + 1) / 5.1)))
NEWNUMBER$ = LTRIM$(STR$(1 + INT((x% - TM% + 1) / 2.1)))
NEWALPHA$ = LCASE$(CHR$(72 - INT((y% - LM% + 1) / 5.1)))
ELSE
OLDNUMBER$ = LTRIM$(STR$(8 - INT((OLDX% - TM% + 1) / 2.1)))
OLDALPHA$ = LCASE$(CHR$(65 + INT((OLDY% - LM% + 1) / 5.1)))
NEWNUMBER$ = LTRIM$(STR$(8 - INT((x% - TM% + 1) / 2.1)))
NEWALPHA$ = LCASE$(CHR$(65 + INT((y% - LM% + 1) / 5.1)))
END IF
RETURN

CANCELMOVE:
LOCATE x%, y%
COLOR COLORIT% MOD 16, COLORIT% \ 16
PRINT Piece$;
COLOR 7, 1
MOVESTAT% = 0
IF B$ <> CHR$(27) THEN B$ = ""
LOCATE 23, textloc%: PRINT SPACE$(80 - POS(1));
RETURN
END SUB

SUB MDRIVER (EX%, B$, x%, y%, Mode$, board%())
STATIC MU$, PICKUPX%, PICKUPY%, Pickup$, OLDPIECE$, PICKUPCOLOR%, OLDPIECECOLOR%
IF B$ = CHR$(27) THEN
IF PICKUPX% <> 0 THEN LOCATE x%, y%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
PICKUPX% = 0: PICKUPY% = 0: Pickup$ = "": OLDPIECE$ = ""
END IF
OLDX% = x%: OLDY% = y%
REM INITIATE MOUSE
IF MU$ = "" THEN
GOSUB INIMOUSE
END IF
IF EX% = -1 THEN
REM HIDES MOUSE IF A KEY WAS PRESSED FOR NEXT MOUSE LOOP
AX% = 2: GOSUB CALLI
EX% = 2
EXIT SUB
END IF
IF EX% = 1 THEN AX% = 1: GOSUB CALLI
AX% = 3: GOSUB CALLI
LB% = (BX% AND 1) <> 0
RB% = (BX% AND 2) <> 0
REM A LEFT CLICK CANCELS PICKUP ROUTINE
IF LB% <> 0 AND PICKUPX% <> 0 THEN Pickup$ = "": RB% = 1
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
x% = dx% \ 8 + 1: y% = cx% \ 8 + 1
IF x% <> OLDX% OR y% <> OLDY% THEN
IF PICKUPX% = 0 THEN
CALL BOARDMAP(B$, OLDX%, OLDY%, x%, y%)
ELSE
GOSUB DRAG
END IF
END IF
REM MOUSE BUTTONS
IF RB% <> 0 THEN
IF PICKUPX% <> 0 THEN
LOCATE x%, y%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
CALL BOARDMAP(B$, OLDX%, OLDY%, x%, y%)
IF B$ <> "OUTOFBOUNDS" AND Pickup$ <> "" THEN
REM PIECE$ IS CANCELLED AND SET TO "" IF LEFT MOUSE IS CLICKED DURING DRAG.
CALL SNAPTOCENTER(x%, y%)
A% = SCREEN(x%, y%, 1)
IF Mode$ = "W" THEN
IF A% = 23 THEN EXIT SUB
ELSE
IF A% = 96 THEN EXIT SUB
END IF
CALL Recorder("Put", x%, y%, Pickup$, Mode$)
COLOR PICKUPCOLOR% MOD 16, PICKUPCOLOR% \ 16
LOCATE x%, y% - 1
PRINT " " + Pickup$ + " ";
END IF
COLOR 7, 1
CALL Options(1)
PICKUPX% = 0: PICKUPY% = 0: Pickup$ = "": OLDPIECE$ = "": OLDPIECECOLOR% = 0
B$ = ""
DO
AX% = 3: GOSUB CALLI
RB% = (BX% AND 2) <> 0
IF RB% = 0 THEN EXIT DO
LOOP
ELSE
DO
AX% = 3: GOSUB CALLI
RB% = (BX% AND 2) <> 0
IF RB% = 0 THEN EXIT DO
LOOP
REM BOUNDRIES
IF x% > 4 AND x% < 9 AND y% > 51 AND y% < 75 THEN TABLE% = 1
IF TABLE% = 0 AND PICKUPX% = 0 THEN
CALL BOARDMAP(B$, OLDX%, OLDY%, x%, y%)
IF B$ <> "OUTOFBOUNDS" THEN TABLE% = -1
END IF
IF TABLE% = -1 THEN
CALL SNAPTOCENTER(x%, y%)
AX% = 2: GOSUB CALLI
A% = SCREEN(x%, y%, 1)
AX% = 1: GOSUB CALLI
IF Mode$ = "W" THEN
IF A% <> 96 THEN TABLE% = 0
ELSE
IF A% <> 23 THEN TABLE% = 0
END IF
END IF
IF TABLE% <> 0 THEN
FOR i% = 1 TO 3
Pickup$ = CHR$(SCREEN(x%, y% - 2 + i%))
IF Pickup$ <> " " THEN EXIT FOR
NEXT i%
Pickup$ = RTRIM$(Pickup$)
CALL Recorder("Zap", x%, y%, Pickup$, Mode$)
IF Pickup$ <> "" THEN PICKUPX% = x%: PICKUPY% = y%
AX% = 2: GOSUB CALLI
PICKUPCOLOR% = (SCREEN(x%, y% - 2 + i%, 1))
IF TABLE% = -1 THEN
REM LIFT PIECE OFF BOARD
OLDPIECECOLOR% = (SCREEN(x% - 1, y%, 1))
COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: LOCATE x%, y% - 1: PRINT SPACE$(3);
AX% = 1: GOSUB CALLI
GOSUB DRAG
END IF
COLOR 7, 1
CALL Options(3)
AX% = 1: GOSUB CALLI
END IF
END IF
END IF
IF LB% <> 0 THEN
CALL BOARDMAP(B$, OLDX%, OLDY%, x%, y%)
REM PLACE OTHER MOUSE FEATURES HERE
IF B$ = "OUTOFBOUNDS" THEN B$ = "" ELSE B$ = "L-CLICK": REM LEFT MOUSE CLICK
END IF
REM DELAY TO SMOOTH THINGS OUT.
IF LB% <> 0 OR RB% <> 0 THEN
DO
AX% = 3: GOSUB CALLI
LB% = (BX% AND 1) <> 0
RB% = (BX% AND 2) <> 0
IF LB% = 0 AND RB% = 0 THEN EXIT DO
LOOP
END IF
EXIT SUB
REM SUBROUTINES
CALLI:
CALL ABSOLUTE(AX%, BX%, cx%, dx%, SADD(MU$))
RETURN

INIMOUSE:
MU$ = SPACE$(57)
FOR i% = 1 TO 57
READ A$
H$ = CHR$(VAL("&H" + A$))
MID$(MU$, i%, 1) = H$
NEXT i%
RETURN

DRAG:
AX% = 2: GOSUB CALLI
LOCATE OLDX%, OLDY%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
OLDPIECECOLOR% = SCREEN(x%, y%, 1)
OLDPIECE$ = CHR$(SCREEN(x%, y%))
COLOR 14, OLDPIECECOLOR% \ 16: LOCATE x%, y%: PRINT Pickup$;
OLDX% = x%: OLDY% = y%
AX% = 1: GOSUB CALLI
RETURN
END SUB

SUB Options (o%)
o$ = SPACE$(28)
SELECT CASE o%
CASE 1:
LSET o$ = "- Select Opponent Piece or": LOCATE 17, 50: PRINT o$;
LSET o$ = "- Select Your Own Piece or": LOCATE 18, 50: PRINT o$;
LSET o$ = "- Press ESC for more options": LOCATE 19, 50: PRINT o$;
CASE 2:
LSET o$ = "- Place Your Own Piece": LOCATE 17, 50: PRINT o$;
LSET o$ = "(Or Just Put It Back)": LOCATE 18, 50: PRINT o$;
LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE 3:
LSET o$ = "- Place Opponent Piece": LOCATE 17, 50: PRINT o$;
LSET o$ = "(Or Drop It Outside Board)": LOCATE 18, 50: PRINT o$;
LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE 4:
LSET o$ = "- ": LOCATE 17, 50: PRINT o$;
LSET o$ = "": LOCATE 18, 50: PRINT o$;
LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE ELSE:
STOP: 'bug
END SELECT
END SUB

SUB Recorder (cmd$, x%, y%, Pickup$, Mode$)
IF x% < 4 THEN EXIT SUB
IF x% > 18 THEN EXIT SUB
IF y% < 5 THEN EXIT SUB
IF y% > 40 THEN EXIT SUB
p% = INSTR("KQBNRP", Pickup$): IF p% = 0 THEN STOP: 'bug
r% = (x% / 2) - 1
c% = (y% / 5)
IF Mode$ = "W" THEN r% = 9 - r%
IF Mode$ = "B" THEN c% = 9 - c%
SELECT CASE cmd$
CASE "Put":
IF Mode$ = "W" THEN WBoard(c%, r%) = -p% ELSE BBoard(c%, r%) = p%
CASE "Zap":
IF Mode$ = "W" THEN
IF WBoard(c%, r%) <> -p% THEN STOP: 'bug
WBoard(c%, r%) = 0
ELSE
IF BBoard(c%, r%) <> p% THEN STOP: 'bug
BBoard(c%, r%) = 0
END IF
CASE ELSE: STOP: 'bug
END SELECT
END SUB

SUB RefereeSpeaks (Msg$)
PRINT Msg$
END SUB

SUB SNAPTOCENTER (x%, y%)
CNTY% = y% - LM%
y% = y% - (3 - (5 - CNTY% MOD 5))
IF x% \ 2 <> x% / 2 THEN x% = x% + 1
END SUB

SUB WindowSub (Msg$)
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":
VIEW PRINT 21 TO 25: CLS
status = 1
CASE ELSE:
IF status <> 0 THEN STOP: 'bug in program
VIEW PRINT 21 TO 25: CLS
RefereeSpeaks Msg$: GOSUB Waiter
CLS : VIEW PRINT
EXIT SUB
END SELECT
EXIT SUB

CloseIt:
IF status <> 1 THEN STOP: 'bug in program
status = 0
IF MID$(Msg$, 7, 1) = "w" THEN GOSUB Waiter
IF MID$(Msg$, 8, 1) = "c" THEN CLS
VIEW PRINT
RETURN

Waiter:
LOCATE 25, 1, 1: PRINT "";
SLEEP 2
FOR i = 1 TO 1000
k$ = INKEY$: IF k$ <> "" THEN EXIT FOR
NEXT i
IF k$ = "s" THEN STOP: 'debugging
IF k$ = "q" THEN SYSTEM
LOCATE 25, 1, 0: PRINT "";
RETURN
END SUB