Updated Display Driver

1) Press Esc anytime to resign.
2) Right click sets opp. pieces to any free square or opp occupied square.
3) Now you can pick up and move 'dummy' pieces once they are placed on board.
4) To remove dummy pieces, pick it up, move it off the board and right click again. (Also, a left click will get rid of it, too.)
5) Display does not move piece anymore on left click, it just returns move$. (Display will need to be called agin to update board after legal move is evaluated.)
6) This update also works with left click as before.

------Very little debug time, let me know if you find anything that doesn't work right.

---------------------------------------------------------
DECLARE SUB SNAPTOCENTER (X%, Y%)
DECLARE SUB BOARDMAP (B$, OLDX%, OLDY%, X%, Y%)
DECLARE SUB KEYBOARD (B$, X%, Y%, xxx$, mode$, textloc%)
DECLARE SUB MDRIVER (EX%, B$, X%, Y%, mode$)
DECLARE FUNCTION DisplayBoard$ (mode$)
k3$ = "Driver for Kriegspiel Referee DisplayBoard Function"
'=============================================
DIM SHARED board(8, 8) AS INTEGER' column, row
DIM SHARED LM%, TM%
'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 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

TestID$ = "NORMAL (1-6) pieces"
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with TOTAL BOARD option"
MSG$ = "do test": GOSUB GetKey
move$ = DisplayBoard("BW")
MSG$ = "continue.": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with WHITE option"
MSG$ = "do test": GOSUB GetKey
move$ = DisplayBoard("W"): GOSUB EditMove
MSG$ = "continue. You returned move [" + move$ + "]": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with BLACK option"
MSG$ = "do test": GOSUB GetKey
move$ = DisplayBoard("B"): GOSUB EditMove
MSG$ = "continue. You returned move [" + move$ + "]": GOSUB GetKey

'===================================
FOR zR = 1 TO 8: FOR zC = 1 TO 8: board(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

TestID$ = "SPECIAL (7-9) pieces"
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with TOTAL BOARD option"
MSG$ = "do test": GOSUB GetKey
move$ = DisplayBoard("BW")
MSG$ = "continue.": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with WHITE option"
MSG$ = "do test": GOSUB GetKey
move$ = DisplayBoard("W"): GOSUB EditMove
MSG$ = "continue. You returned move [" + move$ + "]": GOSUB GetKey
'======
GOSUB NewScreen
PRINT "Testing DisplayBoard with BLACK option"
MSG$ = "do test": GOSUB GetKey: GOSUB EditMove
move$ = DisplayBoard("B")
MSG$ = "continue. You returned move [" + move$ + "]": GOSUB GetKey
'======
CLS
SYSTEM

NewScreen:
CLS : LOCATE 3, 13: PRINT k3$
LOCATE , 13: PRINT STRING$(LEN(k3$), "=")
LOCATE 7, 1: PRINT "You are now going to test "; TestID$
PRINT : PRINT
RETURN

GetKey:
LOCATE 25, 1, 1
PRINT "Press any key to "; MSG$; " ";
SLEEP: k$ = INKEY$
IF k$ = CHR$(27) THEN CLS : SYSTEM
RETURN

EditMove:
IF move$ = "resign" THEN RETURN
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$ = move$ + "] [*** BUG! ***"
RETURN

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$ (mode$)
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
COLOR 7, 1: CLS
SELECT CASE mode$
CASE "W": GOSUB board: GOSUB tablepieces: GOSUB White: GOSUB GetMove
CASE "B": GOSUB board: GOSUB tablepieces: GOSUB Black: GOSUB GetMove
CASE "BW": GOSUB board: GOSUB Both
END SELECT
EXIT FUNCTION

Both:
COLOR 0, 6
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
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 zP = 0
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
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 zP = 0
IF zP = 0 THEN
ELSE
LOCATE TM% - 1 + (zR * 2), (LM% + 8 * 5) - (LM% - 3 + zC * 5 - 1), 1
PRINT " " + MID$("KQBNRPKRP", -zP, 1) + " ";
END IF
NEXT zC
NEXT zR
COLOR 7, 1
RETURN

GetMove:
LOCATE 23, 1
IF mode$ = "B" THEN PRINT " Left Click Piece for Black's Move: "; ELSE PRINT " Left Click Piece for White's Move: ";
textloc% = POS(1)
LOCATE 25, 1: PRINT " Press [Esc] anytime to Resign.";
CALL KEYBOARD(B$, X%, Y%, xxx$, mode$, textloc%)
IF B$ = CHR$(27) THEN xxx$ = "resign"
DisplayBoard$ = xxx$
RETURN

board:
COLOR 7, 1: CLS
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" 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" 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:
GOSUB board
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 "Right Click to Select Piece";
RETURN

END FUNCTION

SUB KEYBOARD (B$, X%, Y%, xxx$, mode$, textloc%)
LOCATE , , 0
DO
EX% = 1: CALL MDRIVER(EX%, B$, X%, Y%, mode$)
DO
B$ = INKEY$
EX% = 2: CALL MDRIVER(EX%, B$, X%, Y%, mode$)
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$)

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
B$ = "": REM DO OVER EMPTY SQUARE
ELSE
COLORIT% = SCREEN(X%, Y%, 1)
COLOR COLORIT% MOD 16 + 16, COLORIT% \ 16
PRINT PIECE$;
COLOR 7, 1: B$ = ""
GOSUB COORDERNATES
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
GOSUB CANCELMOVE
ELSE
GOSUB COORDERNATES
xxx$ = OLDALPHA$ + OLDNUMBER$ + "-" + NEWALPHA$ + NEWNUMBER$
LOCATE 23, textloc%: PRINT xxx$;
''A% = SCREEN(OLDX% - 1, OLDY%, 1): COLOR A% MOD 16, A% \ 16
''LOCATE OLDX%, OLDY% - 1: PRINT SPACE$(3);
''LOCATE X%, Y% - 1: COLOR COLORIT% MOD 16, COLORIT% \ 16: PRINT " " + PIECE$ + " ";
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$)
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
COLOR PICKUPCOLOR% MOD 16, PICKUPCOLOR% \ 16
LOCATE X%, Y% - 1
PRINT " " + PICKUP$ + " ";
END IF
COLOR 7, 1
LOCATE 9, 50: PRINT "Right Click to Select Piece";
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$)
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
LOCATE 9, 50: PRINT "Right Click Square on Board ";
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 SNAPTOCENTER (X%, Y%)
CNTY% = Y% - LM%
Y% = Y% - (3 - (5 - CNTY% MOD 5))
IF X% \ 2 <> X% / 2 THEN X% = X% + 1
END SUB