Turn it sideways and shove it up your candy...

LOL - Not a big WWF fan but I couldn't resit the line. Anyway, the board can be turned sideways, although I don't like the display as well. Too difficult to center things with the limited vertical pixels.

You will need to check the 'dummy' arrays. It switches the position of the dummy pieces after a move rotation. I'm not sure how you assigned that array, so you will need to see if you can sort it out.

Here is the program. May need some debug work:

Pete

-------------------------------------------------

DECLARE SUB Introduction (n$, t%)
DECLARE SUB SecureReadAndDecrypt (Game$, zkey#, Pb#, pw#, Who%)
DECLARE SUB RefereeSpeaks (Msg$)
DECLARE SUB SecureEncryptAndWrite (Game$, zkey#, Pb#, pw#, Who%)
DECLARE SUB AnnounceMove (c$)
DECLARE SUB WindowSub (Msg$)
DECLARE FUNCTION Authorized% (c$, pw#)
DECLARE SUB BOARDMAP (b$, OLDX%, OLDY%, x%, y%)
DECLARE SUB Cheat ()
DECLARE FUNCTION DisplayBoard$ (OrigMode$)
DECLARE SUB KEYBOARD (b$, x%, y%, xxx$, Mode$, textloc%, opt1, board%())
DECLARE SUB Options (o%)
DECLARE FUNCTION GetInitialPassword# (c$)
DECLARE SUB IntroDualPrint (qi$)
DECLARE SUB IntroListFiles ()
DECLARE SUB IntroMenu (n$, t%)
DECLARE SUB MDRIVER (EX%, b$, x%, y%, Mode$, board%())
DECLARE SUB SNAPTOCENTER (x%, y%, Mode$, opt1)
DECLARE FUNCTION ksgDecrypt$ (k#, Encrypted$)
DECLARE FUNCTION ksgEncrypt$ (k#, Clear$)
DECLARE FUNCTION MakeMove% (c1$)
DECLARE SUB Recorder (cmd$, x%, y%, Pickup$, Mode$)
DECLARE FUNCTION NewGame$ ()
DECLARE FUNCTION ExistsAValidMove% (c$)
DECLARE FUNCTION IsInCheck$ (c$)
DECLARE FUNCTION ispathblocked% (sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER, which AS INTEGER)
DECLARE FUNCTION isthreatened% (bi AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER)
DECLARE FUNCTION LegalMove% (movestr AS STRING)
'=============================================
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
'Requested by LegalMove programmer for internal
'use. Not to be saved/restored/referenced elsewhere
'=============================================
DIM SHARED WBoard(8, 8) AS INTEGER
'Used to keep White's arbitrary placement of Black pieces
DIM SHARED BBoard(8, 8) AS INTEGER
'Used to keep Black's arbitrary placement of White pieces
'=============================================
DIM SecretKey AS DOUBLE: SecretKey = Getkey
' This is used to encrypt the game between play sessions
'=============================================
'========================================================
CONST GameMax = 52: ' Max number of saved games supported
DIM SHARED MenuOption(GameMax + 4) AS STRING
'========================================================
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
'=============================================

DIM PasswordB AS DOUBLE
DIM PasswordW AS DOUBLE
DIM WhoseTurn AS INTEGER
DIM GameName AS STRING, GameType AS INTEGER
CALL Introduction(GameName, GameType)
SELECT CASE GameType
CASE 1: 'Existing game
CALL SecureReadAndDecrypt(GameName, SecretKey, PasswordB, PasswordW, WhoseTurn)
CASE 2: 'New game
IF GameName = "" THEN RUN
GOSUB InitNewGame: GOSUB SaveGame
CASE 3: 'Exit
CLS : SYSTEM
END SELECT
DIM SHARED RefLog AS STRING: RefLog = GameName + ".log"
DO
' MakeMove cases: 1=Made move 2=Will move later 3=Game Over
SELECT CASE WhoseTurn
' WhoseTurn=0=Need PasswordB 1=NeedPassW
' 2=White's move 3=Black's move
' 4=Black needs to acknowledge game over
' 5=White needs to acknowledge game over
' 6=Game Over
CASE 0:
PasswordB = GetInitialPassword("Black")
IF PasswordB = 0 THEN CLS : SYSTEM
WhoseTurn = 1: GOSUB SaveGame
CASE 1:
PasswordW = GetInitialPassword("White")
IF PasswordW = 0 THEN CLS : SYSTEM
WhoseTurn = 2: GOSUB SaveGame
NewPassword% = -1
CASE 2:
IF NewPassword% THEN
NewPassword% = 0
ELSE
IF NOT PasswordW THEN
IF NOT Authorized("White", PasswordW) THEN EXIT DO
CALL RefereeSpeaks("Recall")
END IF
END IF
SELECT CASE MakeMove("White")
CASE 1: WhoseTurn = 3: ' Made move
CASE 2: EXIT DO: ' Will move later
CASE 3: WhoseTurn = 4: GOSUB SaveGame
END SELECT
CASE 3:
IF NOT PasswordB THEN
IF NOT Authorized("Black", PasswordB) THEN EXIT DO
CALL RefereeSpeaks("Recall")
END IF
SELECT CASE MakeMove("Black")
CASE 1: WhoseTurn = 2: ' Made move
CASE 2: EXIT DO: ' Will move later
CASE 3: WhoseTurn = 5: GOSUB SaveGame
END SELECT
CASE 4:
IF NOT PasswordB THEN
IF NOT Authorized("Black", PasswordB) THEN EXIT DO
END IF
WhoseTurn = 6: GOSUB SaveGame
CLS
CASE 5:
IF NOT PasswordW THEN
IF NOT Authorized("White", PasswordW) THEN EXIT DO
END IF
WhoseTurn = 6: GOSUB SaveGame
CLS
CASE 6:
k$ = DisplayBoard("BW")
LOCATE 23, 1
SYSTEM
END SELECT
LOOP
GOSUB SaveGame
SYSTEM

SaveGame:
CALL SecureEncryptAndWrite(GameName, SecretKey, PasswordB, PasswordW, WhoseTurn)
RETURN

InitNewGame:
PasswordW = 0: PasswordB = 0
WhoseTurn = 0
DIM zRow AS INTEGER, zCol AS INTEGER
Stuff$ = "54321345": zRow = 1: GOSUB W1: zRow = 8: GOSUB B1
Stuff$ = "66666666": zRow = 2: GOSUB W1: zRow = 7: GOSUB B1
RETURN
W1:
FOR zCol = 1 TO 8
board(zCol, zRow) = VAL(MID$(Stuff$, zCol, 1))
NEXT zCol
RETURN
B1:
FOR zCol = 1 TO 8
board(zCol, zRow) = -VAL(MID$(Stuff$, zCol, 1))
NEXT zCol
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

FUNCTION Authorized% (c$, pw#)
LOCATE 25, 1: PRINT "Enter password for " + c$;
LINE INPUT ": "; pw$
IF ASC(LEFT$(pw$ + CHR$(0), 1)) = pw# THEN
Authorized% = -1
ELSE
CLS : PRINT "Not Authorized": Authorized% = 0
END IF
END FUNCTION

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

SUB Cheat
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$ (OrigMode$)
STATIC Blue AS INTEGER
IF NOT Blue 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": GOSUB Both
CASE "w": GOSUB tablepieces: GOSUB White
CASE "b": GOSUB tablepieces: GOSUB Black
CASE ELSE: STOP: 'bug
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
LOCATE TM% + zC * 2 - 2, zR * 5 - 2
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
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
LOCATE TM% + zC * 2 - 2, zR * 5 - 2
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
LOCATE TM% + zC * 2 - 2, zR * 5 - 2
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% + zC * 2 - 2, zR * 5
PRINT " " + MID$("KQBNRPKRP", -zP, 1) + " ";
ELSE
zP = BBoard(zC, zR): IF zP < 0 THEN STOP: 'bug
IF zP > 0 THEN
LOCATE TM% + zC * 2 - 2, zR * 5
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%, opt1, 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 7, 0 ELSE COLOR 0, 7
ELSE
IF i / 2 = i \ 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
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
FOR i% = 1 TO 8
PRINT LCASE$(CHR$(48 + i%)) + SPACE$(4);
NEXT i%
LOCATE TM%, 40 + LM% + 2
FOR i% = 1 TO 8
PRINT CHR$(96 + i%);
LOCATE CSRLIN + 2, 40 + LM% + 2
NEXT i%
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

FUNCTION ExistsAValidMove% (c$)
'this function is more complex than it needs to be in an effort to have a
'function that executes fast. This function is optimized for execution speed,
'but but at the expense of being more complex.

'funtion determines if a there are any legal moves for the color

DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER
DIM i AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER
DIM source AS INTEGER

IF c$ = "White" THEN dir = 1 ELSE dir = -1 'direction/color indicator
n = 0 'assume no legal moves
FOR cx = 1 TO 8
FOR cy = 1 TO 8
source = board(cx, cy)
IF SGN(source) = dir THEN ' one of my pieces?
'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)
SELECT CASE ABS(source)
CASE 2, 3, 5, 8 'queen/bishop/rook make linear moves
FOR i = 0 TO 7 'test each direction
x = cx: y = cy
ix = ((i + 2) MOD 3) - 1 'formulas for step values
iy = ((i * 4) \ 10) - 1
DO 'loop for test lines
x = x + ix: y = y + iy 'increment
IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO 'bounds
SELECT CASE ABS(source)
CASE 3: IF (x = cx) OR (y = cy) THEN EXIT DO 'diagnols only
CASE 5, 8: IF (x <> cx) AND (y <> cy) THEN EXIT DO 'ranks/files only
END SELECT
IF dir = SGN(board(x, y)) THEN EXIT DO 'blocked by one's own
GOSUB dotest: IF n THEN EXIT FOR
IF board(x, y) THEN EXIT DO 'blocked
LOOP
NEXT i
CASE 6, 9 'pawn
y = cy + dir: x = cx: GOSUB dotest '1 step
IF (cy = 2 + (5 AND (dir = -1))) AND (NOT n) THEN y = cy + (dir * 2): x = cx: GOSUB dotest '2 steps
IF (cx > 1) AND (NOT n) THEN y = cy + dir: x = cx - 1: GOSUB dotest 'left capture
IF (cx < 8) AND (NOT n) THEN y = cy + dir: x = cx + 1: GOSUB dotest 'right capture
CASE 1, 7 'king
FOR i = 0 TO 7 'test 1 step in each direction
x = cx + ((i + 2) MOD 3) - 1 'formulas
y = cy + ((i * 4) \ 10) - 1
IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN 'bounds
GOSUB dotest: IF n THEN EXIT FOR
END IF
NEXT i
IF (ABS(source) = 1) AND (NOT n) THEN
y = cy: x = cx - 2: GOSUB dotest 'queen's side castle
IF NOT n THEN x = cx + 2: GOSUB dotest 'king's side castle
END IF
CASE 4 'knight
FOR i = 0 TO 7 'test 8 "L" shaped moves
x = cx + (((i + 1) MOD 2) + 1) * (1 OR (i < 4)) 'formulas
y = cy + ((i MOD 2) + 1) * (1 OR (i < 2) OR (i > 5))
IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN 'bounds
GOSUB dotest: IF n THEN EXIT FOR
END IF
NEXT i
END SELECT
END IF
IF n THEN EXIT FOR
NEXT cy
IF n THEN EXIT FOR
NEXT cx

ExistsAValidMove% = n
EXIT FUNCTION

dotest:
IF LegalMove%(CHR$(cx + &H60) + CHR$(cy + &H30) + "-" + CHR$(x + &H60) + CHR$(y + &H30)) = 2 THEN n = -1
RETURN
END FUNCTION

FUNCTION GetInitialPassword# (c$)
PRINT "Simulating getting initial password for " + c$
PRINT "(Just press Enter if you are not that player)"
LINE INPUT "Password: "; p$
IF p$ = "" THEN
GetInitialPassword# = 0
ELSEIF p$ = c$ THEN
GetInitialPassword# = -1
ELSE
GetInitialPassword# = ASC(LEFT$(p$, 1))
END IF
END FUNCTION

SUB IntroDualPrint (qi$)
FOR x = 1 TO 80
LOCATE , x
COLOR INSTR("B2c456W", MID$(qi$, x + 80, 1)), INSTR("B2c456W", MID$(qi$, x, 1))
PRINT CHR$(220);
NEXT x
LOCATE CSRLIN, 1
END SUB

SUB Introduction (n$, t%)
CLS
qi$ = "................................................................................"
qi$ = qi$ + "..........WWWWWWW......................................WW.......................": CALL IntroDualPrint(qi$)
qi$ = "........WWcBBBBBBWW................................WW.WcBW......................"
qi$ = qi$ + "......WWcBBcccccccBWW.............................WcBWcBcWB.....................": CALL IntroDualPrint(qi$)
qi$ = ".....WcBBcccccccccccBW............................WWccBcWcB....................."
qi$ = qi$ + ".....WBccccccccccccccWB............................BWccccW......................": CALL IntroDualPrint(qi$)
qi$ = "....WcBcccccccccccccccW............................WcBcWccW....................."
qi$ = qi$ + "....WBccccccccccccccccWB.......................WWWWWBcWcWWcB....................": CALL IntroDualPrint(qi$)
qi$ = "....WBccccccccccccccccWB......................WcBBBBWWcB.BB....................."
qi$ = qi$ + ".....WcccccccccccccccWcB.....................WcBcccccWB.........................": CALL IntroDualPrint(qi$)
qi$ = ".....WBccccccccccccccWWWWWWWWW..............WcBcccccccW........................."
qi$ = qi$ + "......WWcccccccccccWWcBBBBBBBBWW............WBccccccccWB........................": CALL IntroDualPrint(qi$)
qi$ = ".......BWWcccccccWWcBBcccccccccWB...........WBccccccccWB........................"
qi$ = qi$ + "........WWWWWWWWWcBBcccccccWWWWcB............WcccccccWcB........................": CALL IntroDualPrint(qi$)
qi$ = "......WWcBBBBBBBBBcccccccWWcBBBB.............WWcccccWcB........................."
qi$ = qi$ + "....WWcBBcccccccccccccWWWcBB................WcBWWWWWcB..........................": CALL IntroDualPrint(qi$)
qi$ = "..WWcBBccccccccccccWWWcBBB.................WcBccWBBBB..........................."
qi$ = qi$ + ".WcBBccccccccccWWWWcBWB...................WcBcccWB..............................": CALL IntroDualPrint(qi$)
qi$ = ".WBcccccWWWWWWWcBBBBcWB..................WcBcccWcB.............................."
qi$ = qi$ + "..WWWWWWcBBBBWBBccccccW.................WcBccccWB...............................": CALL IntroDualPrint(qi$)
qi$ = "...BBBBBB....WBcccccccWB...............WcBccccWcB..............................."
qi$ = qi$ + "..............WccccccccW..............WcBcccccWB................................": CALL IntroDualPrint(qi$)
qi$ = "..............WBccccccccW............WcBcccccWcB................................"
qi$ = qi$ + "..............WBccccccccWB.......WWWWWWccccccWB.................................": CALL IntroDualPrint(qi$)
qi$ = "..............WBcccccccccW......WcBBBBBWWcccWcB................................."
qi$ = qi$ + "...............WcccccccccWB....WWBccccccBWWcWB...WWWWWWWWWWWWWWWWWWWWWWWWWWWWW..": CALL IntroDualPrint(qi$)
qi$ = "...............WBcccccccccW.....BWWcccccccBWcB...WcccccccccccccccccccccccccccWB."
qi$ = qi$ + "...............WBccccccccccW......BWWccccccWB....WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "...............WBccccccccccWB.......BWWcccccW....WcccccccccccccccccccccccccccWB."
qi$ = qi$ + "................WcccccccccccW.........BWWcccWB...WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "................WBccccccccccWB..........BWWcWB...WcccccccccccccccccccccccccccWB."
qi$ = qi$ + "................WBcccccccccccW............BWcB...WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "................WBccccccccccccWW............B....WcccccccccccccccccccccccccccWB."
qi$ = qi$ + ".................WcccccccccccccBW................WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = ".................WBccccccccccccccW...............WcccccccccccccccccccccccccccWB."
qi$ = qi$ + ".................WBcccccccccccWWWcWW.............WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = ".................WBccccccWWWWWcBBBcBW............WcccccccccccccccccccccccccccWB."
qi$ = qi$ + ".................WBcWWWWWcBBBBBccccccWW..........WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "................WWWWcBBBBBccccccccccccBWWW.......WcccccccccccccccccccccccccccWB."
qi$ = qi$ + "................WBBBBcccccccccccccccccccBBWW.....WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "................WBcccccccccccccccccccccccccWW....WcccccccccccccccccccccccccccWB."
qi$ = qi$ + "................WBccccccccccccccccccccWWWWWcBB...WcccccccccccccccccccccccccccWB.": CALL IntroDualPrint(qi$)
qi$ = "...............WcBccccccccccccccccWWWWcBBBBB.....WWWWWWWWWWWWWWWWWWWWWWWWWWWWWB."
qi$ = qi$ + "...............WBccccccccccccWWWWWcBBBB...........BBBBBBBBBBBBBBBBBBBBBBBBBBBBB.": CALL IntroDualPrint(qi$)
qi$ = "..............WcBcccccccWWWWWcBBBBB............................................."
qi$ = qi$ + ".............WcBccccWWWWcBBBBB..................................................": CALL IntroDualPrint(qi$)
qi$ = "............WcBWWWWWcBBBB......................................................."
qi$ = qi$ + "............WWWcBBBBB...........................................................": CALL IntroDualPrint(qi$)
qi$ = ".............BBB................................................................"
LOCATE 15, 51: COLOR 7, 3: PRINT STRING$(27, 220) 'designed for chr$(196), eh.
LOCATE 14, 52: COLOR 0, 3: PRINT "Kriegspiel Referee - Menu"
COLOR 7, 0
CALL IntroListFiles
CALL IntroMenu(n$, t%)
END SUB

SUB IntroListFiles
SHELL "dir *.ksg /b /on > ksgtemp.txt" ' dir one line format sort by name to...
MenuCount = 1: MenuOption(MenuCount) = "New Game"
OPEN "ksgtemp.txt" FOR INPUT AS #1
DO
IF EOF(1) THEN EXIT DO
LINE INPUT #1, q$:
IF LTRIM$(q$) <> "" THEN
q$ = RTRIM$(q$)
'no .ksg, all lower but cap first letter
IF LEN(q$) > 4 THEN
q$ = LEFT$(LCASE$(q$), LEN(q$) - 4)
MID$(q$, 1, 1) = UCASE$(LEFT$(q$, 1))
END IF
MenuCount = MenuCount + 1: MenuOption(MenuCount) = q$
IF MenuCount > GameMax + 1 THEN EXIT DO
END IF
LOOP
CLOSE
KILL "ksgtemp.txt"
IF MenuCount > GameMax + 1 THEN
CLS : PRINT "Sorry, you have too many saved games."
PRINT "Erase some and try again."
SYSTEM
END IF
MenuCount = MenuCount + 1: MenuOption(MenuCount) = "Quit"
MenuCount = MenuCount + 1: MenuOption(MenuCount) = ""'make sure it's empty
IF MenuCount > GameMax + 2 THEN MenuOption(1) = "Quit (Can't start New)"
END SUB

SUB IntroMenu (n$, t%)
' 'run this after you create the background intro screen.
' 'this returns the variable Typed which is=-1 for ESC, or selected 1 to [etc.]
ShowOddMenuLegend = 1 'i like it. if you hate it, turn it off :)
' last option must be empty...
FinalOptionSameAsEscKey = 1 'set to 0 if you don't want last option to Quit
' count menu options
numenuopts = -1
DO
numenuopts = numenuopts + 1
LOOP UNTIL MenuOption(numenuopts + 1) = ""
' the big messy loop that does everything :(
' ...but i'm still very fond of it ;)
Typed = 1
DO
menulegend$ = SPACE$(6)
IF numenuopts > 1 THEN
SELECT CASE Typed
CASE IS = 1
menulegend$ = CHR$(32) + CHR$(25) + CHR$(32) + CHR$(25) + CHR$(32) + CHR$(25)
CASE IS = numenuopts
menulegend$ = CHR$(24) + CHR$(32) + CHR$(24) + CHR$(32) + CHR$(24) + CHR$(32)
CASE ELSE
menulegend$ = CHR$(24) + CHR$(32) + CHR$(24) + CHR$(25) + CHR$(32) + CHR$(25)
END SELECT
END IF
IF wheretohlight = 0 THEN wheretohlight = 1
menuline = 0
' display up and down arrows
IF ShowOddMenuLegend <> 0 THEN
COLOR 7, 1
FOR menulegendy = 16 TO 21
LOCATE menulegendy, 77
PRINT MID$(menulegend$, menulegendy - 15, 1)
NEXT menulegendy
END IF
' type and highlight menu
DO
menuline = menuline + 1: IF dispstart < 1 THEN dispstart = 1
LOCATE menuline + 15, 51: htemp$ = MenuOption(menuline + dispstart - 1)
IF menuline = wheretohlight THEN COLOR 3, 0 ELSE COLOR 0, 3
PRINT LEFT$(htemp$ + SPACE$(27), 27 - SGN(ABS(ShowOddMenuLegend)))
LOOP UNTIL menuline >= 6 OR menuline + dispstart - 1 >= numenuopts
' arrow key handler designed to work in QB and FB without modification
' note: rest of routine NOT tested in FB... but should avoid chr$(0) problem.
DO: keyput$ = INKEY$: LOOP UNTIL keyput$ <> "" 'simulate input$(1) with inkey$
IF LEN(keyput$) > 1 THEN MID$(keyput$, 1, 1) = CHR$(255)
IF INSTR("234567890", keyput$) AND numenuopts = 1 THEN keyput$ = "ab" 'fixed
SELECT CASE LCASE$(keyput$)
CASE CHR$(255) + "h", CHR$(255) + "k", CHR$(255) + "i" 'up (also left or pgup)
IF wheretohlight > 1 THEN
wheretohlight = wheretohlight - 1
ELSE
IF dispstart > 1 THEN dispstart = dispstart - 1
END IF
Typed = dispstart + wheretohlight - 1
CASE CHR$(255) + "p", CHR$(255) + "m", CHR$(255) + "q" 'down (also rt or pgdn)
IF Typed < numenuopts THEN
IF wheretohlight < 6 THEN
wheretohlight = wheretohlight + 1
ELSE
IF dispstart + 5 < numenuopts THEN dispstart = dispstart + 1
END IF
Typed = dispstart + wheretohlight - 1
END IF
CASE CHR$(27)
Typed = -1 'quit!
CASE SPACE$(1), CHR$(13) 'or enter
Typed = Typed + .5 'selection!
CASE "1", "2", "3", "4", "5", "6", "7", "8", "9"
' allow actual numbers 1 through 9
IF numenuopts = 1 THEN
IF keyput$ = "1" THEN Typed = Typed + .5 'treat specially as enter key
ELSE
' normal
IF VAL(keyput$) <= numenuopts THEN
dispstart = 0
DO: dispstart = dispstart + 1: LOOP UNTIL dispstart + 5 >= VAL(keyput$)
wheretohlight = VAL(keyput$) - dispstart + 1
Typed = dispstart + wheretohlight - 1
END IF
END IF
CASE ELSE
COLOR 0, 3
LOCATE 14, 51: PRINT "Use Arrow Keys-then [Enter]"
timert = TIMER + 1.5: DO: emptybuffer$ = INKEY$ 'prevent long wait bug XD
LOOP UNTIL TIMER > timert OR TIMER < timert - 1.5 * 1.2
COLOR 0, 3
LOCATE 14, 51: PRINT " Kriegspiel Referee - Menu "
END SELECT
LOOP UNTIL Typed < 0 OR Typed <> INT(Typed): Typed = INT(Typed)
IF Typed = numenuopts AND FinalOptionSameAsEscKey THEN Typed = -1
COLOR 7, 0
' yay...
' integrate with mac's design:
SELECT CASE Typed
CASE -1
n$ = "": t% = 3 'quit
CASE 1
IF MenuOption(1) = "New Game" THEN
n$ = NewGame:
IF n$ = "" THEN CALL Introduction(n$, t%) ELSE t% = 2'new
ELSE
CLS : PRINT "Erase some games if you want to same new ones"
LINE INPUT "Press Enter to acknowledge: "; n$
n$ = "": t% = 3 'quit
END IF
CASE ELSE
n$ = MenuOption(Typed): t% = 1 'continue
END SELECT
END SUB

FUNCTION IsInCheck$ (c$)
'tests whether the king is in check

DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER
DIM i AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER
DIM t AS STRING * 3

IF c$ = "White" THEN dir = 1 ELSE dir = -1
cx = 666 'in case there is no king
DO
FOR x = 1 TO 8
FOR y = 1 TO 8
SELECT CASE dir * board(x, y)
CASE 1, 7: cx = x: cy = y: EXIT DO 'find king
END SELECT
NEXT y
NEXT x
LOOP UNTIL -1 'this loop exists only for the convenient EXIT DO, cheap substitute for GOTO

n = 0 'assume not in check
IF cx <> 666 THEN 'king exists
FOR i = 0 TO 7 'test each linear direction
x = cx: y = cy
'ix = ((i + 2) MOD 3) - 1 'could be replaced with a SELECT CASE
'iy = ((i * 4) \ 10) - 1 'not sure which would be more efficient
SELECT CASE i 'this select case block accomplishes the same thing
CASE 0: ix = 1: iy = -1
CASE 1: ix = -1: iy = -1
CASE 2: ix = 0: iy = -1
CASE 3: ix = 1: iy = 0
CASE 4: ix = -1: iy = 0
CASE 5: ix = 0: iy = 1
CASE 6: ix = 1: iy = 1
CASE 7: ix = -1: iy = 1
END SELECT
DO 'loop to test the lines
x = x + ix: y = y + iy 'increment
IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO 'bounds

'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)

SELECT CASE board(x, y) * dir 'what's there?
CASE IS > 0, -4: EXIT DO 'blocked by one of mine, or enemy knight
CASE -1, -7: IF (ABS(x - cx) > 1) OR (ABS(y - cy) > 1) THEN EXIT DO ELSE GOSUB orit
CASE -2: GOSUB orit
CASE -3: IF (x = cx) OR (y = cy) THEN EXIT DO ELSE GOSUB orit
CASE -5, -8: IF (x <> cx) AND (y <> cy) THEN EXIT DO ELSE GOSUB orit
CASE -6, -9: IF (ABS(x - cx) <> 1) OR ((y - cy) <> dir) THEN EXIT DO ELSE GOSUB orit
END SELECT
LOOP
NEXT i
FOR i = 0 TO 7 '"L" shaped knight moves
'x = cx + (((i + 1) MOD 2) + 1) * (1 OR (i < 4))
'y = cy + ((i MOD 2) + 1) * (1 OR (i < 2) OR (i > 5))
SELECT CASE i 'does the same as formula
CASE 0: x = cx - 2: y = cy - 1
CASE 1: x = cx - 1: y = cy - 2
CASE 2: x = cx - 2: y = cy + 1
CASE 3: x = cx - 1: y = cy + 2
CASE 4: x = cx + 2: y = cy + 1
CASE 5: x = cx + 1: y = cy + 2
CASE 6: x = cx + 2: y = cy - 1
CASE 7: x = cx + 1: y = cy - 2
END SELECT
IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN 'bounds
IF board(x, y) * dir = -4 THEN n = n OR 1 'enemy knight?
END IF
NEXT i
END IF
t = "---" 'create string
IF n AND 1 THEN MID$(t, 1, 1) = "N"
IF n AND 2 THEN MID$(t, 2, 1) = "L"
IF n AND 4 THEN MID$(t, 2, 1) = "S"
IF n AND 8 THEN MID$(t, 3, 1) = "R"
IF n AND 16 THEN MID$(t, 3, 1) = "F"
IsInCheck$ = t
EXIT FUNCTION

orit:
SELECT CASE i
CASE 3, 4: n = n OR 8 'rank
CASE 2, 5: n = n OR 16 'file
CASE 0, 7: IF (cx > 4) XOR (cy > 4) THEN n = n OR 2 ELSE n = n OR 4 '\
CASE 1, 6: IF (cx > 4) XOR (cy > 4) THEN n = n OR 4 ELSE n = n OR 2 '/
END SELECT
RETURN
END FUNCTION

FUNCTION ispathblocked% (sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER, which AS INTEGER)
'line must be a valid linear move. Input is assumed to be valid!
'if blocked by one's own, returns 1
'if blocked by enemy, and not blocked by one's own, returns 2
'if not blocked, returns 0

DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, cnt AS INTEGER
DIM n AS INTEGER, i AS INTEGER
ix = SGN(dx - sx): iy = SGN(dy - sy) 'set direction of move
cnt = ABS(dx - sx) OR ABS(dy - sy) 'counter
x = sx: y = sy
FOR i = 1 TO cnt - 1
x = x + ix: y = y + iy 'increment
IF board(x, y) THEN
'sensitive to color, because of "illegal" vs. "not possible"
IF which <> SGN(board(x, y)) THEN n = 2 ELSE n = 1: EXIT FOR
END IF
NEXT i
ispathblocked% = n
END FUNCTION

FUNCTION isthreatened% (bi AS INTEGER, cx AS INTEGER, cy AS INTEGER, dir AS INTEGER)
'this function assumes valid input
DIM x AS INTEGER, y AS INTEGER, ix AS INTEGER, iy AS INTEGER, n AS INTEGER
DIM i AS INTEGER, b AS INTEGER
n = 0 'assume not threatened
FOR i = 0 TO 7 ' tests each linear direction
x = cx: y = cy
'ix = ((i + 2) MOD 3) - 1 'could be replaced with a SELECT CASE
'iy = ((i * 4) \ 10) - 1 'not sure which would be more efficient
SELECT CASE i
CASE 0: ix = 1: iy = -1
CASE 1: ix = -1: iy = -1
CASE 2: ix = 0: iy = -1
CASE 3: ix = 1: iy = 0
CASE 4: ix = -1: iy = 0
CASE 5: ix = 0: iy = 1
CASE 6: ix = 1: iy = 1
CASE 7: ix = -1: iy = 1
END SELECT
DO 'test the lines
x = x + ix: y = y + iy 'increment
IF (x < 1) OR (x > 8) OR (y < 1) OR (y > 8) THEN EXIT DO 'bounds

'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)

IF bi = 0 THEN 'which array are we working with?
b = board(x, y)
ELSE
b = vboard(x, y)
END IF
SELECT CASE b * dir 'what do we have?
CASE IS > 0, -4: EXIT DO 'blocked by one of my own, or enemy knight
CASE -1, -7: IF (ABS(x - cx) > 1) OR (ABS(y - cy) > 1) THEN EXIT DO ELSE n = -1: EXIT FOR
CASE -2: n = -1: EXIT FOR
CASE -3: IF (x = cx) OR (y = cy) THEN EXIT DO ELSE n = -1: EXIT FOR
CASE -5, -8: IF (x <> cx) AND (y <> cy) THEN EXIT DO ELSE n = -1: EXIT FOR
CASE -6, -9: IF (ABS(x - cx) <> 1) OR ((y - cy) <> dir) THEN EXIT DO ELSE n = -1: EXIT FOR
END SELECT
LOOP
NEXT i
IF NOT n THEN
FOR i = 0 TO 7 'test "L" shaped directions
'x = cx + (((i + 1) MOD 2) + 1) * (1 OR (i < 4))
'y = cy + ((i MOD 2) + 1) * (1 OR (i < 2) OR (i > 5))
SELECT CASE i
CASE 0: x = cx - 2: y = cy - 1
CASE 1: x = cx - 1: y = cy - 2
CASE 2: x = cx - 2: y = cy + 1
CASE 3: x = cx - 1: y = cy + 2
CASE 4: x = cx + 2: y = cy + 1
CASE 5: x = cx + 1: y = cy + 2
CASE 6: x = cx + 2: y = cy - 1
CASE 7: x = cx + 1: y = cy - 2
END SELECT
IF (x >= 1) AND (x <= 8) AND (y >= 1) AND (y <= 8) THEN 'bounds
IF bi = 0 THEN 'which array are we working with?
b = board(x, y)
ELSE
b = vboard(x, y)
END IF
IF (b * dir) = -4 THEN n = -1: EXIT FOR 'enemy knight?
END IF
NEXT i
END IF
isthreatened% = n
END FUNCTION

SUB KEYBOARD (b$, x%, y%, xxx$, Mode$, textloc%, opt1, 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%, Mode$, opt1)
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:
OLDNUMBER$ = LTRIM$(STR$(1 + INT((OLDY% - LM% + 1) / 5.1)))
OLDALPHA$ = LCASE$(CHR$(65 + INT((OLDX% - TM% + 1) / 2.1)))
NEWNUMBER$ = LTRIM$(STR$(1 + INT((y% - LM% + 1) / 5.1)))
NEWALPHA$ = LCASE$(CHR$(65 + INT((x% - TM% + 1) / 2.1)))
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

FUNCTION ksgDecrypt$ (k#, Encrypted$)
DIM ktest AS STRING * 10
LSET ktest = STR$(k#)
IF LEFT$(Encrypted$, 10) <> ktest THEN STOP: 'bug
ksgDecrypt$ = RIGHT$(Encrypted$, LEN(Encrypted$) - 10)
END FUNCTION

FUNCTION ksgEncrypt$ (k#, Clear$)
DIM ktest AS STRING * 10
LSET ktest = STR$(k#)
ksgEncrypt$ = ktest + Clear$
END FUNCTION

FUNCTION LegalMove% (movestr AS STRING)
'format "a1-h8"
'returns 0 if not possible, 1 if illegal, 2 if legal

DIM sx AS INTEGER, sy AS INTEGER, dx AS INTEGER, dy AS INTEGER
DIM source AS INTEGER, why AS INTEGER, x AS INTEGER, y AS INTEGER
DIM kx AS INTEGER, ky AS INTEGER, dir AS INTEGER, block AS INTEGER

why = 2 'assume legal

sx = ASC(LEFT$(movestr, 1)) - &H60 'get coordinates from string
sy = ASC(MID$(movestr, 2, 1)) - &H30
dx = ASC(MID$(movestr, 4, 1)) - &H60
dy = ASC(MID$(movestr, 5, 1)) - &H30

'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)

source = board(sx, sy) 'piece to move
IF source = 0 THEN why = 1: GOTO outnow 'trying to move nothing?
dir = SGN(source) 'note the color of the piece
IF SGN(board(dx, dy)) = dir THEN why = 1: GOTO outnow 'taking one's own piece
FOR x = 1 TO 8
FOR y = 1 TO 8
vboard(x, y) = board(x, y) 'update vboard
SELECT CASE dir * board(x, y)
CASE 1, 7: kx = x: ky = y 'find king
END SELECT
IF ABS(board(x, y)) = 9 THEN
vboard(x, y) = SGN(board(x, y)) * 6 'pawns no longer subject to en passant
END IF
NEXT y
NEXT x
vboard(sx, sy) = 0 'remove piece from starting square in vboard
SELECT CASE ABS(source)
CASE 1 'king that hasn't moved
IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN 'not a normal move
IF sy <> dy THEN why = 1: GOTO outnow 'illegal
SELECT CASE dx
CASE 3 'queen's side castle
IF ABS(board(1, sy)) <> 5 THEN why = 1: GOTO outnow 'need unmoved rook
block = ispathblocked%(sx, sy, 1, dy, dir)
IF block = 1 THEN why = 1: GOTO outnow 'path blocked
IF isthreatened%(0, 4, sy, dir) THEN why = 0: GOTO outnow 'crossing threat
IF block THEN why = 0: GOTO outnow 'path blocked
vboard(1, sy) = 0: vboard(4, sy) = dir * 8 'move rook in vBoard
CASE 7 'kings's side caslte
IF ABS(board(8, sy)) <> 5 THEN why = 1: GOTO outnow 'need unmoved rook
block = ispathblocked%(sx, sy, 8, dy, dir)
IF block = 1 THEN why = 1: GOTO outnow 'path blocked
IF isthreatened%(0, 6, sy, dir) THEN why = 0: GOTO outnow 'crossing threat
IF block THEN why = 0: GOTO outnow 'path blocked
vboard(8, sy) = 0: vboard(6, sy) = dir * 8 'move rook in vBoard
CASE ELSE: why = 1: GOTO outnow 'illegal
END SELECT
IF isthreatened%(0, sx, sy, dir) THEN why = 0: GOTO outnow 'can't castle if checked
END IF
source = dir * 7 'king has moved
kx = dx: ky = dy 'new location
CASE 7 'king that has moved
IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) > 1) THEN why = 1: GOTO outnow 'one square only
kx = dx: ky = dy 'new location
CASE 2 'queen
IF (sx <> dx) AND (sy <> dy) AND (ABS(sx - dx) <> ABS(sy - dy)) THEN why = 1: GOTO outnow
block = ispathblocked%(sx, sy, dx, dy, dir)
IF block = 1 THEN why = 1: GOTO outnow 'blocked by same
IF block THEN why = 0: GOTO outnow 'blocked by enemy
CASE 3 'bishop
IF ABS(sx - dx) <> ABS(sy - dy) THEN why = 1: GOTO outnow
block = ispathblocked%(sx, sy, dx, dy, dir)
IF block = 1 THEN why = 1: GOTO outnow 'blocked by same
IF block THEN why = 0: GOTO outnow 'blocked by enemy
CASE 4 'knight
IF ((ABS(sx - dx) + ABS(sy - dy)) <> 3) OR (sx = dx) OR (sy = dy) THEN why = 1: GOTO outnow
CASE 5, 8 'rook
IF (sx <> dx) AND (sy <> dy) THEN why = 1: GOTO outnow
block = ispathblocked%(sx, sy, dx, dy, dir)
IF block = 1 THEN why = 1: GOTO outnow 'blocked by same
IF block THEN why = 0: GOTO outnow 'blocked by enemy
source = dir * 8 'rook has moved
CASE 6, 1 'pawn
IF SGN(dy - sy) <> dir THEN why = 1: GOTO outnow 'direction
IF sx = dx THEN 'non-diagnol move
SELECT CASE ABS(dy - sy)
CASE 2
IF (sy <> (2 + (5 AND (dir = -1)))) THEN why = 1: GOTO outnow 'only on 1st move
SELECT CASE SGN(board(sx, (3 + (3 AND (dir = -1))))) 'trying to jump something?
CASE dir: why = 1: GOTO outnow
CASE 0 - dir: why = 0: GOTO outnow
END SELECT
source = dir * 9 'pawn subject to en passent
CASE 1: source = dir * 6 'pawn not subject to en passent
CASE ELSE: why = 1: GOTO outnow 'illegal
END SELECT
IF board(dx, dy) THEN why = 0: GOTO outnow 'can't capture with forward move
ELSE 'not same x
IF (ABS(sx - dx) > 1) OR (ABS(sy - dy) <> 1) THEN why = 1: GOTO outnow 'illegal
IF board(dx, dy) = 0 THEN 'trying en passent
IF (board(dx, sy) <> (-9 * dir)) THEN
why = 0: GOTO outnow 'not possible
ELSE
vboard(dx, sy) = 0 'successful en passent
END IF
END IF
source = dir * 6 'pawn not subject to en passent
END IF
END SELECT
vboard(dx, dy) = source 'update vBoard
IF isthreatened%(1, kx, ky, dir) THEN why = 0: GOTO outnow 'can't be in check

outnow:
LegalMove% = why
END FUNCTION

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
IF 1 = 2 THEN
LOCATE 3, 5: COLOR 7, 0
PRINT Move$, zAH%; z18%, zPiece%
LOCATE , 5
PRINT , yAH%; y18%, yPiece%
COLOR 7, 1: PRINT " "
DO: o$ = INKEY$: LOOP WHILE o$ = "": IF o$ = CHR$(27) THEN STOP
END IF

m$ = DisplayBoard(LCASE$(LEFT$(c1$, 1)))
SELECT CASE ABS(yPiece%)
CASE 0:
IF (ABS(zPiece%) = 6) AND (zAH% <> yAH%) THEN
STOP: 'Pawn capture via en passent
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 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
CALL BOARDMAP(b$, OLDX%, OLDY%, x%, y%)
IF b$ <> "OUTOFBOUNDS" THEN
IF Mode$ = "W" THEN IF board%(((x% + 1) \ 2) - 1, (y% + 2) \ 5) > 0 THEN EXIT SUB
IF Mode$ = "B" THEN IF board%(((x% + 1) \ 2) - 1, (y% + 2) \ 5) < 0 THEN EXIT SUB
ELSE
b$ = ""
END IF
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.
IF Mode$ = "W" THEN opt1 = 1 ELSE opt1 = -1
CALL SNAPTOCENTER(x%, y%, Mode$, opt1)
A% = SCREEN(x%, y%, 1)
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
IF Mode$ = "W" THEN opt1 = 1 ELSE opt1 = -1
CALL SNAPTOCENTER(x%, y%, Mode$, opt1)
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%, 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

FUNCTION NewGame$
CLS
DO
OK% = -1
LINE INPUT "Enter a name for this game: "; n$
IF n$ = "" THEN EXIT FUNCTION
IF n$ = "t" THEN STOP
IF OK% THEN
IF LEN(n$) > 8 THEN PRINT "8 characters or less": OK% = 0
END IF
IF OK% THEN
k$ = "0123456789abcdefghijklmnopqrstuvwxyz"
FOR i = 1 TO LEN(n$)
IF INSTR(k$, MID$(LCASE$(n$), i, 1)) = 0 THEN
PRINT "Use only a-z and 0-9": OK% = 0: EXIT FOR
END IF
NEXT i
END IF
IF OK% THEN
Test$ = n$ + ".ksg"
OPEN Test$ FOR APPEND AS #1: l% = LOF(1): CLOSE
IF l% > 0 THEN PRINT "Name already exists": OK% = 0
END IF
LOOP WHILE NOT OK%
NewGame$ = n$
END FUNCTION

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$)
DIM c AS INTEGER, y AS INTEGER
IF Msg$ = "Recall" THEN
OPEN RefLog FOR APPEND AS #1: CLOSE
OPEN RefLog FOR INPUT AS #1
IF EOF(1) THEN CLOSE : EXIT SUB
CLS : PRINT "Referee Calls Overheard:": PRINT
DO WHILE NOT EOF(1)
LINE INPUT #1, l$
IF INSTR(l$, "|") > 0 THEN GOSUB PieceGone
PRINT SPACE$(4) + l$
c = c + 1: 'Count lines except following cases
IF l$ = "White to move" THEN c = c - 1
IF l$ = "Black to move" THEN c = c - 1
IF l$ = "Legal Move" THEN c = c - 1
LOOP
CLOSE
OPEN RefLog FOR OUTPUT AS #1: CLOSE
IF c = 0 THEN
SLEEP 2
FOR c = 1 TO 1000
k$ = INKEY$: IF k$ <> "" THEN EXIT FOR
NEXT c
CLS : EXIT SUB
END IF
PRINT SPACE$(4) + "(Press Enter to acknowledge)"
DO: LINE INPUT ""; e$: LOOP WHILE e$ <> ""
CLS
ELSE
OPEN RefLog FOR APPEND AS #1
PRINT #1, Msg$
CLOSE
y = INSTR(Msg$, "|")
IF y > 0 THEN PRINT LEFT$(Msg$, y - 1) ELSE PRINT Msg$
END IF
EXIT SUB
PieceGone:
y = INSTR(l$, "|")
q$ = RIGHT$(l$, LEN(l$) - y)
l$ = LEFT$(l$, y - 1)
l$ = l$ + ": " + MID$("KQBNRPKRP", VAL(RIGHT$(q$, 1)), 1)
l$ = l$ + " at " + MID$("abcdefgh", VAL(LEFT$(q$, 2)), 1) + MID$(q$, 4, 1)
RETURN

END SUB

SUB SecureEncryptAndWrite (Game$, zkey#, Pb#, pw#, Who%)
DIM m AS STRING
m = LTRIM$(STR$(Pb#)) + "|"
m = m + LTRIM$(STR$(pw#)) + "|"
m = m + LTRIM$(STR$(Who%)) + "|"
DIM i AS INTEGER, J AS INTEGER
FOR i = 1 TO 8: FOR J = 1 TO 8
m = m + STR$(board(i, J))
m = m + STR$(WBoard(i, J))
m = m + STR$(BBoard(i, J))
NEXT J: NEXT i
w$ = ksgEncrypt(zkey#, m)
DIM ff AS INTEGER: ff = FREEFILE
OPEN Game$ + ".ksg" FOR OUTPUT AS #ff
PRINT #ff, w$
CLOSE #ff
END SUB

SUB SecureReadAndDecrypt (Game$, zkey#, Pb#, pw#, Who%)
DIM ff AS INTEGER: ff = FREEFILE
OPEN Game$ + ".ksg" FOR INPUT AS #ff
LINE INPUT #ff, l$
CLOSE #ff
DIM m AS STRING, y AS INTEGER
m = ksgDecrypt(zkey#, l$)
y = INSTR(m, "|"): Pb# = VAL(LEFT$(m, y - 1)): m = RIGHT$(m, LEN(m) - y)
y = INSTR(m, "|"): pw# = VAL(LEFT$(m, y - 1)): m = RIGHT$(m, LEN(m) - y)
y = INSTR(m, "|"): Who% = VAL(LEFT$(m, y - 1)): m = RIGHT$(m, LEN(m) - y)
DIM i AS INTEGER, J AS INTEGER
y = 1
FOR i = 1 TO 8: FOR J = 1 TO 8
board(i, J) = VAL(MID$(m, y, 2))
WBoard(i, J) = VAL(MID$(m, y + 2, 2))
BBoard(i, J) = VAL(MID$(m, y + 4, 2))
y = y + 6
NEXT J: NEXT i
END SUB

SUB SNAPTOCENTER (x%, y%, Mode$, opt1)
CNTY% = y% - LM% + 1
i% = 5 - CNTY% MOD 5: IF i% = 5 THEN i% = 0
y% = y% - (3 - (i%))
IF Mode$ = "B" AND opt1 <> -1 OR opt1 = 1 THEN y% = y% + 2
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