KRef.bas Version 20060620.4

by Team

 
'=============================================
CONST Version = "KRef Version 2006-06-20": 'You must have this to run
CONST Enhancement = 4: 'Level of minor cosmetic changes, if any
'=============================================
DIM SHARED LogC AS STRING * 1
DIM SHARED RefLog(1 TO 100) AS STRING
DIM SHARED RefLogX AS INTEGER
'=============================================
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 SHARED SecretKey AS DOUBLE: SecretKey = GetKey
' This is used to encrypt the game between play sessions
'=============================================
DIM SHARED LogB AS INTEGER ' Last move completed by Black
DIM SHARED LogW AS INTEGER
'========================================================
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
'=============================================
CONST ccMin = 33: CONST ccMax = 126
DIM SHARED ccDelta AS INTEGER: ccDelta = ccMax - ccMin + 1
DIM SHARED sysR(150) AS INTEGER: ' Random numbers
DIM SHARED sysC(150) AS INTEGER: ' Characters of text
'=============================================
DIM SHARED ckE AS STRING * 60
DIM SHARED pbm AS INTEGER: 'Playback mode patch

' MAIN

DIM PasswordB AS DOUBLE
DIM PasswordW AS DOUBLE
DIM WhoseTurn AS INTEGER
DIM SHARED GameName AS STRING, GameType AS INTEGER
DIM SHARED pwW AS STRING * 15, pwB AS STRING * 15
DIM SHARED pwoW AS STRING * 15, pwoB AS STRING * 15
LSET pwW = "": LSET pwB = "": ' Fill with spaces
LSET pwoW = "": LSET pwoB = ""

CALL Introduction(GameName, GameType)
DIM SHARED GotEntries AS INTEGER ' (Boolean)

SELECT CASE GameType
CASE 1: 'Existing game
  CALL SecureReadAndDecrypt(GameName, SecretKey, PasswordB, PasswordW, WhoseTurn)
  pwoW = pwW: pwoB = pwB
  IF Opened(1, GameName + ".pwd") THEN
    LINE INPUT #1, L$
  ELSE
    L$ = SPACE$(30)
  END IF
  CLOSE #1
  IF LEN(L$) <> 30 THEN STOP: L$ = SPACE$(30)
  IF LEFT$(L$, 15) <> pwW THEN LSET pwW = ""
  IF RIGHT$(L$, 15) <> pwB THEN LSET pwB = ""
CASE 2: 'New game
  IF GameName = "" THEN RUN
  GOSUB InitNewGame: CALL Logger("Init", ""): GOSUB SaveGame
CASE 3: 'Exit
  CLS : SYSTEM
END SELECT
DIM BadPass AS INTEGER
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: LogC = "B"
    PasswordB = GetInitialPassword("Black")
    IF PasswordB = 0 THEN CLS : SYSTEM
    WhoseTurn = 1: GOSUB SaveGame
  CASE 1: LogC = "W"
    PasswordW = GetInitialPassword("White")
    IF PasswordW = 0 THEN CLS : SYSTEM
    WhoseTurn = 2: GOSUB SaveGame
    NewPassword% = -1
  CASE 2: LogC = "W"
    IF NewPassword% THEN
      NewPassword% = 0
    ELSE
      IF PasswordW = -1 AND pwW <> SPACE$(15) THEN
        IF PasswordB = -1 AND pwB <> SPACE$(15) THEN
        ELSE
          CALL RefereeSpeaks("Recall")
        END IF
      ELSE
        BadPass = NOT Authorized("White", PasswordW)
        IF BadPass THEN EXIT DO
        CALL RefereeSpeaks("Recall")
      END IF
    END IF
    SELECT CASE MakeMoveX("White")
    CASE 1: WhoseTurn = 3: GOSUB JustMoved
    CASE 2: EXIT DO: ' Will move later
    CASE 3: WhoseTurn = 4: GOSUB SaveGame
    END SELECT
  CASE 3: LogC = "B"
    IF PasswordB = -1 AND pwB <> SPACE$(15) THEN
      IF PasswordW = -1 AND pwW <> SPACE$(15) THEN
      ELSE
        CALL RefereeSpeaks("Recall")
      END IF
    ELSE
      BadPass = NOT Authorized("Black", PasswordB)
      IF BadPass THEN EXIT DO
      CALL RefereeSpeaks("Recall")
    END IF
    SELECT CASE MakeMoveX("Black")
    CASE 1: WhoseTurn = 2: GOSUB JustMoved
    CASE 2: EXIT DO: ' Will move later
    CASE 3: WhoseTurn = 5: GOSUB SaveGame
    END SELECT
  CASE 4: LogC = "B"
    IF PasswordB = -1 AND pwB <> SPACE$(15) THEN
      IF PasswordW = -1 AND pwW <> SPACE$(15) THEN
      ELSE
        CALL RefereeSpeaks("Recall")
      END IF
    ELSE
      BadPass = NOT Authorized("Black", PasswordB)
      IF BadPass THEN EXIT DO
    END IF
    WhoseTurn = 6: GOSUB SaveGame
    CLS
  CASE 5: LogC = "W"
    IF PasswordW = -1 AND pwW <> SPACE$(15) THEN
      IF PasswordB = -1 AND pwB <> SPACE$(15) THEN
      ELSE
        CALL RefereeSpeaks("Recall")
      END IF
    ELSE
      BadPass = NOT Authorized("White", PasswordW)
      IF BadPass THEN EXIT DO
    END IF
    WhoseTurn = 6: GOSUB SaveGame
    CLS
  CASE 6:
    DO
      LINE INPUT "Show Board from Whose Perspective? B/W: "; p$
      IF UCASE$(p$) = "W" THEN K$ = DisplayBoard("BW-W"): EXIT DO
      IF UCASE$(p$) = "B" THEN K$ = DisplayBoard("BW-B"): EXIT DO
    LOOP
    GOSUB PlayBack
    Restart 0
  END SELECT
LOOP
CLS
IF BadPass THEN PRINT "Not Authorized"
GOSUB SaveGame
Restart 1

PlayBack:
DIM lgW AS INTEGER: lgW = FREEFILE
IF NOT Opened(lgW, GameName + ".lgW") THEN RETURN
DIM lgB AS INTEGER: lgB = FREEFILE
IF NOT Opened(lgB, GameName + ".lgB") THEN CLOSE #lgW: RETURN
WindowSub "Open"
DO
  PRINT "Want to see the whole game played? ";
  LINE INPUT "Y/N: "; A$
  CLS : PRINT "You entered "; A$
LOOP WHILE INSTR("YyNn", A$) = 0
IF UCASE$(A$) = "N" THEN PRINT "Game will not be displayed": CLOSE #lgW, #lgB: RETURN
pbm = 1
GOSUB InitNewGame
DIM Moves(1000) AS STRING
DIM MoveX AS INTEGER: MoveX = 0
DIM MoveN AS INTEGER: MoveN = 0
CONST n2m = "None to move"
DIM b AS STRING
' Load playback script
cnt% = 0
DO
  MoveN = MoveN + 1: c$ = "Move" + STR$(MoveN) + " "
  GOSUB GetW: IF L$ <> c$ THEN cnt% = cnt% + 1
  GOSUB GetB: IF L$ <> c$ THEN cnt% = cnt% + 1
  MoveX = MoveX + 1: Moves(MoveX) = c$
  DO
    GOSUB GetW
    MoveX = MoveX + 1: Moves(MoveX) = L$
  LOOP WHILE INSTR(L$, "to move") = 0
  DO
    GOSUB GetB
    MoveX = MoveX + 1: Moves(MoveX) = L$
  LOOP WHILE INSTR(L$, "to move") = 0
LOOP WHILE cnt% < 4
CLOSE #lgW, #lgB
' Prepare it for playback
j = 0: FOR i = 1 TO MoveX
  IF Moves(i) = n2m THEN j = i - 1: EXIT FOR
NEXT i
FOR i = j + 1 TO MoveX
  IF Moves(i) = "" THEN
  ELSEIF Moves(i) = n2m THEN
  ELSEIF LEFT$(Moves(i), 4) = "Move" THEN
  ELSE
    j = j + 1: Moves(j) = Moves(i)
  END IF
NEXT i
MoveX = j + 1: Moves(MoveX) = n2m
GOSUB PlayItBack
RETURN

GetW:
IF EOF(lgW) THEN L$ = n2m ELSE LINE INPUT #lgW, L$
RETURN

GetB:
IF EOF(lgB) THEN L$ = n2m ELSE LINE INPUT #lgB, L$
RETURN

ShowK:
IF LEFT$(K$, 1) = "~" THEN
  oldk$ = RIGHT$(K$, LEN(K$) - 1)
  LOCATE , , 1: PRINT oldk$; " ";
  WHILE INKEY$ <> "": WEND
  DO: e$ = INKEY$: LOOP WHILE e$ = "": IF e$ = CHR$(27) THEN SYSTEM
  oldk$ = oldk$ + SPACE$(4)
  RETURN
END IF
DIM sw(5) AS STRING
DIM swx AS INTEGER
IF K$ <> "u4" THEN
  FOR swx = 1 TO 4: sw(swx) = sw(swx + 1): NEXT swx
  sw(5) = oldk$ + K$: oldk$ = ""
END IF
WindowSub "Close --"
IF UCASE$(p$) = "W" THEN K$ = "BW-W" ELSE K$ = "BW-B"
K$ = DisplayBoard(K$)
WindowSub "Open"
FOR swx = 1 TO 5: PRINT sw(swx): NEXT swx
RETURN

PlayItBack:
MoveX = 0
DO
  GOSUB GetVarB: IF LEFT$(b, 4) = "Move" THEN Move$ = b ELSE STOP
  K$ = Move$ + " (White)": GOSUB ShowK
  GOSUB GetVarB
  DO
    GOSUB DoMoves
  LOOP WHILE INSTR(b, " to move") = 0
  IF b = n2m THEN EXIT DO
  K$ = Move$ + " (Black)": GOSUB ShowK
  GOSUB GetVarB
  DO
    GOSUB DoMoves
  LOOP WHILE INSTR(b, " to move") = 0
LOOP WHILE b <> n2m
RETURN
  
GetVarB:
IF Moves(MoveX) = n2m THEN STOP: 'bug
MoveX = MoveX + 1
b = Moves(MoveX)
IF INSTR(b, "|") THEN b = LEFT$(b, INSTR(b, "|") - 1)
RETURN

DoMoves:
IF INSTR(b, "esigns") > 0 THEN b = "Resigns"
IF LEFT$(b, 3) = "Try" THEN
  OldTry$ = RIGHT$(b, 5)
  K$ = "~" + b: GOSUB ShowK
  GOSUB GetVarB
  IF b = n2m THEN RETURN
  IF LEFT$(b, 4) = "Pawn" THEN PawnGone% = -1
  K$ = b: GOSUB ShowK
  IF LEFT$(b, 2) = "Il" OR LEFT$(b$, 2) = "No" THEN
    ' K$ = "(not tried)": GOSUB ShowK
  ELSEIF b = n2m THEN
    STOP
    WHILE b = n2m: GOSUB GetVarB: PRINT b: STOP: WEND
  ELSE
    x1% = INSTR("abcdefgh", MID$(OldTry$, 1, 1))
    x2% = INSTR("abcdefgh", MID$(OldTry$, 4, 1))
    y1% = VAL(MID$(OldTry$, 2, 1))
    y2% = VAL(MID$(OldTry$, 5, 1))
    Oldv% = Board(x2%, y2%)
    Newv% = Board(x1%, y1%)
    Board(x2%, y2%) = Newv%
    Board(x1%, y1%) = 0
    IF PawnGone% THEN
      PawnGone% = 0
      IF Oldv% = 0 THEN
         K$ = "(en passent)": GOSUB ShowK
         IF Newv% > 0 THEN
           Board(x2%, 5) = 0
         ELSE
           Board(x2%, 4) = 0
         END IF
      END IF
    ELSE
      IF ABS(Newv%) = 1 THEN
        K$ = ""
        IF x1% = 5 THEN
          IF x2% = 7 THEN
            Board(6, y1%) = Board(8, y1%)
            Board(8, y1%) = 0: K$ = "x"
          ELSEIF x2% = 3 THEN
            Board(4, y1%) = Board(1, y1%)
            Board(1, y1%) = 0: K$ = "x"
          END IF
        IF K$ = "x" THEN K$ = "(Castles)": GOSUB ShowK
        END IF
      END IF
    
    END IF
    K$ = "u4": GOSUB ShowK
  END IF
ELSEIF INSTR(b, "promotes") > 0 THEN
  K$ = b: GOSUB ShowK
  GOSUB GetVarB
  IF LEFT$(b, 1) <> "P" THEN STOP: 'bug
  K% = INSTR("KQBNRPKRP", RIGHT$(b, 1))
  IF K% = 0 THEN STOP
  IF Board(x2%, y2%) > 0 THEN
    Board(x2%, y2%) = K%
  ELSE
    Board(x2%, y2%) = -K%
  END IF
  K$ = "u4": GOSUB ShowK
ELSE
  K$ = b: GOSUB ShowK
END IF
GOSUB GetVarB
RETURN

JustMoved:
GotEntries = 0: LSET ckE = "Bogus " + STR$(CDBL(TIMER))
RETURN

SaveGame:
kW$ = pwW: kB$ = pwB: ' In case these are changed below
IF pwW = SPACE$(15) THEN pwW = pwoW
IF pwB = SPACE$(15) THEN pwB = pwoB
CALL SecureEncryptAndWrite(GameName, SecretKey, PasswordB, PasswordW, WhoseTurn)
pwW = kW$: pwB = kB$
RETURN

InitNewGame:
PasswordW = 0: PasswordB = 0
WhoseTurn = 0
DIM zRow AS INTEGER, zCol AS INTEGER
FOR zRow = 3 TO 6: FOR zCol = 1 TO 8: Board(zCol, zRow) = 0: NEXT zCol: NEXT zRow
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

SubRun: VIEW PRINT: COLOR 7, 0: CLS : RUN

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#)
COLOR 7, 1: CLS : LOCATE 5, 30
PRINT "Playing game " + CHR$(34) + GameName + CHR$(34)
PRINT : PRINT
PRINT "Enter the password for " + c$
PRINT "(Just press Enter if you are not that player)"
PRINT
LINE INPUT "Password: "; pw$
IF pw$ = "" THEN EXIT FUNCTION
t# = Hash(pw$)
IF t# = pw# THEN
  Authorized% = -1
ELSE
  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

FUNCTION D2S$ (D AS DOUBLE)
DIM w AS STRING, S AS STRING, i AS INTEGER
w = MKD$(D)
FOR i = 1 TO 8
  c% = ASC(MID$(w, i, 1))
  S = S + CHR$((c% AND 15) + 65) + CHR$(((c% AND 240) / 16) + 65)
NEXT i
D2S$ = S
END FUNCTION

FUNCTION DisplayBoard$ (OrigMode$)
STATIC Blue AS INTEGER
IF NOT Blue OR LEN(OrigMode$) > 1 THEN
  COLOR 7, 1: Blue = -1
  IF pbm = 0 THEN CLS
END IF
Mode$ = UCASE$(OrigMode$)
STATIC ToldPlayer AS INTEGER
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
IF pbm > 0 THEN
  IF pbm = 1 THEN GOSUB Board: pbm = 2
ELSE
  GOSUB Board
END IF
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
LOCATE TM% - 1 + (9 * 2) - (zR * 2), LM% - 3 + zC * 5 - 1
zP = Board(zC, zR)
IF zP = 0 THEN
IF pbm THEN
  cs = ((zR - 1) * 9) + (zC)
  IF cs \ 2 = cs / 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
  PRINT SPACE$(3);
END IF
ELSE
IF zP < 0 THEN zP = -zP: COLOR 0, 6 ELSE COLOR 7, 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
LOCATE TM% - 1 + (0 * 2) + (zR * 2), 43 - (LM% - 3 + zC * 5 - 1)
zP = Board(zC, zR)
IF zP = 0 THEN
IF pbm THEN
  cs = ((zR - 1) * 9) + (zC)
  IF cs \ 2 = cs / 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
  PRINT SPACE$(3);
END IF
ELSE
IF zP < 0 THEN zP = -zP: COLOR 0, 6 ELSE COLOR 7, 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

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 x < 1 OR x > 8 OR y < 1 OR y > 8 THEN STOP: RETURN: 'Mac's Fix useless
 IF LegalMove%(CHR$(cx + &H60) + CHR$(cy + &H30) + "-" + CHR$(x + &H60) + CHR$(y + &H30)) = 2 THEN n = -1
RETURN
END FUNCTION

FUNCTION GetInitialPassword# (c$)
COLOR 7, 0: CLS : LOCATE 5, 30
PRINT "Playing game " + CHR$(34) + GameName + CHR$(34)
PRINT : PRINT
PRINT "Choose and enter the password for " + c$
PRINT "(Just press Enter if you are not that player)"
PRINT
LINE INPUT "Password: "; p$
IF p$ = "" THEN GetInitialPassword# = 0: EXIT FUNCTION
IF p$ <> c$ THEN GetInitialPassword# = Hash(p$): EXIT FUNCTION

'-------------- Compute password for no-password path
RANDOMIZE TIMER
DO
  y# = RND * 44778439
  y$ = LTRIM$(STR$(y#))
LOOP WHILE LEN(y$) < 16 OR INSTR(y$, "D") > 0
y% = INSTR(y$, ".")
IF y% > 0 THEN MID$(y$, y%, 1) = MID$(y$, 16, 1)
IF c$ = "White" THEN LSET pwW = y$ ELSE LSET pwB = y$
'-------------- Read current password file (if any)
IF Opened(1, GameName + ".pwd") THEN LINE INPUT #1, L$ ELSE L$ = SPACE$(30)
CLOSE #1
IF LEN(L$) <> 30 THEN STOP: L$ = SPACE$(30)
'-------------- Add the password for White
IF c$ = "White" THEN
  L$ = pwW + RIGHT$(L$, 15)
ELSE
  L$ = LEFT$(L$, 15) + pwB
END IF
'-------------- Save it
OPEN GameName + ".pwd" FOR OUTPUT AS #1
PRINT #1, L$: CLOSE
'-------------- Report no password required
GetInitialPassword# = -1
END FUNCTION

FUNCTION GetKey#
GetKey# = 434311.34183# / 8.333
END FUNCTION

FUNCTION Hash# (pw$)
IF pw$ = "" THEN STOP: ' Bug in calling program
CONST c1 = 10000000#: CONST c2 = 84901
e# = RND(-57737): ' Good a place as any to start
DIM L AS INTEGER: L = LEN(pw$)
DIM pc(100) AS INTEGER: ' To speed up loop below
DIM i AS INTEGER, j  AS INTEGER
FOR i = 1 TO L: pc(i) = ASC(MID$(pw$, i, 1)): NEXT i
' OK, now compute hash
FOR i = 1 TO 3
  w# = 0
  DO WHILE w# < c1
    FOR j = 1 TO L
      w# = w# + SQR(c2 * RND * pc(j))
    NEXT j
  LOOP
  w# = RND(c1 - w#)
NEXT i
Hash# = RND * c1
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.
COLOR 7, 0
LOCATE 25, 40: PRINT Version; SPACE$(5); " Level:"; Enhancement;
LOCATE 14, 52: COLOR 0, 3: PRINT "Kriegspiel Referee - Menu"
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, 0: htemp$ = MenuOption(menuline + dispstart - 1)
    IF menuline = wheretohlight THEN COLOR 11, 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 keyput$ = "=" THEN
    IF NOT Opened(1, "CurGame.txt") THEN
      COLOR 7, 0
      PRINT "No current game to start"
    ELSE
      LINE INPUT #1, GameName: CLOSE #1
      n$ = GameName: t% = 1
      COLOR 7, 1: CLS
      EXIT SUB
    END IF
  END IF
  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 7, 0: LOCATE 15, 1
    PRINT "Use Arrow Keys to highlight an item"
    PRINT "Use Enter key to select highlighted item"
    Restart 0
  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
  OPEN "CurGame.txt" FOR OUTPUT AS #1: PRINT #1, n$: CLOSE
CASE ELSE
  n$ = MenuOption(Typed): t% = 1 'continue
END SELECT
IF n$ = "" OR t% <> 1 THEN EXIT SUB
OPEN "CurGame.txt" FOR OUTPUT AS #1: PRINT #1, n$: CLOSE
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%, 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

FUNCTION ksgDecrypt$ (K#, Encrypted$)
DIM L AS INTEGER: L = LEN(Encrypted$) - 10
y = RND(-ksgMKey(LEFT$(Encrypted$, 10))): y = RND(-RND * K#)
DIM w AS STRING: w = RIGHT$(Encrypted$, L)
FOR i = 1 TO L
  c% = ASC(MID$(w, i, 1))
   IF c% < ccMin OR c% > ccMax THEN STOP: 'bug
   sysC(i) = c% - ccMin
NEXT i
FOR i = 1 TO L: sysR(i) = 1 + INT(RND * L): NEXT i
' ================================ Decrypt start
FOR iteration = 1 TO 50
  FOR i = 1 TO L
    c% = sysC(i) + INT(RND * ccDelta)
    IF c% >= ccDelta THEN c% = c% - ccDelta
    sysC(i) = c%
  NEXT i
NEXT iteration
FOR i = 1 TO L: SWAP sysC(i), sysC(sysR(i)): NEXT i
' ==============vvvvv============= Decrypt end
w = "": FOR i = 1 TO L: w = w + CHR$(ccMin + sysC(i)): NEXT i
ksgDecrypt$ = w
END FUNCTION

FUNCTION ksgEncrypt$ (K#, Clear$)
DIM w AS STRING: w = Clear$
DIM L AS INTEGER: L = LEN(w)
DIM i AS INTEGER
STATIC ornd AS DOUBLE
IF ornd = 0 THEN RANDOMIZE TIMER: ornd = RND
ornd = RND(-ornd)
FOR i = 1 TO 10: mkey$ = mkey$ + CHR$(ccMin + INT(RND * (ccMax - ccMin + 1))): NEXT i
y = RND(-ksgMKey(mkey$)): y = RND(-RND * K#)
FOR i = 1 TO L
  c% = ASC(MID$(w, i, 1))
  IF c% < ccMin OR c% > ccMax THEN STOP: 'bug
  sysC(i) = c% - ccMin
NEXT i
FOR i = 1 TO L: sysR(i) = 1 + INT(RND * L): NEXT i
' =============^^^^^============== Encrypt start
FOR i = L TO 1 STEP -1: SWAP sysC(i), sysC(sysR(i)): NEXT i
FOR iteration = 1 TO 50
  FOR i = 1 TO L
    c% = sysC(i) - INT(RND * ccDelta)
    IF c% < 0 THEN c% = c% + ccDelta
    sysC(i) = c%
  NEXT i
NEXT iteration
' ================================ Encrypt end
w = "": FOR i = 1 TO L: w = w + CHR$(ccMin + sysC(i)): NEXT i
ksgEncrypt$ = mkey$ + w
END FUNCTION

FUNCTION ksgMKey# (mkey$)
w1# = 3: w2# = 5: w3# = 7: w4# = 11
FOR i = 1 TO 10
  c% = ASC(MID$(mkey$, i, 1)) - ccMin
  w1# = w1# + (c% * i)
  w2# = w2# + (c% * (11 - i))
  IF c% AND 1 THEN
    w3# = w3# + (c% * i)
  ELSE
    w4# = w4# + (c% * 1)
  END IF
NEXT i
ksgMKey# = (w1# / w2#) * (w3# * w4#)
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

SUB Logger (c1 AS STRING, m AS STRING)
STATIC c AS STRING
DIM ff AS INTEGER: ff = FREEFILE
IF c1 = "x" THEN
  IF LogC = "W" OR LogC = "B" THEN  ELSE STOP: 'bug
  OPEN GameName + ".lg" + LogC FOR APPEND AS #ff
  PRINT #ff, m
  CLOSE #ff
  EXIT SUB
ELSE
  c = c1
END IF
IF LEFT$(m, 3) = "Try" THEN
  IF c = "White" THEN
    OPEN GameName + ".lgW" FOR APPEND AS #ff
    IF LogW = LogB THEN LogW = LogW + 1: PRINT #ff, "Move"; LogW
  ELSEIF c = "Black" THEN
    OPEN GameName + ".lgB" FOR APPEND AS #ff
    IF LogB < LogW THEN : LogB = LogW: PRINT #ff, "Move"; LogB
  ELSE
    STOP: 'bug
  END IF
  PRINT #ff, m
  CLOSE #ff
  EXIT SUB
END IF
IF m = "" THEN
  IF c <> "Init" THEN STOP
  IF Opened(ff, GameName + ".lgW") THEN CLOSE #ff
  IF Opened(ff, GameName + ".lgB") THEN CLOSE #ff
  EXIT SUB
END IF
STOP: 'bug
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"
            CALL Logger("x", "Try Resigns")
            CALL Logger("x", "Try Resigns")
            MakeMove% = 3: EXIT FUNCTION
          END IF
        LOOP WHILE LCASE$(A$) <> "n"
      END IF
      IF Ans$ = "a" THEN MakeMove% = 2: EXIT FUNCTION
      IF Ans$ = "c" THEN
        IF c1$ = "White" THEN
          Move$ = DisplayBoard("BW-W")
        ELSEIF c1$ = "Black" THEN
          Move$ = DisplayBoard("BW-B")
        ELSE
          STOP: 'bug
        END IF
        LINE INPUT "Press Enter to continue"; e$
      END IF
      COLOR 7, 1: CLS
      GOTO GetMove2
    END IF
  LOOP
END IF
CALL Logger(c1$, "Try " + Move$)
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
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%
  CALL Logger("x", "Piece: " + MID$("^QBN^^^R", ABS(temp%), 1))
  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

FUNCTION MakeMoveX% (c1$)
IF Replay THEN
  PRINT "Cannot replay old moves."
  PRINT "Restore " + GameName + ".ksg if you've been messing with it"
  Restart 0
END IF
IF c1$ = "White" THEN c2$ = "Black" ELSE c2$ = "White"
DIM Tmp AS INTEGER
WindowSub "Open"
PRINT : PRINT SPACE$(20); c1$
WindowSub "Close --"
Tmp = MakeMove(c1$)
MakeMoveX% = Tmp
IF Tmp <> 1 THEN EXIT FUNCTION
CONST CPrompt = "Pause-after-move mode = "
STATIC WantPrompt AS STRING * 1
IF WantPrompt = "N" THEN EXIT FUNCTION
IF WantPrompt <> "Y" THEN
  OPEN "Kref.dat" FOR BINARY AS #1
  r$ = CPrompt$ + " "
  GET #1, 1, r$
  CLOSE
  WantPrompt = RIGHT$(r$, 1)
  IF r$ = CPrompt + "N" THEN EXIT FUNCTION
  IF r$ <> CPrompt + "Y" THEN GOSUB FirstTime
  IF WantPrompt = "N" THEN EXIT FUNCTION
END IF
WindowSub "Open"
PRINT
PRINT SPACE$(4); "(Press ESC to close the "; c1$; " board.)"
WindowSub "Close --"
Move$ = DisplayBoard(LEFT$(c1$, 1))
CLS
EXIT FUNCTION
FirstTime:
CLS
PRINT "File 'Kref.dat' missing or corrupt: autofix in progress."
PRINT : PRINT : PRINT CPrompt + "?"
LOCATE , , 1: PRINT "Please select Y or N  = ";
DO
  DO: K$ = UCASE$(INKEY$): LOOP WHILE LEN(K$) <> 1
  IF INSTR("YN", K$) > 0 THEN EXIT DO
LOOP
WantPrompt = K$
OPEN "KRef.dat" FOR OUTPUT AS #1
PRINT #1, CPrompt + WantPrompt
CLOSE
CLS
RETURN

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

FUNCTION NewGame$
CLS
DO
  OK% = -1
  LINE INPUT "Enter a name for this game: "; n$
  IF n$ = "" THEN EXIT FUNCTION
  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"
    IF Opened(1, Test$) THEN
      PRINT "Name already exists"
      CLOSE #1: OK% = 0
    END IF
  END IF
LOOP WHILE NOT OK%
NewGame$ = n$
END FUNCTION

FUNCTION Opened% (ff AS INTEGER, ffname AS STRING)
OPEN ffname FOR APPEND AS #ff
IF LOF(ff) = 0 THEN CLOSE #ff: KILL ffname: EXIT FUNCTION
CLOSE #ff
OPEN ffname FOR INPUT AS #ff
Opened% = -1
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, i AS INTEGER
IF Msg$ = "Recall" THEN
  IF RefLogX = 0 THEN EXIT SUB
  CLS : PRINT "Referee Calls Overheard:": PRINT
  FOR i = 1 TO RefLogX
    L$ = RefLog(i)
    IF INSTR(L$, "|") > 0 THEN
      IF LEFT$(L$, 4) <> "Pawn" THEN GOSUB PieceGone
      GOSUB PrintPiece
    END IF
    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
  NEXT i
  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
  CALL Logger("x", Msg$)
  IF INSTR(Msg$, "|") > 0 THEN
    IF LEFT$(Msg$, 4) <> "Pawn" THEN GOSUB Encrypt1
  END IF
  IF GotEntries THEN
    RefLogX = RefLogX + 1
  ELSE
    RefLogX = 1
    GotEntries = -1
  END IF
  RefLog(RefLogX) = Msg$
  y = INSTR(Msg$, "|")
  IF y > 0 THEN PRINT LEFT$(Msg$, y - 1) ELSE PRINT Msg$
END IF
EXIT SUB

PieceGone:
Suffix$ = RIGHT$(L$, 7)
Tmp# = RND(-SecretKey)
FOR i = 1 TO 7
  v% = VAL(MID$(Suffix$, i, 1))
  v% = v% - INT(RND * 10)
  IF v% < 0 THEN v% = v% + 10
  MID$(Suffix$, i, 1) = RIGHT$(STR$(v%), 1)
NEXT i
x# = RND(-VAL(LEFT$(Suffix$, 6)))
v% = VAL(RIGHT$(Suffix$, 1))
v% = v% - INT(RND * 9)
IF v% < 1 THEN v% = v% + 9
L$ = LEFT$(L$, LEN(L$) - 7) + RIGHT$(STR$(v%), 1)
RETURN

PrintPiece:
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)
L$ = L$ + MID$(q$, 4, 1)
RETURN

Encrypt1:
RANDOMIZE TIMER
DO
  K# = 1717177427 * RND
  K$ = LTRIM$(STR$(K#))
LOOP WHILE LEN(K$) < 12
y = INSTR(K$, ".")
IF y > 0 THEN MID$(K$, y, 1) = RIGHT$(STR$(RND * 7793412), 1)
K$ = MID$(K$, 3, 6)
x# = RND(-VAL(K$))
v% = VAL(RIGHT$(Msg$, 1))
v% = v% + INT(RND * 9)
IF v% > 9 THEN v% = v% - 9
Suffix$ = K$ + RIGHT$(STR$(v%), 1)
K# = RND(-SecretKey)
FOR i = 1 TO 7
  v% = VAL(MID$(Suffix$, i, 1))
  v% = v% + INT(RND * 10)
  IF v% > 9 THEN v% = v% - 10
  MID$(Suffix$, i, 1) = RIGHT$(STR$(v%), 1)
NEXT i
Msg$ = LEFT$(Msg$, LEN(Msg$) - 1) + Suffix$
RETURN
END SUB

FUNCTION Replay%
IF LEFT$(ckE, 5) = "Bogus" THEN EXIT FUNCTION
IF ASC(ckE) = 0 THEN EXIT FUNCTION
IF LEN(ckE) < 40 THEN STOP: 'bug
DIM SFile AS STRING: SFile = "B9[j4bh7m2m-q8m"
FOR i = 1 TO 15
  MID$(SFile, i, 1) = CHR$(ASC(MID$(SFile, i, 1)) + 1)
NEXT i
DIM check AS STRING: check = "4c6Em"
DIM ff AS INTEGER: ff = FREEFILE
OPEN SFile FOR RANDOM AS #ff LEN = 5
FIELD #ff, 5 AS x$
GET #ff, 40
IF x$ <> check THEN
  CLOSE #ff: OPEN SFile FOR OUTPUT AS #ff
  w$ = "Uijt!gjmf!xbt!dsfbufe!cz!uif!Lsjfhtqjfm!Sfgfsff!)"
  w$ = w$ + "LSfg*!qsphsbn!zpv!epxompbefe!boe!sbo/!Ju!jt!"
  w$ = w$ + "opu!sfrvjsfe!cz!boz!puifs!qsphsbn!boe!dbo!cf"
  w$ = w$ + "!efmfufe!jg!zpv!bsf!gjojtife!fwfs!qmbzjoh/"
  FOR i = 1 TO LEN(w$)
    MID$(w$, i, 1) = CHR$(ASC(MID$(w$, i, 1)) - 1)
  NEXT i
  PRINT #ff, w$: PRINT #ff, "": PRINT #ff, ""
  CLOSE #ff
  OPEN SFile FOR RANDOM AS #ff LEN = 5
  FIELD #ff, 5 AS x$
  LSET x$ = check: PUT #1, 40
  LSET x$ = STR$(99): PUT #1, 41
  FOR i = 42 TO 99: LSET x$ = "": PUT #1, i: NEXT i
END IF
GET #ff, 40
IF x$ <> check THEN STOP: 'goof
w$ = MID$(ckE, 35, 5)
FOR i = 42 TO 99
  GET #1, i
  IF w$ = x$ THEN
    CLS : PRINT "|"; w$; "|"; x$; "|"
    PRINT "|"; ckE; "|": STOP
    CLOSE #ff: Replay% = -1: EXIT FUNCTION
  END IF
NEXT i
GET #1, 41
DIM CurLast AS INTEGER: CurLast = VAL(x$)
CurLast = CurLast + 1
IF CurLast > 99 THEN CurLast = 42
LSET x$ = w$: PUT #ff, CurLast
LSET x$ = STR$(CurLast): PUT #ff, 41
CLOSE #ff
END FUNCTION

SUB Restart (Num AS INTEGER)
IF Num = 0 THEN
  LINE INPUT "Press Enter to acknowledge"; e$
ELSE
  SLEEP Num: K$ = INKEY$
END IF
ON ERROR GOTO SubRun
x = 0: x = 1 / x
END SUB

FUNCTION S2D# (S AS STRING)
DIM w AS STRING, i AS INTEGER
FOR i = 1 TO 16 STEP 2
  w = w + CHR$(((ASC(MID$(S, i, 1))) - 65) + (((ASC(MID$(S, i + 1, 1))) - 65) * 16))
NEXT i
S2D# = CVD(w)
END FUNCTION

SUB SecureEncryptAndWrite (Game$, zkey#, pB#, pw#, Who%)
IF Who% < 0 THEN STOP
IF Who% > 9 THEN STOP
DIM m AS STRING
m = ""
DIM i AS INTEGER, j AS INTEGER
FOR i = 1 TO 8: FOR j = 1 TO 8
    IF Board(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(Board(i, j) + 44)
    END IF
    IF WBoard(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(WBoard(i, j) + 63)
    END IF
    IF BBoard(i, j) <> 0 THEN
      m = m + CHR$(33 + ((i - 1) * 8) + (j - 1))
      m = m + CHR$(BBoard(i, j) + 82)
    END IF
NEXT j: NEXT i
m = D2S(pB#) + D2S(pw#) + CHR$(Who% + 70) + m
IF LEFT$(pwW, 1) = " " THEN
  m = m + "."
  FOR i = 1 TO 14: m = m + CHR$(48 + INT(RND * 10)): NEXT i
ELSE
  m = m + pwW
END IF
IF LEFT$(pwB, 1) = " " THEN
  m = m + "."
  FOR i = 1 TO 14: m = m + CHR$(48 + INT(RND * 10)): NEXT i
ELSE
  m = m + pwB
END IF
w$ = ksgEncrypt(zkey#, m)
DIM ff AS INTEGER: ff = FREEFILE
OPEN Game$ + ".ksg" FOR OUTPUT AS #ff
WHILE LEN(w$) > 70
  PRINT #ff, LEFT$(w$, 70)
  w$ = RIGHT$(w$, LEN(w$) - 70)
WEND
PRINT #ff, w$
PRINT #ff, Version
WRITE #ff, LogB, LogW
FOR i = 1 TO RefLogX
  PRINT #ff, RefLog(i)
NEXT i
PRINT #ff, "End of Log": PRINT #ff, ""
CLOSE #ff
END SUB

SUB SecureReadAndDecrypt (Game$, zkey#, pB#, pw#, Who%)
DIM ff AS INTEGER: ff = FREEFILE
IF NOT Opened(ff, Game$ + ".ksg") THEN PRINT "Game file disappeared": Restart 0
LINE INPUT #ff, L$
LSET ckE = L$
DO
  IF LEN(L$) > 200 THEN
    PRINT "Sorry, the game file for this selection is invalid"
    PRINT "It may be an old game that is no longer supported"
    Restart 0
  END IF
  LINE INPUT #ff, v$
  IF LEFT$(v$, 7) = LEFT$(Version, 7) THEN EXIT DO
  L$ = L$ + v$
LOOP
IF v$ <> Version THEN
  PRINT "Sorry, for this selection you need"
  PRINT Version
  Restart 0
END IF
IF NOT EOF(ff) THEN INPUT #ff, LogB
IF NOT EOF(ff) THEN INPUT #ff, LogW
DO WHILE NOT EOF(ff)
  LINE INPUT #ff, v$
  IF v$ = "End of Log" THEN EXIT DO
  RefLogX = RefLogX + 1
  RefLog(RefLogX) = v$
LOOP
CLOSE #ff
DIM y AS INTEGER, m AS STRING
m = ksgDecrypt(zkey#, L$)
pwW = MID$(m, LEN(m) - 29, 15)
IF LEFT$(pwW, 1) = "." THEN LSET pwW = ""
pwB = RIGHT$(m, 15)
IF LEFT$(pwB, 1) = "." THEN LSET pwB = ""
m = LEFT$(m, LEN(m) - 30)
pB# = S2D(LEFT$(m, 16)): m = RIGHT$(m, LEN(m) - 16)
pw# = S2D(LEFT$(m, 16)): m = RIGHT$(m, LEN(m) - 16)
Who% = ASC(LEFT$(m, 1)) - 70: m = RIGHT$(m, LEN(m) - 1)
DIM i AS INTEGER
FOR i = 1 TO LEN(m) - 1 STEP 2
  n% = ASC(MID$(m, i, 1)): ' location i,j
  n% = n% - 33: IF n% > 64 THEN PRINT n%: STOP
  ni% = 1 + (n% \ 8)
  nj% = n% + 1 - (8 * (n% \ 8))
  o% = ASC(MID$(m, i + 1, 1)): ' Content
  SELECT CASE o%
  CASE IS < 35: STOP
  CASE IS < 54: o% = o% - 44: Board(ni%, nj%) = o%
  CASE IS < 73: o% = o% - 63: WBoard(ni%, nj%) = o%
  CASE IS < 92: o% = o% - 82: BBoard(ni%, nj%) = o%
  CASE ELSE: STOP
  END SELECT
NEXT i
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



    
This message has been edited by iorr5t from IP address 68.98.164.60 on Jul 4, 2006 8:07 AM
This message has been edited by iorr5t from IP address 68.98.164.60 on Jul 3, 2006 5:18 AM
This message has been edited by iorr5t from IP address 68.98.164.60 on Jun 26, 2006 7:29 PM
This message has been edited by iorr5t from IP address 68.98.164.60 on Jun 24, 2006 1:48 PM

Posted on Jun 21, 2006, 12:26 PM
from IP address 68.98.164.60

Respond to this message   

Return to Index

Response TitleAuthor and Date
Changes resulting in 2006-06-20 Enhancement 0 on Jun 21
Changes resulting in 2006-06-20 Enhancement 1 on Jun 24
Here I come to save the day....(Save this as QB-KRP.bas) then go to next post.Mighty Mouse on Jun 24
 Part two: (Save this as QB-KR2.bas)Pete on Jun 24
  Instructions...Pete on Jun 24
   * errr, gimme some time. just finished a BIG cognac and lost to V'GER on Jun 24
 *FYI: nothing will load on my machine (out of memory). Only works with NT or XP I guess. on Jun 24
Compiling the program on Jun 24
Changes resulting in 2006-06-20 Enhancement 2 on Jun 26
Changes resulting in 2006-06-20 Enhancement 3 on Jul 3
 Re: Changes resulting in 2006-06-20 Enhancement 3 on Jul 3
Changes resulting in 2006-06-20 Enhancement 4 on Jul 4

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement