DM3BC

CLS
PRINT "DM3BC-Introduction"
PRINT "------------------"
PRINT
LINE INPUT "Press Enter to begin testing: "; j$

1 :
DIM GameName AS STRING
DIM GameType AS INTEGER
' ========================================================
CONST GameMax = 50: ' Max number of saved games supported
DIM SHARED MenuOption(GameMax + 4) AS STRING
' ========================================================
CALL Introduction(GameName, GameType)
' 1=Existing game 2=New game 3=Exit
CLS
SELECT CASE GameType
CASE 1:
  g$ = " game named " + CHR$(34) + GameName + CHR$(34)
  PRINT "You elected to continue old"; g$
CASE 2:
  g$ = " game named " + CHR$(34) + GameName + CHR$(34)
  PRINT "You elected to start a new"; g$
CASE 3:
  PRINT "You elected to quit": SYSTEM
CASE ELSE
  STOP: 'bug
END SELECT
PRINT : PRINT "Press key for next test"
WHILE INKEY$ = "": WEND
RUN 1

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