DM4BAD

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

' 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
LSET pwW = "": LSET pwB = "": ' Fill with spaces

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

SELECT CASE GameType
CASE 1: 'Existing game
  CALL SecureReadAndDecrypt(GameName, SecretKey, PasswordB, PasswordW, WhoseTurn)
  OPEN GameName + ".pwd" FOR APPEND AS #1: CLOSE
  OPEN GameName + ".pwd" FOR INPUT AS #1
  IF EOF(1) THEN l$ = SPACE$(30) ELSE LINE INPUT #1, l$
  CLOSE
  IF LEN(l$) <> 30 THEN 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: 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:
    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 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 MakeMove("White")
    CASE 1: WhoseTurn = 3: RefLogOld = 0: ' Made move
    CASE 2: EXIT DO: ' Will move later
    CASE 3: WhoseTurn = 4: GOSUB SaveGame
    END SELECT
  CASE 3:
    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 MakeMove("Black")
    CASE 1: WhoseTurn = 2: RefLogOld = 0: ' Made move
    CASE 2: EXIT DO: ' Will move later
    CASE 3: WhoseTurn = 5: GOSUB SaveGame
    END SELECT
  CASE 4:
    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:
    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
    COLOR 7, 0
    LINE INPUT "Press Enter to exit"; e$
    CLS
    SYSTEM
  END SELECT
LOOP
CLS
IF BadPass THEN PRINT "Not Authorized"
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 RefereeSpeaks (Msg$)
DIM RefLog AS STRING: RefLog = GameName + ".log"
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
      if Left$(l$,4)<>"Pawn" then gosub PieceGone
      gosub PrintPiece
    endif
    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
  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
  IF RefLogOld THEN
    OPEN RefLog FOR APPEND AS #1
  ELSE
    OPEN RefLog FOR OUTPUT AS #1
    RefLogOld = -1
  END IF
  IF INSTR(Msg$, "|") > 0 THEN
    if left$(Msg$,4)<>"Pawn" then GOSUB Encrypt1
  endif
  PRINT #1, Msg$
  CLOSE
  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 Authorized% (c$, Pw#)
SimShow "Simulating " + c$ + " being authorized"
LINE INPUT "Password: "; Pw$
IF ASC(LEFT$(Pw$ + CHR$(0), 1)) = Pw# THEN
  PRINT "Authorized": Authorized% = -1
ELSE
  PRINT "Not Authorized": Authorized% = 0
END IF
END FUNCTION

FUNCTION DisplayBoard$ (Mode$)
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
SimShow "Simulating DisplayBoard"
SELECT CASE Mode$
CASE "W": GOSUB White: GOSUB GetMove
CASE "B": GOSUB Black: GOSUB GetMove
CASE "BW-W", "BW-B": GOSUB Both
CASE "w": GOSUB White
CASE "b": GOSUB Black
CASE ELSE: STOP: 'bug
END SELECT
EXIT FUNCTION

Both:
IF Mode$ = "BW-B" THEN
  PRINT "Would display whole board from Black's perspective"
  RETURN
END IF
IF Mode$ = "BW-W" THEN
  PRINT "Would display whole board from White's perspective"
  RETURN
END IF
STOP: 'bug
RETURN

White:
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF zP < 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      PRINT MID$("KQBNRPKRP", zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "a b c d e f g h"
RETURN

Black:
FOR zR = 1 TO 8
  FOR zC = 8 TO 1 STEP -1
    zP = Board(zC, zR)
    IF zP > 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      COLOR 0, 7
      PRINT MID$("KQBNRPKRP", -zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "h g f e d c b a"
RETURN

GetMove:
CALL ShowBoard("Sleep")
DO
  IF Mode$ = "B" THEN PRINT "Black";  ELSE PRINT "White";
  LINE INPUT "'s move: "; xxx$
  IF LCASE$(xxx$) = "break" THEN MacBreak% = -1
LOOP WHILE LCASE$(xxx$) = "break"
DisplayBoard$ = xxx$
IF xxx$ = "" THEN DisplayBoard$ = "Resign": RETURN
IF NOT (LEN(xxx$) = 5 AND MID$(xxx$, 3, 1) = "-") THEN
  INPUT "Really?"; r$
  IF UCASE$(r$) <> "Y" THEN GOTO GetMove ELSE RETURN
END IF
MacTemp LEFT$(xxx$, 2), zAH%, z18%
IF zAH% = 0 THEN GOTO MacGoof
SELECT CASE Board(zAH%, z18%)
CASE 0: GOTO MacGoof
CASE IS > 0: IF Mode$ = "B" THEN GOTO MacGoof
CASE IS < 0: IF Mode$ = "W" THEN GOTO MacGoof
END SELECT
MacTemp RIGHT$(xxx$, 2), yAH%, y18%
IF yAH% = 0 THEN GOTO MacGoof
IF MacBreak% THEN STOP
RETURN
MacGoof: PRINT "Try again, Mac": GOTO GetMove
END FUNCTION

FUNCTION GetInitialPassword# (c$)
PRINT : PRINT
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: EXIT FUNCTION
IF p$ <> c$ THEN GetInitialPassword# = ASC(LEFT$(p$, 1)): 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)
OPEN GameName + ".pwd" FOR APPEND AS #1: CLOSE
OPEN GameName + ".pwd" FOR INPUT AS #1
IF EOF(1) THEN l$ = SPACE$(30) ELSE LINE INPUT #1, l$
CLOSE
IF LEN(l$) <> 30 THEN 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# = 47827: ' Not secure. Just for testing
END FUNCTION

SUB Introduction (n$, t%)
CLS : LOCATE 24, 1
SimShow "Simulation of the Kriegspiel Referee Introduction SUB"
PRINT "This sub will list games in progress, if any, and promt the user"
PRINT "to select an existing game, start a new game, or exit"
n$ = "DummyNme"
PRINT "For the simulation, there is only one game: "; n$
PRINT "Enter 1=existing, 2=new, 3=exit"
DO
  INPUT "123: ", o%
  SELECT CASE o%
  CASE 1:
    PRINT "You chose to continue existing game "; n$
    t% = 1: EXIT SUB
  CASE 2:
    PRINT "You chose to start a new game "; n$
    t% = 2: EXIT SUB
  CASE 3:
    PRINT "You chose to exit the program"
    t% = 3: EXIT SUB
  END SELECT
LOOP
END SUB

SUB MacTemp (Code$, zAH%, z18%)
IF LEN(Code$) <> 2 THEN STOP
tAH% = INSTR("abcdefgh", LEFT$(Code$, 1))
zAH% = tAH%
IF tAH% = 0 THEN EXIT SUB
t18% = VAL(RIGHT$(Code$, 1))
z18% = t18%
IF t18% = 0 THEN zAH% = 0
END SUB

FUNCTION MakeMove% (c$)
SimShow "Simulating " + c$ + "'s turn"
PRINT "Board as seen by "; c$
IF c$ = "White" THEN
  FOR zRow = 8 TO 1 STEP -1
    FOR zCol = 1 TO 8
      k$ = "-"
      IF WBoard(zCol, zRow) <> 0 THEN k$ = Piece(WBoard(zCol, zRow))
      IF Board(zCol, zRow) > 0 THEN k$ = Piece(Board(zCol, zRow))
      PRINT k$;
    NEXT zCol
    PRINT zRow
  NEXT zRow
  PRINT "abcdefgh"
ELSE
  FOR zRow = 1 TO 8
    FOR zCol = 8 TO 1 STEP -1
      k$ = "-"
      IF BBoard(zCol, zRow) <> 0 THEN k$ = Piece(BBoard(zCol, zRow))
      IF Board(zCol, zRow) < 0 THEN k$ = Piece(Board(zCol, zRow))
      PRINT k$;
    NEXT zCol
    PRINT zRow
  NEXT zRow
  PRINT "hgfedcba"
END IF
PRINT
DO
  PRINT
  PRINT "{Make move} or   2={Will move later}   3={Game Over} 4={Stick Piece}"
  LINE INPUT "Move: "; m$: IF m$ = "" THEN STOP
  IF m$ = "4" THEN
    m$ = "skip"
    IF c$ = "White" THEN
      WBoard(5, 5) = -1: PRINT "Stuck a Black King on White's board"
    ELSE
      BBoard(6, 5) = 2: PRINT "Stuck a White Queen on Black's board"
    END IF
  END IF
  IF m$ = "1" THEN m$ = "e1-e1"
  r% = VAL(m$)
  IF LEN(m$) = 5 THEN
    r% = 1
  ELSEIF LEN(m$) = 1 THEN
    r% = VAL(m$): IF r% < 2 OR r% > 3 THEN r% = 0
  ELSE
    r% = 0
  END IF
LOOP WHILE r% = 0
MakeMove% = r%
IF r% > 1 THEN EXIT FUNCTION
zCol = INSTR("abcdefgh", MID$(m$, 1, 1))
zRow = VAL(MID$(m$, 2, 1))
k% = Board(zCol, zRow)
Board(zCol, zRow) = 0
zCol = INSTR("abcdefgh", MID$(m$, 4, 1))
zRow = VAL(MID$(m$, 5, 1))
Board(zCol, zRow) = k%
END FUNCTION

FUNCTION Piece$ (p%)
IF p% = 0 THEN
  Piece$ = "-"
ELSE
  Piece$ = MID$("kQBNrPKRp", ABS(p%), 1)
END IF
END FUNCTION

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
m = m + pwW + pwB
w$ = m: ' Removed for simulation: 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 = l$: ' Simulation: remove 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
pwW = MID$(m, LEN(m$) - 29, 15): pwB = RIGHT$(m, 15)
END SUB

SUB ShowBoard (DoDis$)
IF DoDis$ = "Sleep" THEN
  PRINT "Press key to show the full board (For DM4BAB debugging)"
  SLEEP
  FOR uR% = 1 TO 10000
    k$ = INKEY$: IF k$ = CHR$(27) THEN DoDat% = -1
  NEXT uR%
END IF

DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
CLS
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF Dull THEN
      IF zP < 0 THEN zP = -zP: COLOR 0, 7
      IF zP = 0 THEN
        PRINT "-";
      ELSE
        PRINT MID$("kQBNrPKRp", zP, 1);
      END IF
      COLOR 7, 0: PRINT " ";
    ELSE
      COLOR 13 + SGN(zP) * 2, 7 - ((((zC MOD 2) XOR (zR MOD 2)) <> 0) AND 5)
      PRINT " "; MID$(" kQBNrPKRp", ABS(zP) + 1, 1);
    END IF
  NEXT zC
  IF Dull THEN
    PRINT zR
  ELSE
    COLOR 7, 0
    PRINT " "; CHR$(&H30 + zR)
  END IF
NEXT zR
IF NOT Dull THEN PRINT " ";
PRINT "a b c d e f g h"
IF DoDat% THEN STOP
END SUB

SUB SimShow (m$)
PRINT : PRINT : PRINT STRING$(LEN(m$), "=")
PRINT m$: PRINT STRING$(LEN(m$), "=")
END SUB