Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Topics - Jaze

Pages: [1] 2

QB64 Discussion / Time Calculator

« on: April 14, 2022, 08:05:31 pm »

Code: QB64: [Select]

_TITLE "Time Calculator" ' I do wonder if I should start planning before I begin to code...
'Author: Jaze James McAskill (mcaskilljaze@gmail.com)
'License: Freeware if anyone can remember what that is.
'            All I ask is that if you copy part or all
'           of this code you keep my name on it
 
CONST TRUE% = 1
CONST FALSE% = -1
CONST AM% = -1
CONST PM% = 1
 
 
WIDTH 80, 50
_FULLSCREEN
 
 
DIM SHARED LeftArrowKey$: LeftArrowKey$ = CHR$(0) + "K"
DIM SHARED RightArrowKey$: RightArrowKey$ = CHR$(0) + "M"
DIM SHARED UpArrowKey$: UpArrowKey$ = CHR$(0) + "H"
DIM SHARED DownArrowKey$: DownArrowKey$ = CHR$(0) + "P"
CONST UpKeyHit% = 18432
CONST DownKeyHit% = 20480
CONST LeftKeyHit% = 19200
CONST RightKeyHit% = 19712
 
 
CLS
LOCATE 20, 1
 
 
CALL Menu
 
FUNCTION GetDateAndTime$ (Header$)
  HaltAndDisplay% = 0: UserCommand$ = "": HeaderCopy$ = "": Instructions$ = "": HighlightedOption% = 0
  yPos% = 0: xPos% = 0: GDTMonth% = 0: GDTDay% = 0: GDTYear% = 0: O% = 0: OP$ = "": MaxOption% = 0
  GDTHours% = 0: GDTMinutes% = 0: GDTSeconds% = 0: GDTRtn$ = ""
  MW$ = "": SomeKey% = 0: TimerStarted% = 0: FirstTime% = 0: Increment% = 0: TimeElapsed% = 0
 
  HaltAndDisplay% = TRUE: yPos% = 15: xPos% = 17: HighlightedOption% = 1: MaxOption% = 6
  GDTMonth% = VAL(LEFT$(DATE$, 2)): GDTDay% = VAL(MID$(DATE$, 4, 2)): GDTYear% = VAL(RIGHT$(DATE$, 4))
  GDTHours% = VAL(LEFT$(TIME$, 2)): GDTMinutes% = VAL(MID$(TIME$, 4, 2)): GDTSeconds% = VAL(RIGHT$(TIME$, 2))
  TimerStarted% = FALSE%: Increment% = 1
  DO
    UserCommand$ = INKEY$
    IF HaltAndDisplay% = TRUE% THEN
      xPos% = 17: yPos% = 15
      HeaderCopy$ = Header$
      COLOR 14, 1: CLS
      COLOR 15
      IF LEN(Header$) >= 50 THEN
        LOCATE 3, 1: PRINT LongCenter(HeaderCopy$, 50, FALSE%)
      ELSE LOCATE 3, Center(HeaderCopy$): PRINT HeaderCopy$: END IF
      COLOR 12, 1: Instructions$ = "Use the arrow keys to select the date and time - Push "
      Instructions$ = Instructions$ + CHR$(34) + "X" + CHR$(34) + " to exit to the system - Push [ESC] to reset - Push [ENTER] to confirm"
      LOCATE 46, 1: PRINT LongCenter$(Instructions$, 50, FALSE)
 
      LOCATE yPos% - 5, xPos%: IF HighlightedOption% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Month"
      MW$ = "": MW$ = MonthWord$(GDTMonth% - 1): COLOR 14, 1
      LOCATE yPos% - 2, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
      MW$ = "": MW$ = MonthWord$(GDTMonth%): COLOR 10, 0
      LOCATE yPos%, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
      MW$ = "": MW$ = MonthWord$(GDTMonth% + 1): COLOR 14, 1
      LOCATE yPos% + 2, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
 
      LOCATE yPos% - 5, xPos% + 20: IF HighlightedOption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Day"
      COLOR 14, 1: O% = 0: O% = CorrectDay(GDTMonth%, GDTDay% - 1, GDTYear%)
      OP$ = "": OP$ = S$(O%) + Suffix$(O%)
      LOCATE yPos% - 2, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
      COLOR 10, 0: OP$ = "": O% = 0: OP$ = S$(GDTDay%) + Suffix$(GDTDay%)
      LOCATE yPos%, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
      COLOR 14, 1: O% = 0: O% = CorrectDay(GDTMonth%, GDTDay% + 1, GDTYear%)
      OP$ = "": OP$ = S$(O%) + Suffix$(O%)
      LOCATE yPos% + 2, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
 
      LOCATE yPos% - 5, xPos% + 40: IF HighlightedOption% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Year"
      COLOR 14, 1: O% = 0: O% = GDTYear% - 1: IF O% = -1 THEN O% = 9999
      LOCATE yPos% - 2, CenterBetween(S$(O%), xPos% + 40, xPos% + 44): PRINT S$(O%)
      COLOR 10, 0: LOCATE yPos%, CenterBetween(S$(GDTYear%), xPos% + 40, xPos% + 44): PRINT S$(GDTYear%)
      COLOR 14, 1: O% = 0: O% = GDTYear% + 1: IF O% > 9999 THEN O% = 0
      LOCATE yPos% + 2, CenterBetween(S$(O%), xPos% + 40, xPos% + 44): PRINT S$(O%)
 
      COLOR 10, 1: a$ = "": a$ = WrittenOutDate$(GDTMonth%, GDTDay%, GDTYear%) + " at " + ClockString$(GDTHours%, GDTMinutes%, GDTSeconds%)
      LOCATE yPos% + 9, Center(a$): PRINT a$
 
      yPos% = yPos% + 21
 
      IF HighlightedOption% = 4 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos%: PRINT "Hours"
      LOCATE yPos% - 2, xPos% + 2
      COLOR 14, 1:
      IF GDTHours% - 1 = -1 THEN
        PRINT "11"
      ELSEIF GDTHours% - 1 = 0 THEN PRINT "12"
      ELSEIF GDTHours% - 1 > 0 AND GDTHours% - 1 <= 12 THEN PRINT S$(GDTHours% - 1)
      ELSEIF GDTHours% - 1 >= 13 AND GDTHours% - 1 <= 23 THEN PRINT S$(GDTHours% - 1 - 12): END IF
      LOCATE yPos%, xPos% + 2: COLOR 10, 0
      IF GDTHours% = 0 THEN
        PRINT "12"
      ELSEIF GDTHours% > 0 AND GDTHours% <= 12 THEN PRINT S$(GDTHours%)
      ELSEIF GDTHours% > 12 AND GDTHours% < 24 THEN PRINT S$(GDTHours% - 12): END IF
      LOCATE yPos% + 2, xPos% + 2: COLOR 14, 1
      IF GDTHours% + 1 >= 1 AND GDTHours% + 1 < 13 THEN
        PRINT S$(GDTHours% + 1)
      ELSEIF GDTHours% + 1 >= 13 AND GDTHours% + 1 <= 24 THEN PRINT S$(GDTHours% + 1 - 12): END IF
 
      IF HighlightedOption% = 5 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos% + 16: PRINT "Minutes"
      LOCATE yPos% - 2, xPos% + 18: COLOR 14, 1
      IF GDTMinutes% - 1 = -1 THEN
        PRINT "59"
      ELSEIF GDTMinutes% - 1 >= 0 AND GDTMinutes% - 1 <= 59 THEN
        IF GDTMinutes% - 1 < 10 THEN PRINT "0";:
        PRINT S$(GDTMinutes% - 1)
      END IF
      LOCATE yPos%, xPos% + 18: COLOR 10, 0: IF GDTMinutes% < 10 THEN PRINT "0";
      PRINT S$(GDTMinutes%)
      LOCATE yPos% + 2, xPos% + 18: COLOR 14, 1
      IF GDTMinutes% + 1 >= 0 AND GDTMinutes% + 1 <= 59 THEN
        IF GDTMinutes% + 1 < 10 THEN PRINT "0";
        PRINT S$(GDTMinutes% + 1)
      ELSEIF GDTMinutes% + 1 = 60 THEN PRINT "00"
      END IF
 
      IF HighlightedOption% = 6 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos% + 32: PRINT "Seconds"
      LOCATE yPos% - 2, xPos% + 36: COLOR 14, 1
      IF GDTSeconds% - 1 = -1 THEN
        PRINT "59"
      ELSEIF GDTSeconds% - 1 >= 0 AND GDTSeconds% <= 59 THEN
        PRINT S$(GDTSeconds% - 1)
      END IF
      LOCATE yPos%, xPos% + 36: COLOR 10, 0
      PRINT S$(GDTSeconds%)
      LOCATE yPos% + 2, xPos% + 36: COLOR 14, 1
      IF gdtseonds% + 1 >= 0 AND GDTSeconds% + 1 <= 59 THEN
        PRINT S$(GDTSeconds% + 1)
      ELSEIF GDTSeconds% + 1 = 60 THEN PRINT "0": END IF
 
      LOCATE yPos% - 2, xPos% + 50: COLOR 14, 1
      IF GDTHours% - 1 >= 0 AND GDTHours% - 1 <= 11 THEN
      PRINT "AM": ELSE PRINT "PM": END IF
      LOCATE yPos%, xPos% + 50: COLOR 10, 0
      IF GDTHours% < 12 THEN
      PRINT "AM": ELSE PRINT "PM": END IF
      LOCATE yPos% + 2, xPos% + 50: COLOR 14, 1
      IF GDTHours% + 1 >= 0 AND GDTHours% + 1 <= 11 OR GDTHours% + 1 = 24 THEN
      PRINT "AM": ELSE: PRINT "PM": END IF
 
      HaltAndDisplay% = FALSE
    END IF
 
    SomeKey% = _KEYHIT
    IF SomeKey% = UpKeyHit% OR SomeKey% = DownKeyHit% THEN
      IF TimerStarted% = FALSE% THEN
        FirstTime% = TIMER
        TimerStarted% = TRUE%
      END IF
    END IF
    IF SomeKey% < 0 THEN
      FirstTime% = 0
      Increment% = 1
      TimeElapsed% = 0
      TimerStarted% = FALSE%
    END IF
    TimeElapsed% = ABS(TIMER - FirstTime%)
    IF TimeElapsed% = 2 THEN
      IF HighlightedOption% = 2 THEN Increment% = 2 'Day
      IF HighlightedOption% = 3 THEN Increment% = 10 'Year
      IF HighlightedOption% = 5 THEN Increment% = 2 'minutes
      IF HighlightedOption% = 6 THEN Increment% = 2 'seconds
    ELSEIF TimeElapsed% = 3 THEN
      IF HighlightedOption% = 3 THEN Increment% = 25
    ELSEIF TimeElapsed% = 4 THEN
      IF HighlightedOption% = 3 THEN Increment% = 50
    END IF
 
    SELECT CASE UserCommand$
      CASE LeftArrowKey$
        HighlightedOption% = HighlightedOption% - 1
        IF HighlightedOption% = 0 THEN HighlightedOption% = MaxOption%
        HaltAndDisplay% = TRUE%
      CASE RightArrowKey$
        HighlightedOption% = HighlightedOption% + 1
        IF HighlightedOption% > MaxOption% THEN HighlightedOption% = 1
        HaltAndDisplay% = TRUE%
      CASE UpArrowKey$
        IF HighlightedOption% = 1 THEN
          GDTMonth% = GDTMonth% - Increment%
          IF GDTMonth% <= 0 THEN GDTMonth% = 12
          IF GDTMonth% = 4 OR GDTMonth% = 6 OR GDTMonth% = 9 OR GDTMonth% = 11 THEN
            IF GDTDay% = 31 THEN GDTDay% = 30:
          ELSEIF GDTMonth% = 2 THEN
            IF GDTDay% > 29 AND GDTYear% MOD 4 = 0 THEN
              GDTDay% = 29
            ELSEIF GDTDay% >= 29 AND GDTYear% MOD 4 <> 0 THEN GDTDay% = 28
            END IF
          END IF
        ELSEIF HighlightedOption% = 2 THEN
          GDTDay% = GDTDay% - Increment%
          IF GDTDay% <= 0 THEN
            IF GDTMonth% = 4 OR GDTMonth% = 6 OR GDTMonth% = 9 OR GDTMonth% = 11 THEN
              GDTDay% = 30
            ELSEIF GDTMonth% = 2 AND GDTYear% MOD 4 = 0 THEN GDTDay% = 29
            ELSEIF GDTMonth% = 2 AND GDTYear% MOD 4 <> 0 THEN GDTDay% = 28
            ELSE GDTDay% = 31: END IF
          END IF
        ELSEIF HighlightedOption% = 3 THEN
          GDTYear% = GDTYear% - Increment%
          IF GDTYear% < 0 THEN GDTYear% = 9999
          GDTDay% = CorrectDay%(GDTMonth%, GDTDay%, GDTYear%)
        ELSEIF HighlightedOption% = 4 THEN
          GDTHours% = GDTHours% - 1
          IF GDTHours% < 0 THEN GDTHours% = 23
        ELSEIF HighlightedOption% = 5 THEN
          GDTMinutes% = GDTMinutes% - Increment%
          IF GDTMinutes% < 0 THEN GDTMinutes% = 59
        ELSEIF HighlightedOption% = 6 THEN
          GDTSeconds% = GDTSeconds% - Increment%
          IF GDTSeconds% < 0 THEN GDTSeconds% = 59
        END IF
        HaltAndDisplay% = TRUE%
      CASE DownArrowKey$
        IF HighlightedOption% = 1 THEN
          GDTMonth% = GDTMonth% + Increment%
          IF GDTMonth% > 12 THEN GDTMonth% = 1
          GDTDay% = CorrectDay%(GDTMonth%, GDTDay%, GDTYear%)
        ELSEIF HighlightedOption% = 2 THEN
          GDTDay% = GDTDay% + Increment%
          IF GDTDay% >= 29 THEN GDTDay% = CorrectDay(GDTMonth%, GDTDay%, GDTYear%)
        ELSEIF HighlightedOption% = 3 THEN
          GDTYear% = GDTYear% + Increment%
          IF GDTYear% > 9999 THEN GDTYear% = 0
          GDTDay% = CorrectDay%(GDTMonth%, GDTDay%, GDTYear%)
        ELSEIF HighlightedOption% = 4 THEN
          GDTHours% = GDTHours% + 1
          IF GDTHours% = 24 THEN GDTHours% = 0
        ELSEIF HighlightedOption% = 5 THEN
          GDTMinutes% = GDTMinutes% + Increment%
          IF GDTMinutes% >= 60 THEN GDTMinutes% = 0
        ELSEIF HighlightedOption% = 6 THEN
          GDTSeconds% = GDTSeconds% + Increment%
          IF GDTSeconds% >= 60 THEN GDTSeconds% = 0
        END IF
        HaltAndDisplay% = TRUE%
      CASE CHR$(27)
        GDTMonth% = VAL(LEFT$(DATE$, 2))
        GDTDay% = VAL(MID$(DATE$, 4, 2))
        GDTYear% = VAL(RIGHT$(DATE$, 4))
        GDTHours% = VAL(LEFT$(TIME$, 2))
        GDTMinutes% = VAL(MID$(TIME$, 4, 2))
        GDTSeconds% = VAL(RIGHT$(TIME$, 2))
        HaltAndDisplay% = TRUE%
      CASE "X", "x"
        SYSTEM
      CASE CHR$(13)
        GDTRtn$ = ""
        IF GDTYear% < 10 THEN
          GDTRtn$ = "000"
        ELSEIF GDTYear% >= 10 AND GDTYear% < 100 THEN GDTRtn$ = "00"
        ELSEIF GDTYear% >= 100 AND GDTYear% < 1000 THEN GDTRtn$ = "0": END IF
        GDTRtn$ = GDTRtn$ + S$(GDTYear%) + ":"
        tempDay% = 0: tempDay% = DaysPassedJanFromMonthDayYear(GDTMonth%, GDTDay%, GDTYear%)
        IF tempDay% < 10 THEN
          GDTRtn$ = GDTRtn$ + "00"
        ELSEIF tempDay% >= 10 AND tempDay% < 100 THEN GDTRtn$ = GDTRtn$ + "0": END IF
        GDTRtn$ = GDTRtn$ + S$(tempDay%) + ":"
        IF GDTHours% < 10 THEN GDTRtn$ = GDTRtn$ + "0"
        GDTRtn$ = GDTRtn$ + S$(GDTHours%) + ":"
        IF GDTMinutes% < 10 THEN GDTRtn$ = GDTRtn$ + "0"
        GDTRtn$ = GDTRtn$ + S$(GDTMinutes%) + ":"
        IF GDTSeconds% < 10 THEN GDTRtn$ = GDTRtn$ + "0"
        GDTRtn$ = GDTRtn$ + S$(GDTSeconds%)
    END SELECT
  LOOP UNTIL UserCommand$ = CHR$(13)
  GetDateAndTime$ = GDTRtn$
END FUNCTION
 
FUNCTION ClockString$ (CSHours%, CSMinutes%, CSSeconds%)
  DisplayHours$ = "": CSRtn$ = "": AmPm$ = ""
 
  IF CSHours% = 0 THEN
    DisplayHours$ = "12"
    AmPm$ = "AM"
  ELSEIF CSHours% >= 1 AND CSHours% <= 11 THEN
    DisplayHours$ = S$(CSHours%)
    AmPm$ = "AM"
  ELSEIF CSHours% = 12 THEN
    DisplayHours$ = "12"
    AmPm$ = "PM"
  ELSEIF CSHours% > 12 AND CSHours% <= 23 THEN
    DisplayHours$ = S$(CSHours% - 12)
    AmPm$ = "PM"
  END IF
 
  CSRtn$ = DisplayHours$ + ":"
  IF CSMinutes% < 10 THEN CSRtn$ = CSRtn$ + "0"
  CSRtn$ = CSRtn$ + S$(CSMinutes%) + " " + AmPm$ + " and " + S$(CSSeconds%) + " second"
  IF CSSeconds% <> 1 THEN CSRtn$ = CSRtn$ + "s"
 
  ClockString$ = CSRtn$
 
END FUNCTION
 
FUNCTION GetDate$ (Header$)
  xPos% = 0: yPos% = 0: MaxOption% = 0: HighlightedOption% = 0
  HaltAndDisplay% = 0: UserCommand$ = "": Instructions$ = "": TimerStarted% = 0: FirstTime% = 0: TimeElapsed% = 0
  GDMonth% = 0: GDDay% = 0: GDYear% = 0: MW$ = "": Increment% = 0: MinOption% = 0: HeaderCopy$ = "": GDRtn$ = ""
 
  HaltAndDisplay% = TRUE%: yPos% = 22: xPos% = 19: HighlightedOption% = 1: Increment% = 1
  MaxOption% = 3: MinOption% = 1: HeaderCopy$ = Header$
  GDMonth% = VAL(LEFT$(DATE$, 2)): GDDay% = VAL(MID$(DATE$, 4, 2)): GDYear% = VAL(RIGHT$(DATE$, 4))
  TimerStarted% = FALSE
 
  DO
    UserCommand$ = INKEY$
    IF HaltAndDisplay% = TRUE% THEN
      HeaderCopy$ = Header$
      COLOR 14, 1: CLS
      COLOR 15
      IF LEN(Header$) >= 50 THEN
        LOCATE 7, 1: PRINT LongCenter(HeaderCopy$, 50, FALSE%)
      ELSE LOCATE 7, Center(HeaderCopy$): PRINT HeaderCopy$: END IF
      COLOR 12, 1: Instructions$ = "Use the arrow keys to select the date - Push [ESC] to reset - Push "
      Instructions$ = Instructions$ + CHR$(34) + "X" + CHR$(34) + " to exit to the system - "
      Instructions$ = Instructions$ + "Push [ENTER] when you have selected the desired date"
      LOCATE yPos% + 20, 1: PRINT LongCenter$(Instructions$, 60, FALSE%)
 
      LOCATE yPos% - 5, xPos%: IF HighlightedOption% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Month"
      MW$ = "": MW$ = MonthWord$(GDMonth% - 1): COLOR 14, 1
      LOCATE yPos% - 2, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
      MW$ = "": MW$ = MonthWord$(GDMonth%): COLOR 10, 0
      LOCATE yPos%, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
      MW$ = "": MW$ = MonthWord$(GDMonth% + 1): COLOR 14, 1
      LOCATE yPos% + 2, CenterBetween(MW$, xPos% - 3, xPos% + 8): PRINT MW$
 
      LOCATE yPos% - 5, xPos% + 20: IF HighlightedOption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Day"
      COLOR 14, 1: O% = 0: O% = CorrectDay(GDMonth%, GDDay% - 1, GDYear%)
      OP$ = "": OP$ = S$(O%) + Suffix$(O%)
      LOCATE yPos% - 2, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
      COLOR 10, 0: OP$ = "": O% = 0: OP$ = S$(GDDay%) + Suffix$(GDDay%)
      LOCATE yPos%, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
      COLOR 14, 1: O% = 0: O% = CorrectDay(GDMonth%, GDDay% + 1, GDYear%)
      OP$ = "": OP$ = S$(O%) + Suffix$(O%)
      LOCATE yPos% + 2, CenterBetween(OP$, xPos% + 19, xPos% + 22): PRINT OP$
 
      LOCATE yPos% - 5, xPos% + 40: IF HighlightedOption% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Year"
      COLOR 14, 1: O% = 0: O% = GDYear% - 1: IF O% = -1 THEN O% = 9999
      LOCATE yPos% - 2, CenterBetween(S$(O%), xPos% + 40, xPos% + 44): PRINT S$(O%)
      COLOR 10, 0: LOCATE yPos%, CenterBetween(S$(GDYear%), xPos% + 40, xPos% + 44): PRINT S$(GDYear%)
      COLOR 14, 1: O% = 0: O% = GDYear% + 1: IF O% > 9999 THEN O% = 0
      LOCATE yPos% + 2, CenterBetween(S$(O%), xPos% + 40, xPos% + 44): PRINT S$(O%)
 
      COLOR 10, 0: a$ = "": a$ = WrittenOutDate$(GDMonth%, GDDay%, GDYear%)
      LOCATE yPos% + 10, Center(a$): PRINT a$
 
      HaltAndDisplay% = FALSE%
    END IF
 
    SomeKey% = _KEYHIT
    IF SomeKey% = UpKeyHit% OR SomeKey% = DownKeyHit% THEN
      IF TimerStarted% = FALSE% THEN
        FirstTime% = TIMER
        TimerStarted% = TRUE%
      END IF
    END IF
    IF SomeKey% < 0 THEN
      FirstTime% = 0
      Increment% = 1
      TimeElapsed% = 0
      TimerStarted% = FALSE%
    END IF
    TimeElapsed% = ABS(TIMER - FirstTime%)
    IF TimeElapsed% = 2 THEN
      IF HighlightedOption% = 3 THEN Increment% = 15
    ELSEIF TimeElapsed% = 3 THEN
      IF HighlightedOption% = 2 THEN Increment% = 2
      IF HighlightedOption% = 3 THEN Increment% = 25
    ELSEIF TimeElapsed% = 4 THEN
      IF HighlightedOption% = 3 THEN Increment% = 35
    ELSEIF TimeElapsed% = 6 THEN
      IF HighlightedOption% = 3 THEN Increment% = 65
    END IF
 
    SELECT CASE UserCommand$
      CASE UpArrowKey$
        IF HighlightedOption% = 1 THEN
          GDMonth% = GDMonth% - Increment%
          IF GDMonth% <= 0 THEN GDMonth% = 12
          IF GDMonth% = 4 OR GDMonth% = 6 OR GDMonth% = 9 OR GDMonth% = 11 THEN
            IF GDDay% = 31 THEN GDDay% = 30:
          ELSEIF GDMonth% = 2 THEN
            IF GDDay% > 29 AND GDYear% MOD 4 = 0 THEN
              GDDay% = 29
            ELSEIF GDDay% >= 29 AND GDYear% MOD 4 <> 0 THEN GDDay% = 28
            END IF
          END IF
        ELSEIF HighlightedOption% = 2 THEN
          GDDay% = GDDay% - Increment%
          IF GDDay% <= 0 THEN
            IF GDMonth% = 4 OR GDMonth% = 6 OR GDMonth% = 9 OR GDMonth% = 11 THEN
              GDDay% = 30
            ELSEIF GDMonth% = 2 AND GDYear% MOD 4 = 0 THEN GDDay% = 29
            ELSEIF GDMonth% = 2 AND GDYear% MOD 4 <> 0 THEN GDDay% = 28
            ELSE GDDay% = 31: END IF
          END IF
        ELSEIF HighlightedOption% = 3 THEN
          GDYear% = GDYear% - Increment%
          IF GDYear% < 0 THEN GDYear% = 9999
          GDDay% = CorrectDay%(GDMonth%, GDDay%, GDYear%)
        END IF
        HaltAndDisplay% = TRUE%
      CASE DownArrowKey$
        IF HighlightedOption% = 1 THEN
          GDMonth% = GDMonth% + Increment%
          IF GDMonth% > 12 THEN GDMonth% = 1
          GDDay% = CorrectDay%(GDMonth%, GDDay%, GDYear%)
        ELSEIF HighlightedOption% = 2 THEN
          GDDay% = GDDay% + Increment%
          IF GDDay% >= 29 THEN GDDay% = CorrectDay(GDMonth%, GDDay%, GDYear%)
        ELSEIF HighlightedOption% = 3 THEN
          GDYear% = GDYear% + Increment%
          IF GDYear% > 9999 THEN GDYear% = 0
          GDDay% = CorrectDay%(GDMonth%, GDDay%, GDYear%)
        END IF
        HaltAndDisplay% = TRUE%
      CASE RightArrowKey$
        HighlightedOption% = HighlightedOption% + 1
        IF HighlightedOption% > MaxOption% THEN HighlightedOption% = MinOption%
        HaltAndDisplay% = TRUE%
      CASE LeftArrowKey$
        HighlightedOption% = HighlightedOption% - 1
        IF HighlightedOption% < MinOption% THEN HighlightedOption% = MaxOption%
        HaltAndDisplay% = TRUE%
      CASE CHR$(27)
        GDMonth% = VAL(LEFT$(DATE$, 2))
        GDDay% = VAL(MID$(DATE$, 4, 2))
        GDYear% = VAL(RIGHT$(DATE$, 4))
      CASE "X", "x"
        SYSTEM
      CASE CHR$(13)
        GDRtn$ = ""
        GDRtn$ = MakeFormattedDATE$(GDMonth%, GDDay%, GDYear%)
    END SELECT
  LOOP UNTIL UserCommand$ = CHR$(13)
  GetDate$ = GDRtn$
END FUNCTION
 
FUNCTION MakeFormattedDATE$ (MFMonth%, MFDay%, MFYear%)
  MFDRtn$ = ""
 
  IF MFMonth% < 10 THEN MFDRtn$ = "0"
  MFDRtn$ = MFDRtn$ + S$(MFMonth%) + "/"
  IF MFDay% < 10 THEN MFDRtn$ = MFDRtn$ + "0"
  MFDRtn$ = MFDRtn$ + S$(MFDay%) + "/"
  IF MFYear% < 10 THEN
    MFDRtn$ = MFDRtn$ + "000"
  ELSEIF MFYear% >= 10 AND MFYear% < 100 THEN MFDRtn$ = MFDRtn$ + "00"
  ELSEIF MFYear% >= 100 AND MFYear% < 1000 THEN MFDRtn$ = MFDRtn$ + "0": END IF
  MFDRtn$ = MFDRtn$ + S$(MFYear%)
 
  MakeFormattedDATE$ = MFDRtn$
 
END FUNCTION
 
FUNCTION WrittenOutDate$ (WODMonth%, WODDay%, WODYear%)
  WODRtn$ = ""
  WODRtn$ = MonthWord$(WODMonth%)
  WODRtn$ = WODRtn$ + " "
  WODRtn$ = WODRtn$ + S$(WODDay%) + Suffix(WODDay%)
  WODRtn$ = WODRtn$ + ", "
  WODRtn$ = WODRtn$ + S$(WODYear%)
 
  WrittenOutDate$ = WODRtn$
END FUNCTION
 
FUNCTION CorrectDay% (CDMonth%, CDDay%, CDYear%)
  CDRtn% = 0
 
  SELECT CASE CDDay%
    CASE IS <= 0
      IF CDMonth% = 1 OR CDMonth% = 3 OR CDMonth% = 5 OR CDMonth% = 7 OR CDMonth% = 8 OR CDMonth% = 10 OR CDMonth% = 12 THEN
        CDRtn% = 31
      ELSEIF CDMonth% = 4 OR CDMonth% = 6 OR CDMonth% = 9 OR CDMonth% = 11 THEN
        CDRtn% = 30
      ELSEIF CDMonth% = 2 THEN
        IF CDYear% MOD 4 = 0 THEN
        CDRtn% = 29: ELSE CDRtn% = 28: END IF
      END IF
    CASE 29
      IF CDMonth% = 2 AND CDYear% MOD 4 <> 0 THEN
        CDRtn% = 1
      ELSE CDRtn% = CDDay%: END IF
    CASE 30
      IF CDMonth% = 2 AND CDYear% MOD 4 = 0 THEN
      CDRtn% = 1: ELSE CDRtn% = CDDay%: END IF
    CASE 31
      IF CDMonth% = 4 OR CDMonth% = 6 OR CDMonth% = 9 OR CDMonth% = 11 THEN
        CDRtn% = 1
      ELSE CDRtn% = CDDay%: END IF
    CASE IS >= 32
      CDRtn% = 1
    CASE ELSE
      CDRtn% = CDDay%
  END SELECT
  CorrectDay% = CDRtn%
END FUNCTION
 
FUNCTION CenterBetween% (text$, MinX%, MaxX%)
  CBRtn% = 0
  IF LEN(text$) + MinX% >= MaxX% THEN
    CBRtn% = MinX%
  ELSE
    CBRtn% = INT((MaxX% - MinX% - LEN(text$)) / 2) + MinX%
  END IF
  CenterBetween = CBRtn%
END FUNCTION
 
SUB FromNowUntil
  FNUMonth% = 0: FNUDay% = 0: FNUYear% = 0: FNUHour% = 0: FNUMinute% = 0: FNUSecond% = 0
  FNUHeader$ = "": FNUTargetFormatDATE$ = "": FNUTargetMonth% = 0: FNUTargetDay% = 0: FNUTargetYear% = 0
  FNUTargetFormatTIME$ = "": FNUTargetHour% = 0: FNUTargetMinute% = 0: FNUTargetSecond% = 0: FNUTargetDayCopy% = 0
  FNUFinalDay% = 0: FNUFinalMonth% = 0: FNUFinalYear% = 0: FNUFinalHour% = 0: FNUFinalMinute% = 0: FNUFinalSecond% = 0
  a$ = "": LeftChar$ = ""
 
  FNUMonth% = VAL(LEFT$(DATE$, 2))
  FNUDay% = VAL(MID$(DATE$, 4, 2))
  FNUYear% = VAL(RIGHT$(DATE$, 4))
  FNUDay% = DaysPassedJanFromMonthDayYear(FNUMonth%, FNUDay%, FNUYear%)
  FNUHour% = VAL(LEFT$(TIME$, 2))
  FNUMinute% = VAL(MID$(TIME$, 4, 2))
  FNUSecond% = VAL(RIGHT$(TIME$, 2))
 
  FNUHeader$ = "Select A Target Date$"
  FNUTargetFormatDATE$ = GetDate$(FNUHeader$)
  PRINT: PRINT: PRINT
  FNUTargetMonth% = VAL(LEFT$(FNUTargetFormatDATE$, 2))
  FNUTargetDay% = VAL(MID$(FNUTargetFormatDATE$, 4, 2))
  FNUTargetDayCopy% = FNUTargetDay%
  FNUTargetYear% = VAL(RIGHT$(FNUTargetFormatDATE$, 4))
  FNUTargetDay% = DaysPassedJanFromMonthDayYear(FNUTargetMonth%, FNUTargetDay%, FNUTargetYear%)
 
  FNUHeader$ = ""
  FNUHeader$ = "Select A Target Time On " + WrittenOutDate$(FNUTargetMonth%, FNUTargetDayCopy%, FNUTargetYear%)
  FNUTargetFormatTIME$ = GetTime$(FNUHeader$)
  FNUTargetHour% = VAL(LEFT$(FNUTargetFormatTIME$, 2))
  FNUTargetMinute% = VAL(MID$(FNUTargetFormatTIME$, 4, 4))
  FNUTargetSecond% = VAL(RIGHT$(FNUTargetFormatTIME$, 2))
 
  FNUFinalSecond% = FNUTargetSecond% - FNUSecond%
  IF FNUFinalSecond% < 0 THEN
    FNUTargetMinute% = FNUTargetMinute% - 1
    FNUFinalSecond% = FNUFinalSecond% + 60
  END IF
  FNUFinalMinute% = FNUTargetMinute% - FNUMinute%
  IF FinalMinute% < 0 THEN
    FNUTargetHour% = FNUTargetHour% - 1
    FNUFinalMinute% = FNUFinalMinute% + 60
  END IF
  FNUFinalHour% = FNUTargetHour% - FNUHour%
  IF FNUFinalHour% < 0 THEN
    FNUFinalHour% = FNUFinalHour% + 60
    FNUTargetDay% = FNUTargetDay% - 1
  END IF
  FNUFinalDay% = FNUTargetDay% - FNUDay%
  IF FNUFinalDay% < 0 THEN
    FNUFinalDay% = FNUFinalDay% + 366
    FNUTargetYear% = FNUTargetYear% - 1
  END IF
  FNUFinalYear% = FNUTargetYear% - FNUYear%
 
  COLOR 14, 1: CLS
  IF FNUFinalYear% < 0 THEN
    a$ = "": a$ = "The selected date and time is before now"
    LOCATE 25, Center(a$)
    PRINT a$
  ELSE
    a$ = "": a$ = MakeElapsedTimeShort$(FNUFinalYear%, FNUFinalDay%, FNUFinalHour%, FNUFinalMinute%, FNUFinalSecond%)
    a$ = ElapsedTimeWrittenOut$(a$)
    IF VAL(LEFT$(a$, 2)) = 1 THEN
      b$ = "There is"
    ELSE b$ = "There are": END IF
    LOCATE 15, Center(b$): PRINT b$
    LOCATE 20, Center(a$): PRINT a$
    LOCATE 25, Center("until"): PRINT "until"
    a$ = "": a$ = WrittenOutDate$(FNUTargetMonth%, FNUTargetDayCopy%, FNUTargetYear%)
    LOCATE 30, Center(a$): PRINT a$
    LOCATE 32, Center("at"): PRINT "at"
    a$ = "": a$ = ClockString$(FNUTargetHour%, FNUTargetMinute%, FNUTargetSecond%)
    LOCATE 34, Center(a$): PRINT a$
  END IF
 
  a$ = "": a$ = "Hit any key to continue"
  LOCATE 48, Center(a$): PRINT a$: ll$ = P$
END SUB
 
FUNCTION MakeElapsedTimeShort$ (MEYears%, MEDays%, MEHours%, MEMinutes%, MESeconds%)
  METSRtn$ = ""
 
  IF MEYears% < 10 THEN
    METSRtn$ = "000"
  ELSEIF MEYears% >= 10 AND MEYears% < 100 THEN METSRtn$ = "00"
  ELSEIF MEYears% >= 100 AND MEYears% < 1000 THEN METSRtn$ = "0": END IF
  METSRtn$ = METSRtn$ + S$(MEYears%) + ":"
 
  IF MEDays% < 10 THEN
    METSRtn$ = METSRtn$ + "00"
  ELSEIF MEDays% >= 10 AND MEDays% < 100 THEN
  METSRtn$ = METSRtn$ + "0": END IF
  METSRtn$ = METSRtn$ + S$(MEDays%) + ":"
 
  IF MEHours% < 10 THEN METSRtn$ = METSRtn$ + "0"
  METSRtn$ = METSRtn$ + S$(MEHours%) + ":"
 
  IF MEMinutes% < 10 THEN METSRtn$ = METSRtn$ + "0"
  METSRtn$ = METSRtn$ + S$(MEMinutes%) + ":"
 
  IF MESeconds% < 10 THEN METSRtn$ = METSRtn$ + "0"
  METSRtn$ = METSRtn$ + S$(MESeconds%)
 
  MakeElapsedTimeShort$ = METSRtn$
END FUNCTION
 
FUNCTION ElapsedTimeWrittenOut$ (TimeShortString$)
  ETWORtn$ = "": Years3% = 0: Days3% = 0: Hours3% = 0: Minutes3% = 0: Seconds3% = 0
 
  Years3% = VAL(LEFT$(TimeShortString$, 4))
  Days3% = VAL(MID$(TimeShortString$, 6, 3))
  Hours3% = VAL(MID$(TimeShortString$, 10, 2))
  Minutes3% = VAL(MID$(TimeShortString$, 13, 2))
  Seconds3% = VAL(RIGHT$(TimeShortString$, 2))
 
  IF Years3% <> 0 THEN
    IF Years3% >= 1000 AND Years3% <= 9999 THEN
      lftNum% = INT(Years3% / 1000)
      ETWORtn$ = S$(lftNum%) + ","
      rtNum% = Years3% - (lftNum% * 1000)
      IF rtNum% < 10 THEN
        ETWORtn$ = ETWORtn$ + "00"
      ELSEIF rtNum% >= 10 AND rtNum% < 100 THEN
        ETWORtn$ = ETWORtn$ + "0"
      END IF
      ETWORtn$ = ETWORtn$ + S$(rtNum%)
    ELSE
      ETWORtn$ = S$(Years3%)
    END IF
    ETWORtn$ = ETWORtn$ + " Year"
    IF Years3% <> 1 THEN ETWORtn$ = ETWORtn$ + "s"
    IF Days3% <> 0 AND (Hours3% <> 0 OR Minutes3% <> 0 OR Seconds3% <> 0) THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Days3% <> 0 AND (Hours3% = 0 AND Minutes3% = 0 AND Seconds3% = 0) THEN
      ETWORtn$ = ETWORtn$ + " and "
    ELSEIF Hours3% <> 0 AND (Minutes3% <> 0 OR Seconds3% <> 0) THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Hours3% <> 0 AND Minutes3% = 0 AND Seconds3% = 0 THEN
      ETWORtn$ = ETWORtn$ + " and "
    ELSEIF Minutes3% <> 0 AND Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Minutes3% <> 0 XOR Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + " and "
    END IF
  END IF
  IF Days3% <> 0 THEN
    ETWORtn$ = ETWORtn$ + S$(Days3%) + " Day"
    IF Days3% <> 1 THEN ETWORtn$ = ETWORtn$ + "s"
    IF Hours3% <> 0 AND (Minutes3% <> 0 OR Seconds3% <> 0) THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Hours3% <> 0 AND Minutes3% = 0 AND Seconds3% = 0 THEN
      ETWORtn$ = ETWORtn$ + " and "
    ELSEIF Minutes3% <> 0 AND Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Minutes3% <> 0 XOR Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + " and "
    END IF
  END IF
  IF Hours3% <> 0 THEN
    ETWORtn$ = ETWORtn$ + S$(Hours3%) + " hour"
    IF Hours3% <> 1 THEN ETWORtn$ = ETWORtn$ + "s"
    IF Minutes3% <> 0 AND Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + ", "
    ELSEIF Minutes3% <> 0 XOR Seconds3% <> 0 THEN
      ETWORtn$ = ETWORtn$ + " and "
    END IF
  END IF
  IF Minutes3% <> 0 THEN
    ETWORtn$ = ETWORtn$ + S$(Minutes3%) + " minute"
    IF Minutes3% <> 1 THEN ETWORtn$ = ETWORtn$ + "s"
    IF Seconds3% <> 0 THEN ETWORtn$ = ETWORtn$ + " and "
  END IF
  IF Seconds3% <> 0 THEN
    ETWORtn$ = ETWORtn$ + S$(Seconds3%) + " second"
    IF Seconds3% <> 1 THEN ETWORtn$ = ETWORtn$ + "s"
  END IF
  IF Years3% = 0 AND Days3% = 0 AND Hours3% = 0 AND Minutes3% = 0 AND Seconds3% = 0 THEN ETWORtn$ = "Nothing"
  ElapsedTimeWrittenOut$ = ETWORtn$
END FUNCTION
 
 
FUNCTION GetTime$ (GTHeader$)
  HaltAndDisplay% = 0: GTHeaderCopy$ = "": Instructions$ = "": xPos% = 0: yPos% = 0: HighlightedOption% = 0
  GTHours% = 0: GTMinutes% = 0: GTSeconds% = 0: SomeKey% = 0: TimerStarted% = 0: GTClock$ = ""
  FirstTime% = 0: Increment% = 0: TimeElapsed% = 0: UserCommand$ = "": MaxOption% = 0: GTRtn$ = ""
 
  HaltAndDisplay% = TRUE%: xPos% = 13: yPos% = 25: HighlightedOption% = 1
  GTHours% = VAL(LEFT$(TIME$, 2)): GTMinutes% = VAL(MID$(TIME$, 4, 2)): GTSeconds% = VAL(RIGHT$(TIME$, 2))
  Increment% = 1: TimerStarted% = FALSE%: MaxOption% = 3
 
 
  DO
    UserCommand$ = INKEY$
 
    IF HaltAndDisplay% = TRUE% THEN
      GTHeaderCopy$ = GTHeader$
      COLOR 14, 1: CLS
      COLOR 15
      IF LEN(GTHeader$) >= 50 THEN
        LOCATE 6, 1: PRINT LongCenter(GTHeaderCopy$, 50, FALSE%)
      ELSE
        LOCATE 7, Center(GTHeaderCopy$)
        PRINT GTHeaderCopy$
      END IF
      COLOR 12, 1: Instructions$ = "Use the arrow keys to select the time. Push [ESC] to reset. Push "
      Instructions$ = Instructions$ + CHR$(34) + "X" + CHR$(34) + " to exit to the system. Push [ENTER] when you have selected the desired time"
      LOCATE 44, 1: PRINT LongCenter$(Instructions$, 60, FALSE%)
 
      IF HighlightedOption% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos%: PRINT "Hours"
      LOCATE yPos% - 2, xPos% + 2
      COLOR 14, 1:
      IF GTHours% - 1 = -1 THEN
        PRINT "11"
      ELSEIF GTHours% - 1 = 0 THEN PRINT "12"
      ELSEIF GTHours% - 1 > 0 AND GTHours% - 1 <= 12 THEN PRINT S$(GTHours% - 1)
      ELSEIF GTHours% - 1 >= 13 AND GTHours% - 1 <= 23 THEN PRINT S$(GTHours% - 1 - 12): END IF
      LOCATE yPos%, xPos% + 2: COLOR 10, 0
      IF GTHours% = 0 THEN
        PRINT "12"
      ELSEIF GTHours% > 0 AND GTHours% <= 12 THEN PRINT S$(GTHours%)
      ELSEIF GTHours% > 12 AND GTHours% < 24 THEN PRINT S$(GTHours% - 12): END IF
      LOCATE yPos% + 2, xPos% + 2: COLOR 14, 1
      IF GTHours% + 1 >= 1 AND GTHours% + 1 < 13 THEN
        PRINT S$(GTHours% + 1)
      ELSEIF GTHours% + 1 >= 13 AND GTHours% + 1 <= 24 THEN PRINT S$(GTHours% + 1 - 12): END IF
 
      IF HighlightedOption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos% + 16: PRINT "Minutes"
      LOCATE yPos% - 2, xPos% + 18: COLOR 14, 1
      IF GTMinutes% - 1 = -1 THEN
        PRINT "59"
      ELSEIF GTMinutes% - 1 >= 0 AND GTMinutes% - 1 <= 59 THEN
        IF GTMinutes% - 1 < 10 THEN PRINT "0";:
        PRINT S$(GTMinutes% - 1)
      END IF
      LOCATE yPos%, xPos% + 18: COLOR 10, 0: IF GTMinutes% < 10 THEN PRINT "0";
      PRINT S$(GTMinutes%)
      LOCATE yPos% + 2, xPos% + 18: COLOR 14, 1
      IF GTMinutes% + 1 >= 0 AND GTMinutes% + 1 <= 59 THEN
        IF GTMinutes% + 1 < 10 THEN PRINT "0";
        PRINT S$(GTMinutes% + 1)
      ELSEIF GTMinutes% + 1 = 60 THEN PRINT "00"
      END IF
 
      IF HighlightedOption% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      LOCATE yPos% - 5, xPos% + 32: PRINT "Seconds"
      LOCATE yPos% - 2, xPos% + 36: COLOR 14, 1
      IF GTSeconds% - 1 = -1 THEN
        PRINT "59"
      ELSEIF GTSeconds% - 1 >= 0 AND GTSeconds% <= 59 THEN
        IF GTSeconds% - 1 < 10 THEN PRINT "0";
        PRINT S$(GTSeconds% - 1)
      END IF
      LOCATE yPos%, xPos% + 36: COLOR 10, 0: IF GTSeconds% < 10 THEN PRINT "0";
      PRINT S$(GTSeconds%)
      LOCATE yPos% + 2, xPos% + 36: COLOR 14, 1
      IF GTSeconds% + 1 >= 0 AND GTSeconds% + 1 <= 59 THEN
        IF GTSeconds% + 1 < 10 THEN PRINT "0";
        PRINT S$(GTSeconds% + 1)
      ELSEIF GTSeconds% + 1 = 60 THEN PRINT "00": END IF
 
      LOCATE yPos% - 2, xPos% + 50: COLOR 14, 1
      IF GTHours% - 1 >= 0 AND GTHours% - 1 <= 11 THEN
      PRINT "AM": ELSE PRINT "PM": END IF
      LOCATE yPos%, xPos% + 50: COLOR 10, 0
      IF GTHours% < 12 THEN
      PRINT "AM": ELSE PRINT "PM": END IF
      LOCATE yPos% + 2, xPos% + 50: COLOR 14, 1
      IF GTHours% + 1 >= 0 AND GTHours% + 1 <= 11 OR GTHours% + 1 = 24 THEN
      PRINT "AM": ELSE: PRINT "PM": END IF
 
      GTClock$ = ClockString$(GTHours%, GTMinutes%, GTSeconds%)
      COLOR 10, 0: LOCATE ypos + 34, Center(GTClock$): PRINT GTClock$
 
      HaltAndDisplay% = FALSE%
    END IF
 
    SomeKey% = _KEYHIT
    IF SomeKey% = UpKeyHit% OR SomeKey% = DownKeyHit% THEN
      IF TimerStarted% = FALSE% THEN
        FirstTime% = TIMER
        TimerStarted% = TRUE%
      END IF
    END IF
    IF SomeKey% < 0 THEN
      FirstTime% = 0
      Increment% = 1
      TimeElapsed% = 0
      TimerStarted% = FALSE%
    END IF
    TimeElapsed% = ABS(TIMER - FirstTime%)
    IF TimeElapsed% = 2 THEN
      IF HighlightedOption% = 2 OR HighlightedOption% = 3 THEN Increment% = 3
    END IF
 
    SELECT CASE UserCommand$
      CASE UpArrowKey$
        IF HighlightedOption% = 1 THEN
          GTHours% = GTHours% - Increment%
          IF GTHours% < 0 THEN GTHours% = 23
        ELSEIF HighlightedOption% = 2 THEN
          GTMinutes% = GTMinutes% - Increment%
          IF GTMinutes% < 0 THEN GTMinutes% = 59
        ELSEIF HighlightedOption% = 3 THEN
          GTSeconds% = GTSeconds% - Increment%
          IF GTSeconds% < 0 THEN GTSeconds% = 59
        END IF
        HaltAndDisplay% = TRUE
      CASE DownArrowKey$
        IF HighlightedOption% = 1 THEN
          GTHours% = GTHours% + Increment%
          IF GTHours% > 23 THEN GTHours% = 0
        ELSEIF HighlightedOption% = 2 THEN
          GTMinutes% = GTMinutes% + Increment%
          IF GTMinutes% > 59 THEN GTMinutes% = 0
        ELSEIF HighlightedOption% = 3 THEN
          GTSeconds% = GTSeconds% + Increment%
          IF GTSeconds% > 59 THEN GTSeconds% = 0
        END IF
        HaltAndDisplay% = TRUE
      CASE LeftArrowKey$
        HighlightedOption% = HighlightedOption% - 1
        IF HighlightedOption% = 0 THEN HighlightedOption% = MaxOption%
        HaltAndDisplay% = TRUE
      CASE RightArrowKey$
        HighlightedOption% = HighlightedOption% + 1
        IF HighlightedOption% > MaxOption% THEN HighlightedOption% = 1
        HaltAndDisplay% = TRUE
      CASE CHR$(13)
        GTRtn$ = MakeFormattedTIME$(GTHours%, GTMinutes%, GTSeconds%)
      CASE CHR$(27)
        GTHours% = VAL(LEFT$(TIME$, 2))
        GTMinutes% = VAL(MID$(TIME$, 4, 2))
        GTSeconds% = VAL(RIGHT$(TIME$, 2))
        HaltAndDisplay% = TRUE%
      CASE "X", "x"
        SYSTEM
    END SELECT
  LOOP UNTIL UserCommand$ = CHR$(13)
 
  GetTime$ = GTRtn$
END FUNCTION
 
FUNCTION MakeFormattedTIME$ (MFHours%, MFMinutes%, MFSeconds%)
  MFTRtn$ = ""
 
  IF MFHours% < 10 THEN MFTRtn$ = "0"
  MFTRtn$ = MFTRtn$ + S$(MFHours%) + ":"
  IF MFMinutes% < 10 THEN MFTRtn$ = MFTRtn$ + "0"
  MFTRtn$ = MFTRtn$ + S$(MFMinutes%) + ":"
  IF MFSeconds% < 10 THEN MFTRtn$ = MFTRtn$ + "0"
  MFTRtn$ = MFTRtn$ + S$(MFSeconds%)
 
  MakeFormattedTIME$ = MFTRtn$
 
END FUNCTION
 
FUNCTION LongCenter$ (Text$, CutHere%, BlankLineBetween%)
  PartString$ = "": Spaces$ = "": CutString$ = "": LCRtn$ = "": LastSpaces$ = ""
  NumLastSpaces% = 0
 
  CutHere% = CutHere% + 1
  DO
    DO
      CutHere% = CutHere% - 1
      Cutting$ = MID$(Text$, CutHere%, 1)
    LOOP UNTIL Cutting$ = " "
    PartString$ = MID$(Text$, 1, CutHere%)
    Text$ = MID$(Text$, CutHere% + 1, LEN(Text$))
    Spaces$ = STRING$(Center(PartString$), " ")
    CutString$ = Spaces$ + PartString$ + Spaces$
    LCRtn$ = LCRtn$ + CutString$
    IF BlankLineBetween% = TRUE% THEN LCRtn$ = LCRtn$ + STRING$(80, " ")
  LOOP UNTIL LEN(Text$) < CutHere%
  NumLastSpaces% = Center(Text$)
  LastSpaces$ = STRING$(NumLastSpaces%, " ")
  LCRtn$ = LCRtn$ + LastSpaces$ + Text$
  LongCenter$ = LCRtn$
END FUNCTION
 
 
FUNCTION DaysPassedJanFromMonthDayYear% (Month9%, Day9%, Years9%)
  DPJFMDYRtn% = 0: LeapYear% = 0
 
  IF Years9% MOD 4 = 0 THEN
  LeapYear% = 1: ELSE LeapYear% = 0: END IF
 
  SELECT CASE Month9%
    CASE 1
      DPJFMDYRtn% = Day9%
    CASE 2
      DPJFMDYRtn% = 31 + Day9%
    CASE 3
      DPJFMDYRtn% = 31 + 28 + LeapYear% + Day9%
    CASE 4
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + Day9%
    CASE 5
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + Day9%
    CASE 6
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + Day9%
    CASE 7
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + Day9%
    CASE 8
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + 31 + Day9%
    CASE 9
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + 31 + 31 + Day9%
    CASE 10
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + 31 + 31 + 30 + Day9%
    CASE 11
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + Day9%
    CASE 12
      DPJFMDYRtn% = 31 + 28 + LeapYear% + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30 + Day9%
  END SELECT
  DaysPassedJanFromMonthDayYear = DPJFMDYRtn%
END FUNCTION
 
SUB HowLongSince
  YearNow% = 0: DayNow% = 0: HourNow% = 0: MinuteNow% = 0: SecondNow% = 0: MonthNow% = 0
  HLSTargetDateAndTime$ = "": Instructions$ = "": DayNowCopy% = 0: HLSTargetYear% = 0: HLSTargetDay% = 0
  HLSTargetHour% = 0: HLSTargetMinute% = 0: HLSTargetSecond% = 0: HLSFinalYear% = 0: HLSFinalDay% = 0
  HLSFinalHour% = 0: HLSFinalMinute% = 0: HLSFinalSecond% = 0: SecondNowCopy% = 0: MinuteNowCopy% = 0: HourNowCopy% = 0
  DayNowCopy% = 0: YearNowCopy% = 0: HLSTargetMonth% = 0: HLSTargetDayCopy% = 0
 
  YearNow% = VAL(RIGHT$(DATE$, 4))
  DayNow% = VAL(MID$(DATE$, 4, 2))
  DayNowCopy% = DayNow%
  MonthNow% = VAL(LEFT$(DATE$, 2))
  DayNow% = DaysPassedJanFromMonthDayYear(MonthNow%, DayNow%, YearNow%)
  HourNow% = VAL(LEFT$(TIME$, 2))
  MinuteNow% = VAL(MID$(TIME$, 4, 2))
  SecondNow% = VAL(RIGHT$(TIME$, 2))
  YearNowCopy% = YearNow%
  HourNowCopy% = HourNow%
  MinuteNowCopy% = MinuteNow%
  SecondNowCopy% = SecondNow%
 
  Instructions$ = "Select A Target Date and Time Before " + WrittenOutDate$(MonthNow%, DayNowCopy%, YearNow%)
  Instructions$ = Instructions$ + " at " + ClockString$(HourNow%, MinuteNow%, SecondNow%)
  HLSTargetDateAndTime$ = GetDateAndTime$(Instructions$)
 
  whatTheHellString$ = MID$(HLSTargetDateAndTime$, 6, 3)
  whatTheHellInteger% = VAL(whatTheHellString$)
  HLSTargetYear% = VAL(LEFT$(HLSTargetDateAndTime$, 4))
  HLSTargetDay% = VAL(MID$(HLSTargetDateAndTime$, 6, 3))
  HLSTargetHour% = VAL(MID$(HLSTargetDateAndTime$, 10, 2))
  HLSTargetMinute% = VAL(MID$(HLSTargetDateAndTime$, 13, 2))
  HLSTargetSecond% = VAL(RIGHT$(HLSTargetDateAndTime$, 2))
  HLSTargetMonth% = MonthOrDayFromDaysPassedJan(HLSTargetDay%, 1, HLSTargetYear%)
  HLSTargetDayCopy% = MonthOrDayFromDaysPassedJan(HLSTargetDay%, 2, HLSTargetYear%)
 
  HLSFinalSecond% = SecondNow% - HLSTargetSecond%
  IF HLSFinalSecond% < 0 THEN
    HLSFinalSecond% = HLSFinalSecond% + 60
    MinuteNow% = MinuteNow% - 1
  END IF
  HLSFinalMinute% = MinuteNow% - HLSTargetMinute%
  IF HLSFinalMinute% < 0 THEN
    HLSFinalMinute% = HLSFinalMinute% + 60
    HourNow% = HourNow% - 1
  END IF
  HLSFinalHour% = HourNow% - HLSTargetHour%
  IF HLSFinalHour% < 0 THEN
    HLSFinalHour% = HLSFinalHour% + 24
    DayNow% = DayNow% - 1
  END IF
  HLSFinalDay% = DayNow% - whatTheHellInteger%
  IF HLSFinalDay% < 0 THEN
    HLSFinalDay% = HLSFinalDay% + 365
    YearNow% = YearNow% - 1
  END IF
  HLSFinalYear% = YearNow% - HLSTargetYear%
 
  COLOR 14, 1: CLS
  IF HLSFinalYear% < 0 THEN
    a$ = "": a$ = "The selected date and time is after "
    a$ = a$ + WrittenOutDate$(MonthNow%, DayNowCopy%, YearNowCopy%)
    a$ = a$ + " at " + ClockString$(HourNowCopy%, MinuteNowCopy%, SecondNowCopy%)
    LOCATE 24, 1
    PRINT LongCenter$(a$, 50, TRUE%)
  ELSE
    a$ = "": a$ = WrittenOutDate$(HLSTargetMonth%, HLSTargetDayCopy%, HLSTargetYear%)
    a$ = a$ + " at " + ClockString$(HLSTargetHour%, HLSTargetMinute%, HLSTargetSecond%)
    a$ = a$ + " occurred "
    a$ = a$ + ElapsedTimeWrittenOut$(MakeElapsedTimeShort$(HLSFinalYear%, HLSFinalDay%, HLSFinalHour%, HLSFinalMinute%, HLSFinalSecond%))
    a$ = a$ + " ago"
    LOCATE 24, 1
    PRINT LongCenter(a$, 50, TRUE%)
  END IF
  a$ = "Hit any key": LOCATE 48, Center(a$): PRINT a$: ll$ = P$
END SUB
 
SUB WhatDateAfterElapsedTime
  TimePassed$ = "": YearsToday% = 0: MonthToday% = 0: DaysToday% = 0: DaysTodayAfterJan0% = 0: HoursToday% = 0: MinutesToday% = 0
  SecondsToday% = 0: YearsPassed% = 0: DaysPassed% = 0: HoursPassed% = 0: MinutesPassed% = 0: SecondsPassed% = 0
  ResultingYears% = 0: ResultingDaysPassedJan% = 0: ResultingDays% = 0: ResultingHours% = 0: ResultingMinutes% = 0
  ResultingSeconds% = 0: ResultingDateMonth% = 0: ResultingDateDay% = 0: ResultingDateYear% = 0: ResultingTimeHour% = 0
  ResultingTimeMinutes% = 0: ResultingTimeSeconds% = 0: AnswerString$ = ""
 
 
  YearsToday% = VAL(RIGHT$(DATE$, 4))
  DaysToday% = VAL(MID$(DATE$, 4, 2))
  MonthToday% = VAL(LEFT$(DATE$, 2))
  DaysTodayAfterJan0% = DaysPassedJanFromMonthDayYear(MonthToday%, DaysToday%, YearsToday%)
  HoursToday% = VAL(LEFT$(TIME$, 2))
  MinutesToday% = VAL(MID$(TIME$, 4, 2))
  SecondsToday% = VAL(RIGHT$(TIME$, 2))
 
  TimePassed$ = GetElapsedTime$("Find the date after how much time has passed?")
  YearsPassed% = VAL(LEFT$(TimePassed$, 4))
  DaysPassed% = VAL(MID$(TimePassed$, 6, 3))
  HoursPassed% = VAL(MID$(TimePassed$, 10, 2))
  MinutesPassed% = VAL(MID$(TimePassed$, 13, 2))
  SecondsPassed% = VAL(RIGHT$(TimePassed$, 2))
 
  ResultingSeconds% = SecondsToday% + SecondsPassed%
  IF ResultingSeconds% >= 60 THEN
    ResultingSeconds% = ResultingSeconds% - 60
    MinutesPassed% = MinutesPassed% + 1
  END IF
  ResultingMinutes% = MinutesToday% + MinutesPassed%
  IF ResultingMinutes% >= 60 THEN
    ResultingMinutes% = ResultingMinutes% - 60
    HoursPassed% = HoursPassed% + 1
  END IF
  ResultingHours% = HoursToday% + HoursPassed%
  IF ResultingHours% >= 24 THEN
    ResultingHours% = ResultingHours% - 24
    DaysPassed% = DaysPassed% + 1
  END IF
  ResultingDays% = DaysTodayAfterJan0% + DaysPassed%
  IF ResultingDays% >= 365 THEN
    ResultingDays% = ResultingDays% - 365
    YearsPassed% = YearsPassed% + 1
  END IF
  ResultingYears% = YearsToday% + YearsPassed%
  ResultingDateYear% = ResultingYears%
  ResultingDateMonth% = MonthOrDayFromDaysPassedJan(ResultingDays%, 1, ResultingDateYear%)
  ResultingDateDay% = MonthOrDayFromDaysPassedJan(ResultingDays%, 2, ResultingDateYear%)
  ResultingTimeHour% = ResultingHours%
  ResultingTimeMinutes% = ResultingMinutes%
  ResultingTimeSeconds% = ResultingSeconds%
  AnswerString$ = ElapsedTimeWrittenOut$(MakeElapsedTimeShort$(YearsPassed%, DaysPassed%, HoursPassed%, MinutesPassed%, SecondsPassed%))
  AnswerString$ = AnswerString$ + " after now is "
  AnswerString$ = AnswerString$ + WrittenOutDate$(ResultingDateMonth%, ResultingDateDay%, ResultingDateYear%)
  AnswerString$ = AnswerString$ + " at " + ClockString$(ResultingTimeHour%, ResultingTimeMinutes%, ResultingTimeSeconds%)
  CLS
  LOCATE 23, 1
  PRINT LongCenter$(AnswerString$, 45, TRUE%)
  a$ = "": a$ = "Hit any key": LOCATE 48, Center(a$): PRINT a$: ll$ = P$
END SUB
 
SUB AddElapsedTimes
  Years1% = 0: Years2% = 0: AddedYears% = 0: Days1% = 0: Days2% = 0: AddedDays% = 0: Hours1% = 0
  Hours2% = 0: AddedHours% = 0: Minutes1% = 0: Minutes2% = 0: AddedMinutes% = 0: Seconds1% = 0
  Seconds2% = 0: AddedSeconds% = 0: et1$ = "": et2$ = "": Prompt2$ = "": AnswerString$ = "": AT$ = ""
 
  et1$ = GetElapsedTime$("Select the fire time")
  Years1% = VAL(LEFT$(et1$, 4))
  Days1% = VAL(MID$(et1$, 6, 3))
  Hours1% = VAL(MID$(et1$, 10, 2))
  Minutes1% = VAL(MID$(et1$, 13, 2))
  Seconds1% = VAL(RIGHT$(et1$, 2))
 
  Prompt2$ = "Select the amount of time to add to " + ElapsedTimeWrittenOut$(et1$)
  et2$ = GetElapsedTime$(Prompt2$)
  Years2% = VAL(LEFT$(et2$, 4))
  Days2% = VAL(MID$(et2$, 6, 3))
  Hours2% = VAL(MID$(et2$, 10, 2))
  Minutes2% = VAL(MID$(et2$, 13, 2))
  Seconds2% = VAL(RIGHT$(et2$, 2))
 
  AddedSeconds% = Seconds1% + Seconds2%
  IF AddedSeconds% >= 60 THEN
    AddedSeconds% = AddedSeconds% - 60
    Minutes1% = Minutes1% + 1
  END IF
  AddedMinutes% = Minutes1% + Minutes2%
  IF AddedMinutes% >= 60 THEN
    AddedMinutes% = AddedMinutes% - 60
    Hours1% = Hours1% + 1
  END IF
  AddedHours% = Hours1% + Hours2%
  IF AddedHours% >= 24 THEN
    AddedHours% = AddedHours% - 24
    Days1% = Days1% + 1
  END IF
  AddedDays% = Days1% + Days2%
  IF AddedDays% >= 365 THEN
    AddedDays% = AddedDays% - 365
    Years1% = Years1% + 1
  END IF
  AddedYears% = Years1% + Years2%
 
  COLOR 14, 1: CLS
  AnswerString$ = ElapsedTimeWrittenOut$(et1$) + " added with " + ElapsedTimeWrittenOut$(et2$)
  ATShort$ = MakeElapsedTimeShort$(AddedYears%, AddedDays%, AddedHours%, AddedMinutes%, AddedSeconds%)
  AT$ = ElapsedTimeWrittenOut$(ATShort$)
  AnswerString$ = AnswerString$ + " equals " + AT$
  LOCATE 20, 1
  PRINT LongCenter$(AnswerString$, 50, TRUE%)
  ll$ = P$
END SUB
 
SUB SubtractElapsedTimes
  Et1$ = "": Et2$ = "": Prompt1$ = "": Prompt2$ = "": Years1% = 0: Years2% = 0: SubtractedYears% = 0: Days1% = 0: Days2% = 0
  SubtractedDays% = 0: Hours1% = 0: Hours2% = 0: SubtractedHours% = 0: Minutes1% = 0: Minutes2% = 0: SubtractedMinutes% = 0
  Seconds1% = 0: Seconds2% = 0: SubtractedSeconds% = 0: BT% = 0: FirstYears% = 0: SecondYears% = 0: FirstDays% = 0: SecondDays% = 0
  FirstHours% = 0: SecondHours% = 0: FirstMinutes% = 0: SecondMinutes% = 0: FirstSeconds% = 0: SecondSeconds% = 0: Result$ = ""
  FTWO$ = "": STWO$ = "": SubTWO$ = ""
 
  Prompt1$ = "Select one of the 2 times"
  Et1$ = GetElapsedTime$(Prompt1$)
  Years1% = VAL(LEFT$(Et1$, 4))
  Days1% = VAL(MID$(Et1$, 6, 3))
  Hours1% = VAL(MID$(Et1$, 10, 2))
  Minutes1% = VAL(MID$(Et1$, 13, 2))
  Seconds1% = VAL(RIGHT$(Et1$, 2))
 
  Prompt2$ = "Select the second time -- The smaller time will be subtracted from the larger"
  Et2$ = GetElapsedTime$(Prompt2$)
  Years2% = VAL(LEFT$(Et2$, 4))
  Days2% = VAL(MID$(Et2$, 6, 3))
  Hours2% = VAL(MID$(Et2$, 10, 2))
  Minutes2% = VAL(MID$(Et2$, 13, 2))
  Seconds2% = VAL(RIGHT$(Et2$, 2))
 
  BT% = 1
  IF Years1% < Years2% THEN
    BT% = 2
  ELSEIF Years1% = Years2% AND Days1% < Days2% THEN BT% = 2
  ELSEIF Years1% = Years2% AND Days1% = Days2% AND Hours1% < Hours2% THEN BT% = 2
  ELSEIF Years1% = Years2% AND Days1% = Days2% AND Hours1% = Hours2% AND Minutes1% < Minutes2% THEN BT% = 2
  ELSEIF Years1% = Years2% AND Days1% = Days2% AND Hours1% = Hours2% AND Minutes1% = Minutes1% AND Seconds1% < Seconds2% THEN BT% = 2
  END IF
 
  ' first - second
  IF BT% = 1 THEN
    FirstYears% = Years1%: SecondYears% = Years2%
    FirstDays% = Days1%: SecondDays% = Days2%
    FirstHours% = Hours1%: SecondHours% = Hours2%
    FirstMinutes% = Minutes1%: SecondMinutes% = Minutes2%
    FirstSeconds% = Seconds1%: SecondSeconds% = Seconds2%
  ELSE
    FirstYears% = Years2%: SecondYears% = Years1%
    FirstDays% = Days2%: SecondDays% = Days1%
    FirstHours% = Hours2%: SecondHours% = Hours1%
    FirstMinutes% = Minutes2%: SecondMinutes% = Minutes1%
    FirstSeconds% = Seconds2%: SecondSeconds% = Seconds1%
  END IF
 
 
  SubtractedSeconds% = FirstSeconds% - SecondSeconds%
  IF SubtractedSeconds% < 0 THEN
    SubtractedSeconds% = SubtractedSeconds% + 60
    FirstMinutes% = FirstMinutes% - 1
  END IF
  SubtractedMinutes% = FirstMinutes% - SecondMinutes%
  IF SubtractedMinutes% < 0 THEN
    SubtractedMinutes% = SubtractedMinutes% + 60
    FirstHours% = FirstHours% - 1
  END IF
  SubtractedHours% = FirstHours% - SecondHours%
  IF SubtractedHours% < 0 THEN
    SubtractedHours% = SubtractedHours% + 24
    FirstDays% = FirstDays% - 1
  END IF
  SubtractedDays% = FirstDays% - SecondDays%
  IF SubtractedDays% < 0 THEN
    SubtractedDays% = SubtractedDays% + 365
    FirstYears% = FirstYears% - 1
  END IF
  SubtractedYears% = FirstYears% - SecondYears%
 
  CLS
  PRINT "SubtractedYears%: " + S$(SubtractedYears%)
  PRINT "SubtractedDays%: " + S$(SubtractedDays%)
  PRINT "SubtractedHours%: " + S$(SubtractedHours%)
  PRINT "SubtractedMinutes%: " + S$(SubtractedMinutes%)
  PRINT "SubtractedSeconds%: " + S$(SubtractedSeconds%)
  ll$ = P$
 
  FTWO$ = ElapsedTimeWrittenOut$(Et1$)
  STWO$ = ElapsedTimeWrittenOut$(Et2$)
  SubTWO$ = ElapsedTimeWrittenOut$(MakeElapsedTimeShort$(SubtractedYears%, SubtractedDays%, SubtractedHours%, SubtractedMinutes%, SubtractedSeconds%))
 
  Result$ = FTWO$ + " minus " + STWO$ + " equals " + SubTWO$
  CLS: COLOR 14, 1: LOCATE 20, 1: PRINT LongCenter$(Result$, 50, TRUE%)
  ll$ = P$
END SUB
 
SUB Multiply
  Prompt$ = "": Et$ = "": Years% = 0: Days% = 0: Hours% = 0: Minutes% = 0: Seconds% = 0: ETWO$ = "": x = 0
  Constant! = 0.0: ProductYears% = 0: ProductDays% = 0: ProductHours% = 0: ProductMinutes% = 0: ProductSeconds% = 0
  TMin% = 0: THr% = 0: Tsec% = 0: Tday% = 0: Tyr% = 0: Ans$ = ""
 
  Prompt$ = "Select a time to multiply"
  Et$ = GetElapsedTime$(Prompt$)
  Years% = VAL(LEFT$(Et$, 4))
  Days% = VAL(MID$(Et$, 6, 3))
  Hours% = VAL(MID$(Et$, 10, 2))
  Minutes% = VAL(MID$(Et$, 13, 2))
  Seconds% = VAL(MID$(Et$, 16, 2))
 
  COLOR 14, 1: CLS
  LOCATE 20, Center("Multiply")
  ETWO$ = ElapsedTimeWrittenOut$(Et$)
  LOCATE 22, Center(ETWO$): PRINT ETWO$
  x = Center("by what    ")
  LOCATE 25, x: INPUT "by what"; Constant!
 
  ProductSeconds% = RoundOff(Seconds% * Constant! / 100) * 100
  IF ProductSeconds% >= 60 THEN
    DO
      ProductSeconds% = ProductSeconds% - 60
      TMin% = TMin% + 1
    LOOP UNTIL ProductSeconds% < 60
  END IF
  ProductMinutes% = RoundOff(Minutes% * Constant! / 100) * 100 + TMin%
  IF ProductMinutes% >= 60 THEN
    DO
      ProductMinutes% = ProductMinutes% - 60
      THr% = THr% + 1
    LOOP UNTIL ProductMinutes% < 60
  END IF
  ProductHours% = RoundOff(Hours% * Constant! / 100) * 100 + THr%
  IF ProductHours% >= 24 THEN
    DO
      ProductHours% = ProductHours% - 24
      Tday% = Tday% + 1
    LOOP UNTIL ProductHours% < 24
  END IF
  ProductDays% = RoundOff(Days% * Constant! / 100) * 100 + Tday%
  IF ProductDays% >= 365 THEN
    ProductDays% = ProductDays% - 365
    Tyr% = Tyr% + 1
  END IF
  ProductYears% = RoundOff(Years% * Constant! / 100) * 100 + Tyr%
 
  CLS
  IF ProductYears% > 9999 THEN
    LOCATE 10: a$ = "": a$ = "May not display correctly": LOCATE , Center(a$): PRINT a$
  END IF
  LOCATE 20, Center(ElapsedTimeWrittenOut$(Et$)): PRINT ElapsedTimeWrittenOut$(Et$)
  Ans$ = "multiplied by " + S$(Constant!) + " equals": LOCATE 22, Center(Ans$): PRINT Ans$
  LOCATE 24, 1
  PRINT LongCenter(ElapsedTimeWrittenOut$(MakeElapsedTimeShort$(ProductYears%, ProductDays%, ProductHours%, ProductMinutes%, ProductSeconds%)), 40, TRUE)
  ll$ = P$
END SUB
 
FUNCTION RoundOff (Number!)
  DIM Rtn!, DifferentNumber!, Decimal!: Rtn = 0.0: DifferentNumber = 0.0: Decimal = 0.0
  Decimal = INT(Number * 1000) - (INT(Number * 100) * 10)
  DifferentNumber! = INT(Number! * 100)
  IF Decimal! >= 5 AND Decimal! <= 9 THEN
    DifferentNumber! = DifferentNumber! + 1
  ELSE
    DifferentNumber! = DifferentNumber!
  END IF
  Rtn = DifferentNumber! / 100
  RoundOff = Rtn!
END FUNCTION
 
FUNCTION GetElapsedTime$ (title$)
  DIM minOption, maxOption, haltAndDisplay, xPos, yPos, highlightedOption AS INTEGER
  DIM Years1, Days1, Hours1, Minutes1, Seconds1 AS INTEGER
  KeyThatWasHit% = 0: TimerStarted% = FALSE%: FirstTime% = 0: Increment% = 1: RecentTime% = 0: TimeDifference% = 0
 
  highlightedOption = 4: haltAndDisplay = TRUE
  minOption = 4: maxOption = 8
  DO
    userCommand$ = INKEY$
    IF haltAndDisplay = TRUE THEN
      COLOR 14, 1: CLS: yPos = 22: xPos = 10
      COLOR 15, 1
      titleCopy$ = title$
      IF LEN(titleCopy$) >= 60 THEN
        a$ = LongCenter(titleCopy$, 60, FALSE%)
        LOCATE 8, 1: PRINT a$
      ELSE
        LOCATE 8, Center(titleCopy$): PRINT title$
      END IF
      COLOR 12, 1
      Instructions$ = ""
      Instructions$ = "Use the arrow keys to select the desired elapsed time - Push [ENTER] to accept - Push "
      Instructions$ = Instructions$ + "Push [ESC] to reset - Push " + CHR$(34) + "X" + CHR$(34) + " to exit to the system"
      LOCATE yPos + 18, 1
      PRINT LongCenter$(Instructions$, 50, FALSE%)
 
      xPos = xPos + 16
 
      'Years
      LOCATE yPos - 5, xPos - 10
      IF highlightedOption = 4 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Years"
      LOCATE yPos - 2, xPos - 10: COLOR 14, 1:
      IF Years1 - 1 >= 0 THEN
      PRINT USING "#,###"; (Years1 - 1): ELSE PRINT "9,999": END IF
      LOCATE yPos: COLOR 10, 0: IF Years1 >= 0 AND Years1 < 10 THEN
        LOCATE , xPos - 6: PRINT S$(Years1)
      ELSEIF Years1 >= 10 AND Years1 < 100 THEN LOCATE , xPos - 7: PRINT S$(Years1)
      ELSEIF Years1 >= 100 AND Years1 < 1000 THEN LOCATE , xPos - 8: PRINT S$(Years1)
      ELSEIF Years1 >= 1000 AND Years1 < 10000 THEN LOCATE , xPos - 10: PRINT USING "#,###"; Years1
      ELSE PRINT "I hope I don't see this error": END IF
      LOCATE yPos + 2, xPos - 10: COLOR 14, 1: IF Years1 + 1 < 10000 THEN
      PRINT USING "#,###"; Years1 + 1: ELSE PRINT USING "#,###"; 0: END IF
 
      'Days
      LOCATE yPos - 5, xPos
      IF highlightedOption = 5 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Days"
      COLOR 14, 1: LOCATE yPos - 2, xPos: IF Days1 - 1 = -1 THEN
      PRINT "364": ELSE PRINT USING "###"; Days1 - 1: END IF
      COLOR 10, 0: LOCATE yPos: IF Days1 < 10 THEN
        LOCATE , xPos + 2: PRINT S$(Days1)
      ELSEIF Days1 < 100 THEN LOCATE , xPos + 1: PRINT S$(Days1)
      ELSE LOCATE , xPos: PRINT S$(Days1): END IF
      COLOR 14, 1: LOCATE yPos + 2, xPos + 0: IF Days1 + 1 < 365 THEN
      PRINT USING "###"; Days1 + 1: ELSE PRINT USING "###"; 0: END IF
 
      LOCATE yPos - 5, xPos + 9
      IF highlightedOption = 6 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Hours"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 11: IF Hours1 - 1 >= 0 THEN
      PRINT S$(Hours1 - 1): ELSE PRINT "23": END IF
      LOCATE yPos, xPos + 11: COLOR 10, 0: PRINT S$(Hours1)
      LOCATE yPos + 2, xPos + 11: COLOR 14, 1: IF Hours1 + 1 <= 23 THEN
      PRINT S$(Hours1 + 1): ELSE PRINT "0": END IF
 
      LOCATE yPos - 5, xPos + 18
      IF highlightedOption = 7 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Minutes"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 20: IF Minutes1 - 1 >= 0 THEN
      PRINT S$(Minutes1 - 1): ELSE PRINT "59": END IF
      LOCATE yPos, xPos + 20: COLOR 10, 0: PRINT S$(Minutes1)
      LOCATE yPos + 2, xPos + 20: COLOR 14, 1: IF Minutes1 + 1 < 60 THEN
      PRINT S$(Minutes1 + 1): ELSE PRINT "0": END IF
 
      LOCATE yPos - 5, xPos + 29
      IF highlightedOption = 8 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Seconds"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 32: IF Seconds1 - 1 >= 0 THEN
      PRINT S$(Seconds1 - 1): ELSE PRINT "59": END IF
      LOCATE yPos, xPos + 32: COLOR 10, 0: PRINT S$(Seconds1)
      LOCATE yPos + 2, xPos + 32: COLOR 14, 1: IF Seconds1 + 1 <= 59 THEN
      PRINT S$(Seconds1 + 1): ELSE PRINT "0": END IF
 
      a$ = "": a$ = ElapsedTimeWrittenOut$(MakeElapsedTimeShort$(Years1, Days1, Hours1, Minutes1, Seconds1))
      LOCATE yPos + 12, Center(a$): PRINT a$
 
      haltAndDisplay = FALSE
    END IF
 
    SomeKey% = _KEYHIT
    IF SomeKey% = UpKeyHit% OR SomeKey% = DownKeyHit% THEN
      IF TimerStarted% = FALSE% THEN
        FirstTime% = TIMER
        TimerStarted% = TRUE%
      END IF
    END IF
    IF SomeKey% < 0 THEN
      FirstTime% = 0
      Increment% = 1
      TimeElapsed% = 0
      TimerStarted% = FALSE%
    END IF
    TimeElapsed% = ABS(TIMER - FirstTime%)
    IF TimeElapsed% = 2 THEN
      IF highlightedOption = 4 THEN Increment% = 5
      IF highlightedOption = 5 THEN Increment% = 3
      IF highlightedOption = 7 THEN Increment% = 2
      IF highlightedOption = 8 THEN incrment% = 2
    ELSEIF TimeElapsed% = 3 THEN
      IF highlightedOption = 4 THEN Increment% = 15
      IF highlightedOption = 5 THEN Increment% = 10
      IF highlightedOption = 7 THEN Increment% = 5
      IF highlightedOption = 8 THEN Increment% = 5
    ELSEIF TimeElapsed% = 4 THEN
      IF highlightedOption = 4 THEN Increment% = 40
      IF highlightedOption = 5 THEN Increment% = 15
    ELSEIF TimeElapsed% = 5 THEN Increment% = 70
    END IF
 
    SELECT CASE userCommand$
      CASE UpArrowKey$
        IF highlightedOption = 4 THEN
          Years1 = Years1 - Increment%
          IF Years1 <= -1 THEN Years1 = 9999
        ELSEIF highlightedOption = 5 THEN
          Days1 = Days1 - Increment%
          IF Days1 <= -1 THEN Days1 = 364
        ELSEIF highlightedOption = 6 THEN
          Hours1 = Hours1 - 1
          IF Hours1 = -1 THEN Hours1 = 23
        ELSEIF highlightedOption = 7 THEN
          Minutes1 = Minutes1 - Increment%
          IF Minutes1 <= -1 THEN Minutes1 = 59
        ELSEIF highlightedOption = 8 THEN
          Seconds1 = Seconds1 - Increment%
          IF Seconds1 <= -1 THEN Seconds1 = 59
        END IF
        haltAndDisplay = TRUE
      CASE DownArrowKey$
        IF highlightedOption = 4 THEN
          Years1 = Years1 + Increment%
          IF Years1 >= 10000 THEN Years1 = 0
        ELSEIF highlightedOption = 5 THEN
          Days1 = Days1 + Increment%
          IF Days1 >= 365 THEN Days1 = 0
        ELSEIF highlightedOption = 6 THEN
          Hours1 = Hours1 + 1
          IF Hours1 = 24 THEN Hours1 = 0
        ELSEIF highlightedOption = 7 THEN
          Minutes1 = Minutes1 + Increment%
          IF Minutes1 >= 60 THEN Minutes1 = 0
        ELSEIF highlightedOption = 8 THEN
          Seconds1 = Seconds1 + Increment%
          IF Seconds1 >= 60 THEN Seconds1 = 0
        END IF
        haltAndDisplay = TRUE
      CASE RightArrowKey$
        highlightedOption = highlightedOption + 1
        IF highlightedOption > maxOption THEN highlightedOption = minOption
        haltAndDisplay = TRUE
      CASE LeftArrowKey$
        highlightedOption = highlightedOption - 1
        IF highlightedOption < minOption THEN highlightedOption = maxOption
        haltAndDisplay = TRUE
      CASE CHR$(13), CHR$(32)
        Rtn$ = MakeElapsedTimeShort$(Years1, Days1, Hours1, Minutes1, Seconds1)
      CASE CHR$(27)
        montH = 1: daY = 1: year = 2022
        Years1 = 0: Days1 = 0: Hours1 = 0: Minutes1 = 0: Seconds1 = 0
        Years2 = 0: Days2 = 0: Hours2 = 0: Minutes2 = 0: Seconds2 = 0
        haltAndDisplay = TRUE
      CASE "X", "x"
        SYSTEM
    END SELECT
  LOOP UNTIL userCommand$ = CHR$(13) OR userCommand$ = CHR$(32)
 
  GetElapsedTime$ = Rtn$
 
END FUNCTION
 
 
FUNCTION MonthOrDayFromDaysPassedJan% (Days27%, Month1Day2%, Year27%)
  MODFDPJRtn% = 0: Month27% = 0: Leap% = 0
 
  IF Year27% MOD 4 = 0 THEN
  Leap% = 1: ELSE Leap% = 0: END IF
  SELECT CASE Days27%
    CASE 1 TO 31 'January
      Month27% = 1
      Days27% = Days27%
    CASE 32 TO 59 + Leap% 'February
      Month27% = 2
      Days27% = Days27% - 31
    CASE 60 + Leap% TO 90 + Leap% 'March
      Month27% = 3
      Days27% = Days27% - 59 - Leap%
    CASE 91 + Leap% TO 120 + Leap% 'april
      Month27% = 4
      Days27% = Days27% - 90 - Leap%
    CASE 121 + Leap% TO 151 + Leap% 'may
      Month27% = 5
      Days27% = Days27% - 120 - Leap%
    CASE 152 + Leap% TO 181 + Leap%
      Month27% = 6
      Days27% = Days27% - 150 - Leap%
    CASE 182 + Leap% TO 212 + Leap%
      Month27% = 7
      Days27% = Days27% - 180 - Leap%
    CASE 213 + Leap% TO 243 + Leap%
      Month27% = 8
      Days27% = Days27% - 212 - Leap%
    CASE 244 + Leap% TO 273 + Leap%
      Month27% = 9
      Days27% = Days27% - 243 - Leap%
    CASE 274 + Leap% TO 304 + Leap%
      Month27% = 10
      Days27% = Days27% - 273 - Leap%
    CASE 305 + Leap% TO 334 + Leap%
      Month27% = 11
      Days27% = Days27% - 304 - Leap%
    CASE 335 + Leap% TO 365 + Leap%
      Month27% = 12
      Days27% = Days27% - 334 - Leap%
  END SELECT
  IF Month1Day2% = 1 THEN
    MODFDPJRtn% = Month27%
  ELSEIF Month1Day2% = 2 THEN
    MODFDPJRtn% = Days27%
  END IF
  MonthOrDayFromDaysPassedJan = MODFDPJRtn%
END FUNCTION
 
FUNCTION MonthWord$ (Month10%)
  MWRtn$ = ""
 
  SELECT CASE Month10%
    CASE 0 ' for the top value of the dial
      MWRtn$ = "December"
    CASE 1
      MWRtn$ = "January"
    CASE 2
      MWRtn$ = "February"
    CASE 3
      MWRtn$ = "March"
    CASE 4
      MWRtn$ = "April"
    CASE 5
      MWRtn$ = "May"
    CASE 6
      MWRtn$ = "June"
    CASE 7
      MWRtn$ = "July"
    CASE 8
      MWRtn$ = "August"
    CASE 9
      MWRtn$ = "September"
    CASE 10
      MWRtn$ = "October"
    CASE 11
      MWRtn$ = "November"
    CASE 12
      MWRtn$ = "December"
    CASE 13 'for the bottom value of the dial
      MWRtn$ = "January"
  END SELECT
  MonthWord$ = MWRtn$
END FUNCTION
 
FUNCTION Suffix$ (DaySuffix%)
  SRtn$ = ""
  IF DaySuffix% = 1 OR DaySuffix% = 21 OR DaySuffix% = 31 THEN
    SRtn$ = "st"
  ELSEIF DaySuffix% = 2 OR DaySuffix% = 22 THEN SRtn$ = "nd"
  ELSEIF DaySuffix% = 3 OR DaySuffix% = 23 THEN SRtn$ = "rd"
  ELSE SRtn$ = "th": END IF
  Suffix$ = SRtn$
END FUNCTION
 
FUNCTION WrittenDate1Clock2Time3$ (AllFive$, Which%)
  WD1C2T3Rtn$ = "": Years8% = 0: Days8% = 0: Hours8% = 0: Minutes8% = 0: Seconds8% = 0: Month8% = 0
  AmPm8$ = "": LftNum8% = 0: RtNum8% = 0: LpYr% = 0
 
  Years8% = VAL(MID$(AllFive$, 1, 4))
  Days8% = VAL(MID$(AllFive$, 6, 3))
  Hours8% = VAL(MID$(AllFive$, 10, 2))
  Minutes8% = VAL(MID$(AllFive$, 13, 2))
  Seconds8% = VAL(MID$(AllFive$, 16, 2))
  SELECT CASE Which%
    CASE 1
      Month8% = MonthOrDayFromDaysPassedJan(Days8% - LpYr%, 1, Years8%)
      Days8% = MonthOrDayFromDaysPassedJan(Days8% - LpYr%, 2, Years8%)
      WD1C2T3Rtn$ = MonthWord$(Month8%)
      WD1C2T3Rtn$ = WD1C2T3Rtn$ + " " + S$(Days8%)
      WD1C2T3Rtn$ = WD1C2T3Rtn$ + Suffix$(Days8%) + ", " + S$(Years8%)
    CASE 2
      IF Hours8% = 0 THEN
        WD1C2T3Rtn$ = "12"
        AmPm8$ = "AM"
      ELSEIF Hours8% > 0 AND Hours8% < 12 THEN
        WD1C2T3Rtn$ = S$(Hours8%)
        AmPm8$ = "AM"
      ELSEIF Hours% = 12 THEN
        WD1C2T3Rtn$ = "12"
        AmPm8$ = "PM"
      ELSEIF Hours8% > 12 AND Hours8% < 24 THEN
        WD1C2T3Rtn$ = S$(Hours8% - 12)
        AmPm8$ = "PM"
      END IF
      WD1C2T3Rtn$ = WD1C2T3Rtn$ + ":" + S$(Minutes8%) + " " + AmPm8$ + " and " + S$(Seconds8%)
      IF Seconds8% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
    CASE 3
      IF Years8% <> 0 THEN
        IF Years8% >= 1000 AND Years8% <= 9999 THEN
          LftNum8% = INT(Years8% / 1000)
          WD1C2T3Rtn$ = S$(LftNum8%) + ","
          RtNum8% = Years8% - (LftNum8% * 1000)
          IF RtNum8% < 10 THEN
            WD1C2T3Rtn$ = WD1C2T3Rtn$ + "00"
          ELSEIF RtNum8% >= 10 AND RtNum8% < 100 THEN
            WD1C2T3Rtn$ = WD1C2T3Rtn$ + "0"
          END IF
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + S$(RtNum8%)
        ELSE
          WD1C2T3Rtn$ = S$(Years8%)
        END IF
        WD1C2T3Rtn$ = WD1C2T3Rtn$ + " Year"
        IF Years% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
        IF Days8% <> 0 AND (Hours3% <> 0 OR Minutes8% <> 0 OR Seconds8% <> 0) THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Days8% <> 0 AND (Hours8% = 0 AND Minutes8% = 0 AND Seconds8% = 0) THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        ELSEIF Hours8% <> 0 AND (Minutes8% <> 0 OR Seconds8% <> 0) THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Hours8% <> 0 AND Minutes8% = 0 AND Seconds8% = 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        ELSEIF Minutes8% <> 0 AND Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Minutes8% <> 0 XOR Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        END IF
      END IF
      IF Days8% <> 0 THEN
        WD1C2T3Rtn$ = WD1C2T3Rtn$ + S$(Days8%) + " Day"
        IF Days8% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
        IF Hours8% <> 0 AND (Minutes8% <> 0 OR Seconds8% <> 0) THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Hours8% <> 0 AND Minutes8% = 0 AND Seconds8% = 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        ELSEIF Minutes8% <> 0 AND Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Minutes8% <> 0 XOR Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        END IF
      END IF
      IF Hours8% <> 0 THEN
        WD1C2T3Rtn$ = WD1C2T3Rtn$ + S$(Hours8%) + " hour"
        IF Hours8% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
        IF Minutes8% <> 0 AND Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + ", "
        ELSEIF Minutes8% <> 0 XOR Seconds8% <> 0 THEN
          WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
        END IF
      END IF
      IF Minutes8% <> 0 THEN
        WD1C2T3Rtn$ = WD1C2T3Rtn$ + S$(Minutes8%) + " minute"
        IF Minutes8% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
        IF Seconds8% <> 0 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + " and "
      END IF
      IF Seconds8% <> 0 THEN
        WD1C2T3Rtn$ = WD1C2T3Rtn$ + S$(Seconds8%) + " second"
        IF Seconds8% <> 1 THEN WD1C2T3Rtn$ = WD1C2T3Rtn$ + "s"
      END IF
      IF Years8% = 0 AND Days8% = 0 AND Hours8% = 0 AND Minutes8% = 0 AND Seconds8% = 0 THEN WD1C2T3Rtn$ = "Nothing"
  END SELECT
  WrittenDate1Clock2Time3$ = WD1C2T3Rtn$
END FUNCTION
 
 
SUB Menu
  HaltAndDisplay% = 0: HighlightedOption% = 0: yPos% = 0: UserCommand$ = "": A$ = ""
  xPos% = 0: MaxOption% = 0: SelectedAnOption% = 0
 
  HaltAndDisplay% = TRUE%: HighlightedOption% = 1: yPos% = 13: MaxOption% = 7: SelectedAnOption% = FALSE%
  HighlightedOption% = 1
  HaltAndDisplay% = TRUE%
  yPos = 14
  DO
    UserCommand$ = INKEY$
    IF HaltAndDisplay% = TRUE% THEN
      COLOR 14, 1: CLS
      A$ = "Time Calculator Menu": xPos% = Center(A$)
      LOCATE yPos%, Center(A$): PRINT A$: LOCATE yPos% + 1, Center(A$)
      PRINT "---- ---------- ----"
 
      A$ = "": A$ = "1.) Find How Long From Now"
      LOCATE yPos% + 3, Center(A$): IF HighlightedOption% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "Until A Selected Time"
      LOCATE yPos% + 4, Center(A$): IF HighlightedOption% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "2.) Find How Long It Has Been Since"
      LOCATE yPos% + 6, Center(A$): IF HighlightedOption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "A Selected Time Has Passed"
      LOCATE yPos% + 7, Center(A$): IF HighlightedOption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "3.) Find The Date And Time It Will Be After"
      LOCATE yPos% + 9, Center(A$): IF HighlightedOption% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "A Selected Amount Of Time Has Passed"
      LOCATE yPos% + 10, Center(A$): IF HighlightedOption% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "4.) Add Two Elapsed Times"
      LOCATE yPos% + 12, Center(A$): IF HighlightedOption% = 4 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "5.) Subtract One Elapsed Time From Another One"
      LOCATE yPos% + 14, Center(A$): IF HighlightedOption% = 5 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "6.) Multiply An Elapsed Time By A Constant"
      LOCATE yPos% + 16, Center(A$): IF HighlightedOption% = 6 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "7.) Exit"
      LOCATE 45, Center(A$): IF HighlightedOption% = MaxOption% THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      HaltAndDisplay% = FALSE%
    END IF
 
    SELECT CASE UserCommand$
      CASE UpArrowKey$, LeftArrowKey$
        HighlightedOption% = HighlightedOption% - 1
        IF HighlightedOption% = 0 THEN HighlightedOption% = MaxOption%
        HaltAndDisplay% = TRUE%
      CASE DownArrowKey$, RightArrowKey$
        HighlightedOption% = HighlightedOption% + 1
        IF HighlightedOption% > MaxOption% THEN HighlightedOption% = 1
        HaltAndDisplay% = TRUE%
      CASE CHR$(13)
        SelectedAnOption% = TRUE%
      CASE "1", "2", "3", "4", "5", "6"
        HighlightedOption% = VAL(UserCommand$)
        SelectedAnOption% = TRUE%
    END SELECT
    IF SelectedAnOption% = TRUE THEN
      SELECT CASE HighlightedOption%
        CASE 1
          CALL FromNowUntil
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
        CASE 2
          CALL HowLongSince
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
        CASE 3
          CALL WhatDateAfterElapsedTime
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
        CASE 4
          CALL AddElapsedTimes
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
        CASE 5
          CALL SubtractElapsedTimes
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
        CASE 6
          CALL Multiply
          SelectedAnOption% = FALSE%
          HaltAndDisplay% = TRUE%
      END SELECT
 
    END IF
  LOOP UNTIL UserCommand$ = CHR$(27) OR UserCommand$ = S$(MaxOption%)
END SUB
 
 
FUNCTION Center% (Text$): Center% = INT((80 - LEN(Text$)) / 2): END FUNCTION
FUNCTION S$ (Number!): S$ = LTRIM$(STR$(Number!)): END FUNCTION
FUNCTION P$
  pause$ = INPUT$(1): IF pause$ = CHR$(27) THEN END
P$ = pause$: END FUNCTION
 

QB64 Discussion / Highlight% changes by itself

« on: April 11, 2022, 01:34:56 pm »

I often make a DO LOOP with an INKEY$ to access the string values of the arrow keys. Out of probably 25 times writing a loop similar to this one, this is the second time I could not use my HaltAndDisplay% bool to stop the flicker.
On line 56, the Highlight% rapidly changes between positive and negative integers of about 3 to 5 digits. From what I can see in the code I've written, Highlight% shouldn't change until
one of the SHARED ArrowKey$ Values has been detected. I'd be grateful to anyone who can't point out my error

Code: QB64: [Select]

 
_TITLE "Time Calculator"
 
CONST TRUE% = 1
CONST FALSE% = -1
DIM SHARED LeftArrowKey$: LeftArrowKey$ = CHR$(0) + "K"
DIM SHARED RightArroeKey$: rightArrowKey$ = CHR$(0) + "M"
DIM SHARED UpArrowKey$: UpArrowKey$ = CHR$(0) + "H"
DIM SHARED DownArrowKey$: DownArrowKey$ = CHR$(0) + "P"
CONST UpArrowHit% = 18432
CONST LeftArrowHit% = 19200
CONST RightArrowHit% = 19712
CONST DownArrowHit% = 20480
' for the highlighted option in the GetTimeAmount SUB
CONST YearsHO% = 1
CONST DaysHO% = 2
CONST HoursHO% = 3
CONST MinutesHO% = 4
CONST SecondsHO% = 5
 
WIDTH 80, 50
_FULLSCREEN
COLOR 14, 1: CLS
 
CALL Menu
 
SUB FromNowUntil
END SUB
 
SUB HowLongSince
END SUB
 
SUB WhatDateAfterElapsedTime
END SUB
 
SUB AddElapsedTimes
END SUB
 
SUB SubtractElapsedTimes
END SUB
 
SUB Multiply
END SUB
 
SUB Divide
END SUB
 
 
SUB Menu
  HaltAndDisplay% = 0: Highlight% = 0: yPos% = 0: UserCommand$ = "": A$ = ""
  xPos% = 0: MaxOption% = 0: SelectedAnOption% = 0
 
  HaltAndDisplay% = TRUE%: Highlight% = 1: yPos% = 13: MaxOption% = 8: SelectedAnOption% = FALSE%
  DO
    UserCommand$ = INKEY$
    LOCATE 45, 1: PRINT S$(Highlight%)
    LOCATE 46, 1: PRINT "|" + UserCommand$ + "|"
    IF HaltAndDisplay% = TRUE% THEN
      COLOR 14, 1: CLS
      A$ = "Time Calculator Menu": xPos% = Center(A$)
      LOCATE yPos%, Center(A$): PRINT A$: LOCATE yPos% + 1, Center(A$)
      PRINT "---- ---------- ----"
 
      A$ = "": A$ = "1.) Find How Long From Now"
      LOCATE yPos% + 3, Center(A$): IF Highlight% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "Until A Selected Time"
      LOCATE yPos% + 4, Center(A$): IF Highlight% = 1 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "2.) Find How Long It Has Been Since"
      LOCATE yPos% + 6, Center(A$): IF highlighedoption% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "A Selected Time Has Passed"
      LOCATE yPos% + 7, Center(A$): IF Highlight% = 2 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "3.) Find The Date And Time It Will Be After"
      LOCATE yPos% + 9, Center(A$): IF Highlight% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
      A$ = "": A$ = "A Selected Amount Of Time Has Passed"
      LOCATE yPos% + 10, Center(A$): IF Highlight% = 3 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "4.) Add Two Elapsed Times"
      LOCATE yPos% + 12, Center(A$): IF Highlight% = 4 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "5.) Subtract One Elapsed Time From Another One"
      LOCATE yPos% + 14, Center(A$): IF Highlight% = 5 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "6.) Multiply An Elapsed Time By A Constant"
      LOCATE yPos% + 16, Center(A$): IF Highlight% = 6 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "7.) Divide An Elapsed Time By A Constant"
      LOCATE yPos% + 18, Center(A$): IF Highlight% = 7 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      A$ = "": A$ = "8.) Exit"
      LOCATE 45, Center(A$): IF Highlight% = 8 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT A$
 
      HaltAndDisplay% = FALSE%
    END IF
 
    SELECT CASE UserCommand$
      CASE UpArrowKey$, LeftArrowKey$
        Highlight% = highlightedoption - 1
        IF Highlight% = 0 THEN Highlight% = MaxOption%
        HaltAndDisplay% = TRUE%
      CASE DownArrowKey$, rightarrowkey$
        Highlight% = Highlight% + 1
        IF highlightedoption > maxoption THEN Highlight% = 1
        HaltAndDisplay% = TRUE%
      CASE CHR$(13)
        SelectedAnOption% = TRUE%
      CASE "1", "2", "3", "4", "5", "6", "7"
        Highlight% = VAL(UserCommand$)
        SelectedAnOption% = TRUE%
    END SELECT
    IF SelectedAnOption% = TRUE THEN
      SELECT CASE Highlight%
        CASE 1
          CALL FromNowUntil: SelectedAnOption% = FALSE%
        CASE 2
          CALL HowLongSince: SelectedAnOption% = FALSE%
        CASE 3
          CALL WhatDateAfterElapsedTime: SelectedAnOption% = FALSE%
        CASE 4
          CALL AddElapsedTimes: SelectedAnOption% = FALSE%
        CASE 5
          CALL SubtractElapsedTimes: SelectedAnOption% = FALSE%
        CASE 6
          CALL Multiply: SelectedAnOption% = FALSE%
        CASE 7
          CALL Divide: SelectedAnOption% = FALSE%
      END SELECT
    END IF
  LOOP UNTIL UserCommand$ = CHR$(27) OR UserCommand$ = S$(MaxOption%)
END SUB
 
 
 
 
 
FUNCTION Center% (Text$): Center% = INT((80 - LEN(Text$)) / 2): END FUNCTION
FUNCTION S$ (Number!): S$ = LTRIM$(STR$(Number!)): END FUNCTION
FUNCTION P$: pause$ = INPUT$(1): IF pause$ = CHR$(27) THEN END
P$ = pause$: END FUNCTION
 

QB64 Discussion / Fickle Increment variable

« on: April 05, 2022, 01:07:22 pm »

I have a variable from 0 to 9,999. You change it by some increment with the up and down arrow keys. I'm using INKEY$ with a SELECT CASE to check when the arrow keys are hit. I tried using _KEYDOWN for that but the values changed very fast and I got a rather strange error. Instead I'm using the _KEYDOWN to detect how long the key has been down and change the increment accordingly. This method isn't working to well. Sometime the increment changes, sometimes it does not. Any suggestions?

Code: QB64: [Select]

FUNCTION GetOneTimeAmount$ (title$)
  DIM minOption, maxOption, haltAndDisplay, xPos, yPos, highlightedOption AS INTEGER
  DIM years1, days1, hours1, minutes1, seconds1, keyWasPressed, timerStarted AS INTEGER
  DIM isLessThan, notZero AS INTEGER
 
  differentTime1:
 
  highlightedOption = 4: haltAndDisplay = TRUE: keyWasPressed = FALSE
  isLessThan = FALSE: notZero = TRUE: Increment = 1
  minOption = 4: maxOption = 8
  DO
    userCommand$ = INKEY$
    IF haltAndDisplay = TRUE THEN
 
      COLOR 14, 1: CLS: yPos = 25: xPos = 15
      a$ = title$: LOCATE 5, Center(a$): PRINT a$
 
      LOCATE yPos, xPos - 3
      IF highlightedOption >= 4 AND highlightedOption <= 8 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF
      PRINT "Time:"
      xPos = xPos + 18
 
      LOCATE yPos - 5, xPos - 10
      IF highlightedOption = 4 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Years"
      LOCATE yPos - 2, xPos - 10: COLOR 14, 1:
      IF years1 - 1 >= 0 THEN
      PRINT USING "#,###"; (years1 - 1): ELSE PRINT "9,999": END IF
      LOCATE yPos: COLOR 10, 0: IF years1 >= 0 AND years1 < 10 THEN
        LOCATE , xPos - 6: PRINT S$(years1)
      ELSEIF years1 >= 10 AND years1 < 100 THEN LOCATE , xPos - 7: PRINT S$(years1)
      ELSEIF years1 >= 100 AND years1 < 1000 THEN LOCATE , xPos - 8: PRINT S$(years1)
      ELSEIF years1 >= 1000 AND years1 < 10000 THEN LOCATE , xPos - 10: PRINT USING "#,###"; years1
      ELSE PRINT "I hope I don't see this error": END IF
      LOCATE yPos + 2, xPos - 10: COLOR 14, 1: IF years1 + 1 < 10000 THEN
      PRINT USING "#,###"; years1 + 1: ELSE PRINT USING "#,###"; 0: END IF
 
      LOCATE yPos - 5, xPos
      IF highlightedOption = 5 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Days"
      COLOR 14, 1: LOCATE yPos - 2, xPos: IF days1 - 1 = -1 THEN
      PRINT "365": ELSE PRINT USING "###"; days1 - 1: END IF
      COLOR 10, 0: LOCATE yPos ', ' xPos + 9:
      IF days1 >= 0 AND days1 < 10 THEN
        LOCATE , xPos + 2: PRINT S$(days1)
      ELSEIF days1 >= 10 AND days1 < 100 THEN LOCATE , xPos + 1: PRINT S$(days1)
      ELSEIF days1 >= 100 AND days1 <= 365 THEN LOCATE , xPos + 0: PRINT S$(days1)
      END IF
      COLOR 14, 1: LOCATE yPos + 2, xPos + 0: PRINT USING "###"; days1 + 1 ': IF days1 + 1 >= 0 AND days1 + 1 < 10 THEN
 
      LOCATE yPos - 5, xPos + 9
      IF highlightedOption = 6 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Hours"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 11: IF hours1 - 1 >= 0 THEN
      PRINT S$(hours1 - 1): ELSE PRINT "23": END IF
      LOCATE yPos, xPos + 11: COLOR 10, 0: PRINT S$(hours1)
      LOCATE yPos + 2, xPos + 11: COLOR 14, 1: IF hours1 + 1 <= 23 THEN
      PRINT S$(hours1 + 1): ELSE PRINT "0": END IF
 
      LOCATE yPos - 5, xPos + 18
      IF highlightedOption = 7 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Minutes"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 20: IF minutes1 - 1 >= 0 THEN
      PRINT S$(minutes1 - 1): ELSE PRINT "59": END IF
      LOCATE yPos, xPos + 20: COLOR 10, 0: PRINT S$(minutes1)
      LOCATE yPos + 2, xPos + 20: COLOR 14, 1: IF minutes1 + 1 < 60 THEN
      PRINT S$(minutes1 + 1): ELSE PRINT "0": END IF
 
      LOCATE yPos - 5, xPos + 29
      IF highlightedOption = 8 THEN
      COLOR 10, 0: ELSE COLOR 14, 1: END IF: PRINT "Seconds"
      COLOR 14, 1: LOCATE yPos - 2, xPos + 32: IF seconds1 - 1 >= 0 THEN
      PRINT S$(seconds1 - 1): ELSE PRINT "59": END IF
      LOCATE yPos, xPos + 32: COLOR 10, 0: PRINT S$(seconds1)
      LOCATE yPos + 2, xPos + 32: COLOR 14, 1: IF seconds1 + 1 <= 59 THEN
      PRINT S$(seconds1 + 1): ELSE PRINT "0": END IF
 
      b1$ = "YYYY DDD HH MM SS"
      a1$ = ""
      IF years1 = 0 THEN
        a1$ = "0000"
      ELSEIF years1 > 0 AND years1 < 10 THEN
        a1$ = "000" + S$(years1)
      ELSEIF years1 >= 10 AND years1 < 100 THEN
        a1$ = "00" + S$(years1)
      ELSEIF years1 >= 100 AND years1 < 1000 THEN
        a1$ = a1$ + "0" + S$(years1)
      ELSEIF years1 >= 1000 AND years1 < 10000 THEN
        a1$ = a1$ + S$(years1)
      END IF
      a1$ = a1$ + ":"
      IF days1 = 0 THEN
        a1$ = a1$ + "000"
      ELSEIF days1 > 0 AND days1 < 10 THEN
        a1$ = a1$ + "00" + S$(days1)
      ELSEIF days1 >= 10 AND days1 < 100 THEN
        a1$ = a1$ + "0" + S$(days1)
      ELSE
        a1$ = a1$ + S$(days1)
      END IF
      a1$ = a1$ + ":"
      IF hours1 = 0 THEN
        a1$ = a1$ + "00"
      ELSEIF hours1 > 0 AND hours1 < 10 THEN
        a1$ = a1$ + "0" + S$(hours1)
      ELSE
        a1$ = a1$ + S$(hours1)
      END IF
      a1$ = a1$ + ":"
      IF minutes1 = 0 THEN
        a1$ = a1$ + "00"
      ELSEIF minutes1 > 0 AND minutes1 < 10 THEN
        a1$ = a1$ + "0" + S$(minutes1)
      ELSE
        a1$ = a1$ + S$(minutes1)
      END IF
      a1$ = a1$ + ":"
      IF seconds1 = 0 THEN
        a1$ = a1$ + "00"
      ELSEIF seconds1 > 0 AND seconds1 < 10 THEN
        a1$ = a1$ + "0" + S$(seconds1)
      ELSE
        a1$ = a1$ + S$(seconds1)
      END IF
      haltAndDisplay = FALSE
      '      LOCATE 48, 1: PRINT a1$
    END IF
 
    IF _KEYDOWN(upKeydownCode) <> 0 OR _KEYDOWN(downKeydownCode) <> 0 THEN
      IF keyWasPressed = FALSE THEN
        timerStarted = TIMER
        keyWasPressed = TRUE
      END IF
      IF INT(TIMER - timerStarted) = 2 THEN
        Increment = 10
      ELSEIF INT(TIMER - timerStarted) = 3 THEN Increment = 20
      ELSEIF INT(TIMER - timerStarted) = 5 THEN Increment = 50
      ELSEIF INT(TIMER - timerStarted) = 7 THEN Increment = 100
      END IF
    ELSE
      keyWasPressed = FALSE
      Increment = 1
    END IF
 
    SELECT CASE userCommand$
      CASE upArrowKey$
        IF highlightedOption = 4 THEN
          years1 = years1 - Increment
          IF years1 <= -1 THEN years1 = 9999
        ELSEIF highlightedOption = 5 THEN
          days1 = days1 - Increment
          IF days1 <= -1 THEN days1 = 365
        ELSEIF highlightedOption = 6 THEN
          hours1 = hours1 - Increment: IF hours1 <= -1 THEN hours1 = 23
        ELSEIF highlightedOption = 7 THEN
          minutes1 = minutes1 - Increment: IF minutes1 <= -1 THEN minutes1 = 59
        ELSEIF highlightedOption = 8 THEN
          seconds1 = seconds1 - Increment: IF seconds1 <= -1 THEN seconds1 = 59
        END IF
        haltAndDisplay = TRUE
      CASE downArrowKey$
        IF highlightedOption = 4 THEN
          years1 = years1 + Increment
          IF years1 >= 10000 THEN years1 = 0
        ELSEIF highlightedOption = 5 THEN
          days1 = days1 + Increment: IF days1 >= 366 THEN days1 = 0
        ELSEIF highlightedOption = 6 THEN
          hours1 = hours1 + Increment: IF hours1 >= 24 THEN hours1 = 0
        ELSEIF highlightedOption = 7 THEN
          minutes1 = minutes1 + Increment: IF minutes1 >= 60 THEN minutes1 = 0
        ELSEIF highlightedOption = 8 THEN
          seconds1 = seconds1 + Increment: IF seconds1 >= 60 THEN seconds1 = 0
        END IF
        haltAndDisplay = TRUE
      CASE rightArrowKey$
        highlightedOption = highlightedOption + 1
        IF highlightedOption > maxOption THEN highlightedOption = minOption
        haltAndDisplay = TRUE
      CASE leftArrowKey$
        highlightedOption = highlightedOption - 1
        IF highlightedOption < minOption THEN highlightedOption = maxOption
        haltAndDisplay = TRUE
      CASE CHR$(13), CHR$(32)
        notZero = TRUE
        IF years1 = 0 AND days1 = 0 AND hours1 = 0 AND minutes1 = 0 AND seconds1 = 0 THEN
          notZero = FALSE
        END IF
        '        isLessThan = FALSE
        '        IF years1 < years2 THEN isLessThan = TRUE
        '        IF years1 = years2 AND days1 < days2 THEN isLessThan = TRUE
        '        IF days1 = days2 AND hours1 < hours2 THEN isLessThan = TRUE
        '        IF days1 = days2 AND hours1 = hours2 AND minutes1 < minutes2 THEN isLessThan = TRUE
        '        IF days1 = days2 AND hours1 = hours2 AND minutes1 = minutes2 AND seconds1 < seconds2 THEN isLessThan = TRUE
        '        IF isLessThan = TRUE THEN
        '          userCommand$ = ""
        '          a$ = "Time 1 cannot be less than Time 2": LOCATE yPos - 8, Center(a$): COLOR 12, 0: PRINT a$
        '          _DELAY (2.5)
        '          a$ = "                                 ": LOCATE yPos - 8, Center(a$): COLOR 14, 1: PRINT a$
        '        END IF
        IF notZero = TRUE THEN 'AND isLessThan = FALSE THEN
          '          LOCATE yPos + 10, 1 'xPos - 10
          '          PRINT "here": ll$ = P$
          this$ = "You have selected "
          IF years1 <> 0 THEN
            IF years1 >= 1000 THEN
              lftNum = INT(years1 / 1000)
              this$ = this$ + S$(lftNum) + ","
              rtNum = years1 - (lftNum * 1000)
              this$ = this$ + S$(rtNum)
            ELSE
              this$ = this$ + S$(years1)
            END IF
            this$ = this$ + " year"
            IF years1 <> 1 THEN this$ = this$ + "s"
            IF (days1 <> 0 AND (minutes1 <> 0 OR hours1 <> 0 OR seconds1 <> 0)) OR (hours1 <> 0 AND (minutes1 <> 0 OR seconds1 <> 0)) OR (minutes1 <> 0 AND seconds1 <> 0) THEN
              this$ = this$ + ", "
            ELSEIF days1 <> 0 OR minutes1 <> 0 OR hours1 <> 0 OR seconds1 <> 0 THEN
              this$ = this$ + " and "
            END IF
          END IF
          IF days1 <> 0 THEN
            this$ = this$ + S$(days1) + " day"
            IF days1 <> 1 THEN this$ = this$ + "s"
            IF (hours1 <> 0 AND (minutes1 <> 0 OR seconds1 <> 0)) OR (minutes1 <> 0 AND seconds1 <> 0) THEN
              this$ = this$ + ", "
            ELSEIF minutes1 <> 0 AND seconds1 <> 0 THEN
              this$ = this$ + " and "
            END IF
          END IF
          IF hours1 <> 0 THEN
            this$ = this$ + S$(hours1) + " hour"
            IF hours1 <> 1 THEN this$ = this$ + "s"
            IF minutes1 <> 0 AND seconds1 <> 0 THEN
              this$ = this$ + ", "
            ELSEIF minutes1 <> 0 OR seconds1 <> 0 THEN
              this$ = this$ + " and "
            END IF
          END IF
          IF minutes1 <> 0 THEN
            this$ = this$ + S$(minutes1) + " minute"
            IF minutes1 <> 1 THEN this$ = this$ + "s"
            IF seconds1 <> 0 THEN this$ = this$ + " and "
          END IF
          IF seconds1 <> 0 THEN
            this$ = this$ + S$(seconds1) + " second"
            IF seconds1 <> 1 THEN this$ = this$ + "s"
          END IF
          LOCATE yPos + 10, Center(this$): PRINT this$
          a$ = "Is this correct?": LOCATE yPos + 12, Center(a$): PRINT a$
          yn$ = UCASE$(P$)
          IF yn$ = "N" THEN GOTO differentTime1
        ELSE
          a$ = "You have selected 0. Is this correct?"
          yn$ = UCASE$(P$)
          IF yn$ = "N" THEN GOTO differentTime1
        END IF
      CASE CHR$(27)
        montH = 1: daY = 1: year = 2022
        years1 = 0: days1 = 0: hours1 = 0: minutes1 = 0: seconds1 = 0
        '        years2 = 0: days2 = 0: hours2 = 0: minutes2 = 0: seconds2 = 0
        haltAndDisplay = TRUE
      CASE "X"
        END
    END SELECT
  LOOP UNTIL userCommand$ = CHR$(13) OR userCommand$ = CHR$(32)
 
  GetOneTimeAmount$ = a1$
 
END FUNCTION

QB64 Discussion / big number

« on: April 04, 2022, 05:49:49 pm »

is there a way to use and integer value bigger than the LONG data type allows?

QB64 Discussion / Strangest Error. Anyone know why?

« on: March 27, 2022, 12:54:18 am »

Code: QB64: [Select]

invalidEntry:
xPos = Center("h:mm")
COLOR 30, 1: LOCATE 34, xPos: PRINT "H": LOCATE 34, xPos + 2: PRINT "MM": COLOR 14, 1: LOCATE 34, xPos + 1: PRINT ":"
h$ = INPUT$(1): IF ASC(h$) < 48 OR ASC(h$) > 57 THEN GOTO invalidEntry
COLOR 14, 1: LOCATE 34, xPos: PRINT h$
m1$ = INPUT$(1): IF ASC(m1$) < 48 OR ASC(m1$) > 53 THEN GOTO invalidEntry
COLOR 14, 1: LOCATE 34, xPos + 2: PRINT m1$
m2$ = INPUT$(1): IF ASC(m2$) < 48 OR ASC(m2$) > 57 THEN GOTO invalidEntry
COLOR 14, 1: LOCATE 34, xPos + 3: PRINT m2$
searchMinutes = (VAL(h$) * 60) + VAL(m1$ + m2$)
PRINT "searchMinutes: " + S$(searchMinutes): ll$ = P$
a$ = "Is " + MinutesToHoursPassed$(searchMinutes) + " correct?": LOCATE 38, Center(a$): PRINT a$: w$ = INPUT$(1): IF UCASE$(w$) = "N" THEN GOTO invalidEntry
PRINT "searchMinutes: " + S$(searchMinutes): ll$ = P$
 
 
 
FUNCTION MinutesToHoursPassed$ (minutes AS SINGLE)
  'I'm not going to worry about days... yet
  rtn$ = ""
  hours = INT(minutes / 60)
  minutes = Round(minutes - (hours * 60))
  IF hours <> 0 THEN
    rtn$ = S$(hours) + " hour"
    IF hours <> 1 THEN rtn$ = rtn$ + "s"
    IF minutes <> 0 THEN rtn$ = rtn$ + " and "
  END IF
  IF minutes <> 0 THEN
    rtn$ = rtn$ + S$(minutes) + " minute"
    IF minutes <> 1 THEN rtn$ = rtn$ + "s"
  END IF
  MinutesToHoursPassed$ = rtn$
END FUNCTION
 
FUNCTION Center (text$): Center = INT((80 - LEN(text$)) / 2): END FUNCTION
 
FUNCTION S$ (number): S$ = LTRIM$(STR$(number)): END FUNCTION
 
FUNCTION P$
  pause$ = INPUT$(1)
  IF pause$ = CHR$(27) THEN
    '        SYSTEM
    END
  END IF
  P$ = pause$
END FUNCTION

The print statement just before passing it to MinutesToHoursPassed$ reports the variable as intended.
The second print statement reports searchMinutes as 0 after using the function. I copied the variable and only sent the copy to MinutesToHoursPassed$ and that worked, but shouldn't it have worked without having to do that?

I mnust've checkled the spelling 50 times. I put the number in a seconed variable not used for the call and that worked. Just wondering what's going on

QB64 Discussion / There is definitely an error but for the life of me I can't see it

« on: March 17, 2022, 08:12:41 pm »

I'm trying to test whether a given string is in the format of a call time. Call times are either H:MM:SS or MM:SS or M:SS
I keep getting a result of TRUE for "Cheese" and other seemingly random strings. I just don't know what the error is

Code: QB64: [Select]

CONST TRUE = 1
CONST FALSE = -1
 
FUNCTION IsCallTime (possibleCallTimeString$)
  rtn = TRUE
  pCt$ = possibleCallTimeString$
  IF LEN(pCt$) = 4 THEN
    '1234
    'M:SS
    IF MID$(pCt$, 2, 1) <> ":" THEN rtn = FALSE
    n1$ = LEFT$(pCt$, 1)
    IF ASC(n1$) < 48 OR ASC(n1$) > 57 THEN rtn = FALSE
    n2$ = MID$(pCt$, 3, 1)
    IF ASC(n2$) < 48 OR ASC(n2$) > 57 THEN rtn = FALSE
    n3$ = MID$(pCt$, 4, 1)
    IF ASC(n3$) < 48 OR ASC(n3$) > 57 THEN rtn = FALSE
    IF VAL(n1$ + n2$ + n3$) = 0 THEN rtn = FALSE
  ELSEIF LEN(pCt$) = 5 THEN
    '12345
    'MM:SS
    PRINT
    IF MID$(pCt$, 3, 1) <> ":" THEN rtn = FALSE
    n1$ = MID$(pCt$, 1, 1)
    IF ASC(n1$) < 48 OR ASC(n1$) > 57 THEN rtn = FALSE
    n2$ = MID$(pCt$, 2, 1)
    IF ASC(n2$) < 48 OR ASC(n2$) > 57 THEN rtn = FALSE
    n3$ = MID$(pCt$, 4, 1)
    IF ASC(n3$) < 48 OR ASC(n3$) > 57 THEN rtn = FALSE
    n4$ = MID$(pCt$, 5, 1)
    IF ASC(n4$) < 48 OR ASC(n4$) > 57 THEN rtn = FALSE
    IF VAL(n1$ + n2$ + n3$ + n$4) = 0 THEN rtn = FALSE
  ELSEIF LEN(pCt$) = 7 THEN
    '1234567
    'H:MM:SS
    IF MID$(pCt$, 2, 1) <> ":" THEN rtn = FALSE
    IF MID$(pCt$, 5, 1) <> ":" THEN rtn = FALSE
    n1$ = MID$(pCt$, 1, 1)
    IF ASC(n1$) < 48 OR ASC(n1$) > 57 THEN rtn = FALSE
    n2$ = MID$(pCt$, 3, 1)
    IF ASC(n2$) < 48 OR ASC(n2$) > 57 THEN rtn = FALSE
    n3$ = MID$(pCt$, 4, 1)
    IF ASC(n3$) < 48 OR ASC(n3$) > 57 THEN rtn = FALSE
    n4$ = MID$(pCt$, 6, 1)
    IF ASC(n4$) < 48 OR ASC(n4$) > 57 THEN rtn = FALSE
    n5$ = MID$(pCt$, 7, 1)
    IF ASC(n5$) < 48 OR ASC(n5$) > 57 THEN rtn = FALSE
    IF VAL(n1$ + n2$ + n3$ + n4$ + n5$) = 0 THEN rtn = FALSE
  END IF
  IsCallTime = rtn
END FUNCTION

QB64 Discussion / is this a buig, am I blind or do I just not know something abiout the code?

« on: March 06, 2022, 01:01:37 pm »

Code: QB64: [Select]

        PRINT "fileLine$ ="
        PRINT "|          Joe             C-23:54-C                                       |"
        IF INSTR(fileLine$, "C-") <> 0 AND INSTR(fileLine$, "-C") <> 0 THEN
          ctS = INSTR(fileLine$, "C-") + 2
          ctE = INSTR(fileLine$, "-C") - 1
          possibleCallTime$ = MID$(fileLine$, ctS, ctE - ctS + 1)
          IF IsCallTime(possibleCallTime$, collectingFigure) = TRUE THEN
            CLS
            PRINT "MID$(fileLine$, ctS, ctE - ctS + 1) = "
            PRINT MID$(fileLine$, ctS, ctE - ctS + 1) 'the MID$ here prints the entire string of "23:54"
            callTime$ = possibleCallTime$
            callTimeTotalSeconds = callTimeTotalSeconds + NumberOfSecondsInCallTime(callTime$)
            numberOfCalls = numberOfCalls + 1
            PRINT
 
            PRINT "         1         2         3         4         5         6         7"
            PRINT "1234567890123456789012345678901234567890123456789012345678901234567890123456:"
            PRINT fileLine$
            PRINT
            PRINT "ctS (callTimeStart): " + LTRIM$(STR$(ctS))
            PRINT "ctE (callTimeEnd): " + LTRIM$(STR$(ctE))
            'the following line only prints out the seconds in the call time but otherwise acts properly=
            PRINT "callTime$ = |" + callTime$ + "|     " 'here the minutes and colon are missing
            PRINT
            PRINT "NumberOfSecondsInCallTime(callTime$): " + S$(NumberOfSecondsInCallTime(callTime$))
            PRINT
            PRINT "callTimeTotalSeconds: " + S$(callTimeTotalSeconds)
            PRINT
            PRINT "numberOfCalls: " + S$(numberOfCalls)
            gg$ = P$
          END IF
        END IF

IsCallTime checks the format of the string and returns true if it is in the form of H:MM:SS, MM:SS or M:SS
NumberOfSecondsInCallTime converts the call time to seconds
'callTime$ has only the seconds printed to the screen. it is passed properly to the function that changes it into seconds and it works properly in IsCallTime but it won't print out properly. why?

QB64 Discussion / Trouble understanding MID$( )

« on: November 01, 2021, 03:58:25 pm »

Code: QB64: [Select]

startTime = 34
endTime = 42
lineToPrint$ = "|                                 9:30 AM N-the lobby between 10:13 AM-N   |"
 
 timeString$ = MID$(lineToPrint$, startTime, endTime)
 

the result I get for timeString$ is " 9:30 AM N-the lobby between 10:13 AM-N "

wtf?

am I missing something? I've had lots of problems with MID$(), especially with INSTR(). MID$() often requires me to fudge the numbers but still works consistently after doing so. Any suggestions?

Programs / CryptoGram finished!

« on: September 07, 2021, 09:36:54 pm »

This is a code word game. You are given a phrase in code. You have to decode it. These types of puzzles are often found in a newspaper. I hope you like it.

Code: QB64: [Select]

ON ERROR GOTO crap
GOTO beginning
crap:
PRINT "Error, Line number"
PRINT ERR, _ERRORLINE
END
beginning:
WIDTH 80, 50
_FULLSCREEN
RANDOMIZE TIMER
CONST TRUE = 1
CONST FALSE = 0
CONST numberOfLines = 15
CONST Easy = 1
CONST Normal = 2
CONST arrowKeyMove$ = "L64O2C"
CONST enterKeyHit$ = "L45O4C"
 
DIM SHARED leftArrow$: leftArrow$ = CHR$(0) + "K"
DIM SHARED rightArrow$: rightArrow$ = CHR$(0) + "M"
DIM SHARED upArrow$: upArrow$ = CHR$(0) + "H"
DIM SHARED downArrow$: downArrow$ = CHR$(0) + "P"
DIM SHARED translationMatrix$(1 TO 26, 1 TO 2): FOR cl = 1 TO 26: translationMatrix$(cl, 1) = "": translationMatrix$(cl, 2) = "": NEXT cl
DIM SHARED codedPhrase$: codedPhrase$ = ""
DIM SHARED answerPhrase$: answerPhrase$ = ""
DIM SHARED highlightedLetter: highlightedLetter = 0
DIM SHARED workingLines$(1 TO numberOfLines)
DIM SHARED initiallyCodedLines$(1 TO numberOfLines)
DIM SHARED answerLines$(1 TO numberOfLines)
DIM SHARED leftPositions(1 TO numberOfLines) AS INTEGER
DIM SHARED maxLineNumber: maxLineNumber = 0
DIM SHARED usersCode$(1 TO 26, 1 TO 2): FOR x = 1 TO 26: usersCode$(x, 1) = CHR$(x + 64): usersCode$(x, 2) = "-": NEXT x
DIM SHARED mode: mode = Normal
DIM SHARED loaded: loaded = FALSE
DIM SHARED numberOfPhrases
FOR cl = 1 TO numberOfLines
    workingLines$(cl) = ""
    initiallyCodedLines$(cl) = ""
    answerLines$(cl) = ""
    leftPositions(cl) = 0
NEXT cl
 
CALL Menu
 
SUB Menu
    opt = 1
    mode = Normal
    PrintAgain:
    COLOR 14, 2: CLS: tabs = 25
    a$ = "Main Menu": LOCATE 13, Center(a$): PRINT a$:
    LOCATE 14, Center(a$) - 1: PRINT "-----------"
    COLOR 14, 2: a$ = "Mode = Easy  Normal":
    LOCATE 16, Center(a$): PRINT "Mode = ";
    IF mode = Easy THEN
        COLOR 14, 0
    ELSEIF mode = Normal THEN
        COLOR 14, 2
    END IF
    PRINT "Easy";: COLOR 14, 2: PRINT " ";
    IF mode = Normal THEN
        COLOR 14, 0
    ELSEIF mode = Normal THEN
        COLOR 14, 2
    END IF
    PRINT "Normal"
 
    LOCATE 19, tabs
    COLOR 15, 2: PRINT "1.) ";
    IF opt = 1 THEN
        COLOR 14, 0:
    ELSE
        COLOR 14, 2
    END IF
    PRINT "Instructions"
 
    LOCATE 21, tabs
    COLOR 15, 2: PRINT "2.) ";
    IF opt = 2 THEN
        COLOR 14, 0
    ELSE
        COLOR 14, 2
    END IF
    PRINT "New Game"
 
    LOCATE 23, tabs
    COLOR 15, 2: PRINT "3.) ";
    IF opt = 3 THEN
        COLOR 14, 0
    ELSE
        COLOR 14, 2
    END IF
    PRINT "Load a Saved Game"
 
    LOCATE 25, tabs
    COLOR 15, 2: PRINT "4.) ";
    IF opt = 4 THEN
        COLOR 14, 0
    ELSE
        COLOR 14, 2
    END IF
    PRINT "Add New Phrase to Data File"
 
    LOCATE 27, tabs
    COLOR 15, 2: PRINT "5.) ";
    IF opt = 5 THEN
        COLOR 14, 0
    ELSE
        COLOR 14, 2
    END IF
    PRINT "End Game"
    DO
        choice$ = INKEY$
        SELECT CASE choice$
            CASE upArrow$
                opt = opt - 1
                IF opt = 0 THEN opt = 5
                PLAY arrowKeyMove$
                GOTO PrintAgain
            CASE leftArrow$
                IF mode = Easy THEN
                    mode = Normal
                ELSEIF mode = Normal THEN
                    mode = Easy
                END IF
                PLAY arrowKeyMove$
                GOTO PrintAgain
            CASE downArrow$
                opt = opt + 1
                IF opt = 6 THEN opt = 1
                PLAY arrowKeyMove$
                GOTO PrintAgain
            CASE rightArrow$
                IF mode = Easy THEN
                    mode = Normal
                ELSEIF mode = Normal THEN
                    mode = Easy
                END IF
                PLAY arrowKeyMove$
                GOTO PrintAgain
            CASE CHR$(13)
                PLAY enterKeyHit$
                IF opt = 1 THEN CALL Instructions
                IF opt = 2 THEN CALL Main
                IF opt = 3 THEN CALL LoadGame
                IF opt = 4 THEN CALL AddPhrase
                IF opt = 5 THEN END
                GOTO PrintAgain
            CASE "1"
                PLAY enterKeyHit$
                CALL Instructions
                GOTO PrintAgain
            CASE "2"
                PLAY enterKeyHit$
                loaded = FALSE
                CALL Main
                GOTO PrintAgain
            CASE "3"
                PLAY enterKeyHit$
                loaded = TRUE
                CALL LoadGame
                GOTO PrintAgain
            CASE "4"
                PLAY enterKeyHit$
                CALL AddPhrase
                GOTO PrintAgain
            CASE "5"
                PLAY enterKeyHit$
                END
        END SELECT
    LOOP UNTIL choice$ = CHR$(13) OR choice$ = "5"
END SUB
 
SUB Instructions
    COLOR 10, 13: CLS
    a$ = "A random phrase picked from " + CHR$(34) + "Phrases.txt" + CHR$(34) + " will be displayed in code."
    LOCATE 12, Center(a$): PRINT a$
    a$ = "The goal is to decode the phrase. The coded letters are in one color": LOCATE 14, Center(a$): PRINT a$
    a$ = "and the letters you choose in another color. In easy mode, incorrect": LOCATE 16, Center(a$): PRINT a$
    a$ = "letters are displayed in yet another color. Different types": LOCATE 18, Center(a$): PRINT a$
    a$ = "of hints are available from the hint menu.": LOCATE 20, Center(a$): PRINT a$
    a$ = "Use the arrow keys to select the letter you wish to change. Type": LOCATE 25, Center(a$): PRINT a$
    a$ = "in the letter you wish to change it to. Push the [ESC] key": LOCATE 27, Center(a$): PRINT a$
    a$ = "to reset the puzzle to the starting code.": LOCATE 29, Center(a$): PRINT a$
 
    a$ = "Hit any key to return to the Main Menu": LOCATE 45, Center(a$): COLOR 11, 13: PRINT a$: l$ = P$
END SUB
 
SUB AddPhrase
    COLOR 11, 13
    CLS
    a$ = "Type in the phrase you want to add. Do not hit": LOCATE 15, Center(a$): PRINT a$
    a$ = " the [ENTER] key until you've entered the entire phrase. ": LOCATE 17, Center(a$): PRINT a$
    a$ = "Don't worry if your entry passes the end of the screen": LOCATE 19, Center(a$): PRINT a$
    a$ = "and continues on to the next line. In fact, longer": LOCATE 21, Center(a$): PRINT a$
    a$ = "phrases are easier to decode.": LOCATE 23, Center(a$): PRINT a$
 
    LOCATE 28, 10: LINE INPUT "Type in your phrase: ", newPhrase$
    maxIndex = FileStatus
    DIM fileArray$(1 TO maxIndex + 1)
    OPEN "Phrases.txt" FOR INPUT AS #1
    FOR index = 1 TO maxIndex
        LINE INPUT #1, fileArray$(index)
    NEXT index
    CLOSE #1
 
    fileArray$(maxIndex + 1) = newPhrase$
    OPEN "Phrases.txt" FOR OUTPUT AS #1
    FOR index = 1 TO maxIndex + 1
        PRINT #1, fileArray$(index)
    NEXT index
    PRINT #1, "EOF"
    CLOSE #1
END SUB
 
 
SUB LoadGame
    maxLineNumber = 0
    FOR index = 1 TO 26
        translationMatrix$(index, 1) = "": translationMatrix$(index, 2) = ""
        usersCode$(index, 1) = "": usersCode$(index, 2) = ""
    NEXT index
    codedPhrase$ = ""
    answerPhrase$ = ""
    highlightedLetter = 0
    mode = 0
    FOR index = 1 TO 15
        workingLines$(index) = ""
        initiallyCodedLines$(index) = ""
        answerLines$(index) = ""
        leftPositions(index) = 0
    NEXT index
 
    OPEN "CryptoGram" FOR INPUT AS #1
    LINE INPUT #1, mLN$: maxLineNumber = VAL(mLN$)
    FOR index = 1 TO 26
        LINE INPUT #1, translationMatrix$(index, 1)
        LINE INPUT #1, translationMatrix$(index, 2)
        LINE INPUT #1, usersCode$(index, 1)
        LINE INPUT #1, usersCode$(index, 2)
    NEXT index
    LINE INPUT #1, codedPhrase$
    LINE INPUT #1, answerPhrase$
    LINE INPUT #1, hL$: PRINT hL$: g$ = P$: highlightedLetter = VAL(hL$)
    LINE INPUT #1, m$: mode = VAL(m$)
    FOR index = 1 TO maxLineNumber
        LINE INPUT #1, workingLines$(index)
        LINE INPUT #1, initiallyCodedLines$(index)
        LINE INPUT #1, answerLines$(index)
        LINE INPUT #1, lP$: leftPositions(index) = VAL(lP$)
    NEXT index
    CLOSE #1
    loaded = TRUE: CALL Main
END SUB
 
SUB SaveGame
    OPEN "CryptoGram" FOR OUTPUT AS #1
    PRINT #1, S$(maxLineNumber)
    FOR index = 1 TO 26
        PRINT #1, translationMatrix$(index, 1)
        PRINT #1, translationMatrix$(index, 2)
        PRINT #1, usersCode$(index, 1)
        PRINT #1, usersCode$(index, 2)
    NEXT index
    PRINT #1, codedPhrase$
    PRINT #1, answerPhrase$
    PRINT #1, S$(highlightedLetter)
    PRINT #1, S$(mode)
    FOR index = 1 TO maxLineNumber
        PRINT #1, workingLines$(index)
        PRINT #1, initiallyCodedLines$(index)
        PRINT #1, answerLines$(index)
        PRINT #1, S$(leftPositions(index))
    NEXT index
    CLOSE #1
    _DELAY (0.25)
    PLAY arrowKeyMove$
END SUB
 
SUB Main
    IF loaded = FALSE THEN
 
        COLOR 15, 1
        'first, pick a phrase
        randomPhrase = INT(RND * FileStatus) + 1
        OPEN "Phrases.txt" FOR INPUT AS #1
        FOR x = 1 TO randomPhrase
            LINE INPUT #1, answerPhrase$
        NEXT x
        CLOSE #1
 
        'second, create a code
        usedAlphabet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        FOR allLetters = 1 TO 26
            translationMatrix$(allLetters, 1) = CHR$(allLetters + 64)
            newRndLet:
            randomLetter = INT(RND * LEN(usedAlphabet$)) + 1
            translationMatrix$(allLetters, 2) = MID$(usedAlphabet$, randomLetter, 1)
            IF translationMatrix$(allLetters, 1) = translationMatrix$(allLetters, 2) THEN GOTO newRndLet
            usedAlphabet$ = MID$(usedAlphabet$, 1, randomLetter - 1) + MID$(usedAlphabet$, randomLetter + 1, LEN(usedAlphabet$))
        NEXT allLetters
 
        'third: put the phrase in code
        FOR letter = 1 TO LEN(answerPhrase$)
            answerLetter$ = MID$(answerPhrase$, letter, 1)
            upAnsLet$ = UCASE$(answerLetter$)
            answerLetterNumber = ASC(upAnsLet$) - 64
            IF ASC(upAnsLet$) >= 65 AND ASC(upAnsLet$) <= 90 THEN
                upCodeLet$ = translationMatrix$(ASC(upAnsLet$) - 64, 2)
                IF ASC(answerLetter$) >= 65 AND ASC(answerLetter$) <= 90 THEN
                    codedLetter$ = upCodeLet$
                ELSE
                    codedLetter$ = LCASE$(upCodeLet$)
                END IF
            ELSE
                codedLetter$ = answerLetter$
            END IF
            codedPhrase$ = codedPhrase$ + codedLetter$
        NEXT letter
 
        'next on the list is to center the phrases
        lineNumber = 0
        shrinkingCode$ = codedPhrase$
        shrinkingAnswer$ = answerPhrase$
        DO
            checking = 60
            DO
                wheresSpace$ = MID$(shrinkingAnswer$, checking, 1)
                checking = checking - 1
            LOOP UNTIL wheresSpace$ = CHR$(32)
            lineNumber = lineNumber + 1
            answerLines$(lineNumber) = MID$(shrinkingAnswer$, 1, checking)
            workingLines$(lineNumber) = MID$(shrinkingCode$, 1, checking)
            initiallyCodedLines$(lineNumber) = MID$(shrinkingCode$, 1, checking)
            leftPositions(lineNumber) = Center(answerLines$(lineNumber))
            shrinkingAnswer$ = MID$(shrinkingAnswer$, checking + 1, LEN(shrinkingAnswer$))
            shrinkingCode$ = MID$(shrinkingCode$, checking + 1, LEN(shrinkingCode$))
        LOOP UNTIL LEN(shrinkingAnswer$) <= 60
        lineNumber = lineNumber + 1
        answerLines$(lineNumber) = shrinkingAnswer$
        leftPositions(lineNumber) = Center(answerLines$(lineNumber))
        workingLines$(lineNumber) = shrinkingCode$
        initiallyCodedLines$(lineNumber) = shrinkingCode$
 
        maxLineNumber = lineNumber
 
        highlightedLetter = 1
    END IF
    refresh = TRUE
    DO
        userInput$ = UCASE$(INKEY$)
        SELECT CASE userInput$
            CASE "1"
                PLAY enterKeyHit$
                refresh = TRUE
                CALL Hints
            CASE "2"
                PLAY enterKeyHit$
                CALL SaveGame
            CASE CHR$(27)
                PLAY enterKeyHit$ + enterKeyHit$ + arrowKeyMove$
                CALL RestartPuzzle
                refresh = TRUE
            CASE "5"
                PLAY enterKeyHit$
                CALL Menu
            CASE leftArrow$
                PLAY arrowKeyMove$
                IF highlightedLetter > 1 THEN
                    highlightedLetter = highlightedLetter - 1
                ELSE
                    highlightedLetter = 26
                END IF
                refresh = TRUE
            CASE rightArrow$
                PLAY arrowKeyMove$
                IF highlightedLetter < 26 THEN
                    highlightedLetter = highlightedLetter + 1
                ELSE
                    highlightedLetter = 1
                END IF
                refresh = TRUE
            CASE "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"
                PLAY enterKeyHit$
                usersCode$(highlightedLetter, 2) = userInput$
                CALL Switch(userInput$)
                refresh = TRUE
        END SELECT
 
        IF refresh = TRUE THEN
            refresh = FALSE
            CALL ShowPuzzle
        END IF
    LOOP UNTIL userInput$ = "9" OR CorrectPhrase = TRUE
    IF CorrectPhrase = TRUE THEN
        COLOR 11, 0
        LOCATE 25, Center("success")
        PRINT "SUCCESS!!"
        _DELAY (10)
    END IF
END SUB
 
SUB Hints
    nope:
    COLOR 14, 1
    CLS
    a$ = "You have an option of 3 types of hints to choose from.": LOCATE 10, Center(a$): PRINT a$
    a$ = "Wheel of Fortune reveals the letters for R, S, T, L, N and E": LOCATE 11, Center(a$): PRINT a$
    a$ = "Or you can choose to reveal a single letter.": LOCATE 12, Center(a$): PRINT a$
    a$ = "Example phrase = Rmtleyr ewatbr": LOCATE 14, Center(a$): COLOR 10, 1: PRINT "Example phrase ";: COLOR 14, 1: PRINT "=";: COLOR 10, 1: PRINT " Rmtleyr ewatbr": COLOR 14, 1
    a$ = "1.) Wheel of Fortune: Example phrase = Emtlele ewrtse": LOCATE 17, Center(a$): PRINT "1.) Wheel of Fortune: ";: COLOR 10, 1: PRINT "Example phrase = ";
    COLOR 12, 1: PRINT "E";: COLOR 10, 1: PRINT "mtle";: COLOR 12, 1: PRINT "le";: COLOR 10, 1: PRINT " ew";: COLOR 12, 1: PRINT "r";: COLOR 10, 1: PRINT "t";: COLOR 12, 1: PRINT "se": COLOR 14, 1
    a$ = "2.) Reveal a single random letter: Rmtleyr ewatbr": LOCATE 19, Center(a$): PRINT "2.) Reveal a single random letter: ";: COLOR 12, 1: PRINT "E";: COLOR 10, 1
    PRINT "mtley";: COLOR 12, 1: PRINT "e";: COLOR 10, 1: PRINT " ewrts";: COLOR 12, 1: PRINT "e": COLOR 14, 1
    a$ = "3.) Choose a single coded letter to decode:": LOCATE 21, Center(a$): PRINT a$
    a$ = "    Pick any letter in example phrase": LOCATE 22, Center(a$): PRINT "    Pick any letter in ";: COLOR 10, 1: PRINT "R";
    COLOR 12, 1: PRINT "m";: COLOR 10, 1: PRINT "tleyr ewatbr";: COLOR 14, 1
    a$ = "      to be revealed in example phrase": LOCATE 23, Center(a$): PRINT "      to be revealed in ";: COLOR 10, 1: PRINT "E";: COLOR 12, 1: PRINT "x";: COLOR 10, 1: PRINT "ample phrase": COLOR 14, 1
    a$ = "4.) Reveal a letter you think is in the answer phrase:": LOCATE 25, Center(a$): PRINT a$
    a$ = "Choosing " + CHR$(34) + "K" + CHR$(34) + " wouldn't reveal anything. Choosing " + CHR$(34) + "L" + CHR$(34): LOCATE 26, Center(a$): PRINT a$
    a$ = " Reveals the " + CHR$(34) + "L" + CHR$(34) + " -- example phrase": LOCATE 27, Center(a$): PRINT "reveals the " + CHR$(34) + "L" + CHR$(34) + " -- ";
    COLOR 10, 1: PRINT "Examp";: COLOR 12, 1: PRINT "l";: COLOR 10, 1: PRINT "e phrase": COLOR 14, 1
    a$ = "5.) Switch to easy mode": LOCATE 29, Center(a$): PRINT a$
    a$ = "6.) Display every coded letter and the letter": LOCATE 31, Center(a$): PRINT a$
    a$ = "       it should be for 2 seconds": LOCATE 32, Center(a$): PRINT a$
 
 
 
    a$ = "7.) Cancel": LOCATE 35, Center(a$): PRINT a$
    PLAY arrowKeyMove$
    r$ = P$
    PLAY enterKeyHit$
    SELECT CASE r$
        CASE "1"
            r$ = translationMatrix$(18, 2): re = ASC(r$) - 64: highlightedLetter = re: CALL Switch("R"): usersCode$(re, 2) = "R"
            ss$ = translationMatrix$(19, 2): se = ASC(ss$) - 64: highlightedLetter = se: CALL Switch("S"): usersCode$(se, 2) = "S"
            t$ = translationMatrix$(20, 2): te = ASC(t$) - 64: highlightedLetter = te: CALL Switch("T"): usersCode$(te, 2) = "T"
            l$ = translationMatrix$(12, 2): le = ASC(l$) - 64: highlightedLetter = le: CALL Switch("L"): usersCode$(le, 2) = "L"
            n$ = translationMatrix$(14, 2): ne = ASC(n$) - 64: highlightedLetter = ne: CALL Switch("N"): usersCode$(ne, 2) = "N"
            e$ = translationMatrix$(5, 2): ee = ASC(e$) - 64: highlightedLetter = ee: CALL Switch("E"): usersCode$(ee, 2) = "E"
        CASE "2"
            gotThis:
            tryAgain:
            there = FALSE
            someRandom$ = CHR$((INT(RND * 26)) + 65)
            FOR x = 1 TO maxLineNumber
                FOR y = 1 TO LEN(answerLines$(x))
                    IF UCASE$(MID$(answerLines$(x), y, 1)) = someRandom$ THEN there = TRUE
                NEXT y
            NEXT x
            IF there = FALSE THEN GOTO tryAgain
            itShouldBeCodedAs$ = translationMatrix$(ASC(someRandom$) - 64, 2)
            usersAttempt$ = usersCode$(ASC(itShouldBeCodedAs$) - 64, 2)
            IF usersAttempt$ = someRandom$ THEN GOTO tryAgain
            highlightedLetter = ASC(itShouldBeCodedAs$) - 64
            Switch (someRandom$)
            usersCode$(highlightedLetter, 2) = someRandom$
        CASE "3"
            PRINT: PRINT
            a$ = "What code letter do you want to know the answer letter for?    ": LOCATE , Center(a$): PRINT a$;
            invlInp:
            someCodedLetter$ = UCASE$(P$)
            ascSomeCodedLetter = ASC(someCodedLetter$) - 64
            correctLetter$ = ""
            FOR index = 1 TO 26
                IF translationMatrix$(index, 2) = someCodedLetter$ THEN correctLetter$ = translationMatrix$(index, 1)
            NEXT index
            highlightedLetter = ascSomeCodedLetter
            CALL Switch(correctLetter$)
        CASE "4"
            a$ = "What answer letter do you want the code for?    ": LOCATE , Center(a$): PRINT a$;
            invlInpt:
            d$ = UCASE$(P$)
            da = ASC(d$) - 64
 
            ans$ = translationMatrix$(da, 2)
            highlightedLetter = da
            CALL Switch(ans$)
        CASE "5"
            mode = Easy
        CASE "6"
            COLOR 15, 1
            CLS
            FOR index = 1 TO 26
                LOCATE 22, ((80 - 52) / 2) + (index * 2)
                PRINT translationMatrix$(index, 1)
                LOCATE 24, ((80 - 52) / 2) + (index * 2)
                PRINT translationMatrix$(index, 2)
            NEXT index
            _DELAY (2)
        CASE "7"
            'just go away
        CASE ELSE
            GOTO nope
    END SELECT
    highlightedLetter = 1
END SUB
 
FUNCTION CorrectPhrase
    ag = TRUE
    FOR x = 1 TO maxLineNumber
        IF workingLines$(x) <> answerLines$(x) THEN ag = FALSE
    NEXT x
    CorrectPhrase = ag
END FUNCTION
 
SUB Switch (withThis$)
    DIM newLines$(1 TO maxLineNumber): FOR i = 1 TO maxLineNumber: newLines$(i) = "": NEXT i
    FOR l = 1 TO maxLineNumber
        FOR c = 1 TO LEN(workingLines$(l))
            letter$ = CHR$(highlightedLetter + 64)
            initialLetter$ = MID$(initiallyCodedLines$(l), c, 1)
            wcl$ = MID$(workingLines$(l), c, 1)
            IF ASC(initialLetter$) >= 65 AND ASC(initialLetter$) <= 90 THEN
                withThis$ = UCASE$(withThis$)
            ELSEIF ASC(initialLetter$) >= 97 AND ASC(initialLetter$) <= 122 THEN
                withThis$ = LCASE$(withThis$)
            ELSE
            END IF
            IF letter$ = UCASE$(initialLetter$) THEN
                newLines$(l) = newLines$(l) + withThis$
            ELSE
                newLines$(l) = newLines$(l) + wcl$
            END IF
        NEXT c 'haracter
    NEXT l 'ine
    FOR index = 1 TO maxLineNumber
        workingLines$(index) = newLines$(index)
    NEXT index
END SUB
 
SUB RestartPuzzle
    FOR c = 1 TO maxLineNumber
        workingLines$(c) = initiallyCodedLines$(c)
    NEXT c
    FOR xx = 1 TO 26
        usersCode$(xx, 2) = "-"
    NEXT xx
END SUB
 
SUB ShowPuzzle
    COLOR 10, 1: CLS
 
    FOR eachLine = 1 TO maxLineNumber
        LOCATE 13 + eachLine, leftPositions(eachLine)
        FOR eachLetter = 1 TO LEN(workingLines$(eachLine))
            f$ = MID$(workingLines$(eachLine), eachLetter, 1)
            icl$ = MID$(initiallyCodedLines$(eachLine), eachLetter, 1)
            correct$ = MID$(answerLines$(eachLine), eachLetter, 1)
            ac = ASC(UCASE$(icl$)) - 64
            IF f$ <> icl$ THEN
                COLOR 12, 1
            END IF
            IF f$ = correct$ AND mode = Easy THEN
                COLOR 15, 1
            END IF
            IF highlightedLetter = ac THEN
                COLOR 10, 0
            END IF
            IF f$ = icl$ AND highlightedLetter <> ac AND f$ <> correct$ THEN COLOR 10, 1
 
            PRINT f$;
            COLOR 10, 1
        NEXT eachLetter
    NEXT eachLine
    spaces = 2
    FOR x = 1 TO 26
        IF x = highlightedLetter THEN
            COLOR 10, 0
        ELSE
            COLOR 10, 1
        END IF
        LOCATE 35, spaces
        PRINT usersCode$(x, 1)
        LOCATE 37, spaces
        PRINT usersCode$(x, 2)
        spaces = spaces + 3
    NEXT x
    a$ = "Push 1 to access the hint menu"
    LOCATE 43, Center(a$): COLOR 14, 1: PRINT a$
    a$ = "Push 2 to save the game and quit": COLOR 14, 1: LOCATE 45, Center(a$): PRINT a$
    a$ = "Push [ESC] to reset": LOCATE 47, Center(a$): COLOR 14, 1: PRINT a$
    a$ = "Push 5 to quit": LOCATE 49, Center(a$): COLOR 14, 1: PRINT a$
END SUB
 
FUNCTION FileStatus
    IF _FILEEXISTS("Phrases.txt") = 0 THEN
        OPEN "Phrases.txt" FOR OUTPUT AS #1
        PRINT #1, "Tomorrow, and tomorrow, and tomorrow, Creeps in this petty pace from day to day, To the last syllable of recorded time; And all our yesterdays have lighted fools The way to dusty death. Out, out, brief candle! Life's but a walking shadow, a poor player, That struts and frets his hour upon the stage, And then is heard no more. It is a tale Told by an idiot, full of sound and fury, Signifying nothing."
        PRINT #1, "To be, or not to be: that is the question: Whether 'tis nobler in the mind to suffer The slings and arrows of outrageous fortune, Or to take arms against a sea of troubles, And by opposing end them? To die: to sleep; No more; and by a sleep to say we end The heart-ache and the thousand natural shocks That flesh is heir to, 'tis a consummation Devoutly to be wish'd. To die, to sleep; To sleep: perchance to dream"
        PRINT #1, "If someone is able to show me that what I think or do is not right, I will happily change. For I seek the truth, by which no oe ever was truly harmed. Harmed is the person who continues in his self-deception and ignorance."
        PRINT #1, "Funny lines: Before you marry a person, you should first make them use a computer with slow internet to see who they really are. -- Someone asked me, if I were stranded on a desert island what book would I bring... " + CHR$(34) + "How to Build a Boat." + CHR$(34)
        PRINT #1, "Funny lines: I finally realized that people are prisoners of their own phones... that's why it's called a " + CHR$(34) + "cell" + CHR$(34) + " phone. -- Be decisive. Right or wrong, make a decision. The road is paved with flat squirrels who couldn't make a decision."
        PRINT #1, "Funny lines: If at first you don't succeed, then skydiving definitely isn't for you. -- My cell phone is acting up. I keep pressing the Home button but every time I look around, I'm still at work."
        PRINT #1, "Pangrams: Pack my box with five dozen liquor jugs. -- The quick brown fox jumps over the lazy dog. -- My girl wove six dozen plaid jackets before she quit."
        PRINT #1, "EOF"
        CLOSE #1
        numberOfPhrases = 7
    ELSE
        OPEN "Phrases.txt" FOR INPUT AS #1
        numberOfPhrases = 0
        DO
            numberOfPhrases = numberOfPhrases + 1
            LINE INPUT #1, lineCounting$
        LOOP UNTIL INSTR(lineCounting$, "EOF") <> 0
        numberOfPhrases = numberOfPhrases - 1
        CLOSE #1
    END IF
    FileStatus = numberOfPhrases
END FUNCTION
 
FUNCTION Center (text$)
    Center = INT((80 - LEN(text$)) / 2)
END FUNCTION
 
FUNCTION S$ (number)
    S$ = LTRIM$(STR$(number))
END FUNCTION
 
FUNCTION P$
    pause$ = INPUT$(1)
    IF pause$ = CHR$(27) THEN END
    P$ = pause$
END FUNCTION
 

QB64 Discussion / I'm stumped by this error

« on: September 06, 2021, 04:33:48 pm »

I'm writing a puzzle game. You start with a phrase spelled with different letters than the ones actually in the phrase. You continue along until you have the original phrase. The letters appear in one color if you've changed it and another color for the original code. I got it working so the first letter you choose to switch displays properly. But every time you try to change another letter, the lines of the phrase are printed out twice. The second printed line is in a different color. I'm at wits end. Any help would be much appreciated.

Code: QB64: [Select]

ON ERROR GOTO crap
GOTO beginning
crap:
PRINT "Error, Line number"
PRINT ERR, _ERRORLINE
END
beginning:
WIDTH 80, 50
_FULLSCREEN
CONST TRUE = 1
CONST FALSE = 0
CONST numberOfLines = 15
 
DIM SHARED leftArrow$: leftArrow$ = CHR$(0) + "K"
DIM SHARED rightArrow$: rightArrow$ = CHR$(0) + "M"
DIM SHARED translationMatrix$(1 TO 26, 1 TO 2): FOR cl = 1 TO 26: translationMatrix$(cl, 1) = "": translationMatrix$(cl, 2) = "": NEXT cl
DIM SHARED codedPhrase$: codedPhrase$ = ""
DIM SHARED answerPhrase$: answerPhrase$ = ""
DIM SHARED highlightedLetter: highlightedLetter = 0
DIM SHARED attemptedLetters$(1 TO 26, 1 TO 2): FOR cl = 1 TO 26: attemptedLetters$(cl, 1) = CHR$(cl + 64): attemptedLetters$(cl, 2) = "-": NEXT cl
DIM SHARED workingLines$(1 TO numberOfLines)
DIM SHARED initiallyCodedLines$(1 TO numberOfLines)
DIM SHARED newLines$(1 TO numberOfLines)
DIM SHARED answerLines$(1 TO numberOfLines)
DIM SHARED leftPositions(1 TO numberOfLines) AS INTEGER
FOR cl = 1 TO numberOfLines
    workingLines$(cl) = ""
    initiallyCodedLines$(cl) = ""
    newLines$(cl) = ""
    answerLines$(cl) = ""
    leftPositions(cl) = 0
NEXT cl
 
CALL Main
SUB Main
    'first, pick a phrase
    randomPhrase = INT(RND * FileStatus) + 1
    OPEN "Phrases.txt" FOR INPUT AS #1
    FOR x = 1 TO randomPhrase
        LINE INPUT #1, answerPhrase$
    NEXT x
    CLOSE #1
 
    'second, create a code
    usedAlphabet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    FOR allLetters = 1 TO 26
        translationMatrix$(allLetters, 1) = CHR$(allLetters + 64)
        newRndLet:
        randomLetter = INT(RND * LEN(usedAlphabet$)) + 1
        translationMatrix$(allLetters, 2) = MID$(usedAlphabet$, randomLetter, 1)
        IF translationMatrix$(allLetters, 1) = translationMatrix$(allLetters, 2) THEN GOTO newRndLet
        usedAlphabet$ = MID$(usedAlphabet$, 1, randomLetter - 1) + MID$(usedAlphabet$, randomLetter + 1, LEN(usedAlphabet$))
    NEXT allLetters
 
    'third: put the phrase in code
    PRINT "answerPhrase$ = " + answerPhrase$: PRINT
    FOR letter = 1 TO LEN(answerPhrase$)
        answerLetter$ = MID$(answerPhrase$, letter, 1)
        upAnsLet$ = UCASE$(answerLetter$)
        answerLetterNumber = ASC(upAnsLet$) - 64
        IF ASC(upAnsLet$) >= 65 AND ASC(upAnsLet$) <= 90 THEN
            upCodeLet$ = translationMatrix$(ASC(upAnsLet$) - 64, 2)
            IF ASC(answerLetter$) >= 65 AND ASC(answerLetter$) <= 90 THEN
                codedLetter$ = upCodeLet$
            ELSE
                codedLetter$ = LCASE$(upCodeLet$)
            END IF
        ELSE
            codedLetter$ = answerLetter$
        END IF
        codedPhrase$ = codedPhrase$ + codedLetter$
    NEXT letter
 
    'next on the list is to center the phrases
    shrinkCode$ = codedPhrase$
    shrinkAns$ = answerPhrase$
    IF LEN(codedPhrase$) >= 60 THEN
        numLine = 0
        DO
            numLine = numLine + 1
            checkHere = 60
            DO
                checkHere = checkHere - 1
                findSpace$ = MID$(codedPhrase$, checkHere, 1)
            LOOP UNTIL findSpace$ = " "
            workingLines$(numLine) = MID$(shrinkCode$, 1, checkHere)
            initiallyCodedLines$(numLine) = MID$(shrinkCode$, 1, checkHere)
            leftPositions(numLine) = Center(MID$(shrinkCode$, 1, checkHere))
            answerLines$(numLine) = MID$(shrinkAns$, 1, checkHere)
            shrinkCode$ = MID$(shrinkCode$, checkHere + 1, LEN(shrinkCode$))
            shrinkAns$ = MID$(shrinkAns$, checkHere + 1, LEN(shrinkAns$))
        LOOP UNTIL numLine = 15 OR shrinkCode$ = ""
    ELSE
        workingLines$(1) = codedPhrase$
        initiallyCodedLines$(1) = codedPhrase$
        answerLines$(1) = answerPhrase$
        leftPositions(1) = Center(codedPhrase$)
    END IF
    cs = 1
    '    DO WHILE leftPositions(cs) <> 0
    '        LOCATE , leftPositions(cs): PRINT answerLines$(cs)
    '        cs = cs + 1
    '    LOOP
    PRINT
    '    gg = 1
    '    DO WHILE leftPositions(gg) <> 0
    '        LOCATE , leftPositions(gg): PRINT workingLines$(gg)
    '        gg = gg + 1
    '    LOOP
    '    a$ = P$
 
    'now to display and build the interface
    highlightedLetter = 1
    CALL DisplayScreen
    '    d$ = P$
    plsWt = FALSE
    DO
        '        FOR cv = 1 TO numberOfLines: newLines$(cv) = "": NEXT cv
        getCmd$ = INKEY$
        getCmd$ = UCASE$(getCmd$)
        SELECT CASE getCmd$
            CASE leftArrow$
                IF highlightedLetter > 1 THEN
                    highlightedLetter = highlightedLetter - 1
                ELSE
                    highlightedLetter = 26
                END IF
                plsWt = TRUE
            CASE rightArrow$
                IF highlightedLetter < 26 THEN
                    highlightedLetter = highlightedLetter + 1
                ELSE
                    highlightedLetter = 1
                END IF
                plsWt = TRUE
            CASE CHR$(13)
                FOR cl = 1 TO 26
                    attemptedLetters$(cl, 1) = CHR$(cl + 64)
                    attemptedLetters$(cl, 2) = "-"
                NEXT cl
                FOR x = 1 TO numberOfLines
                    workingLines$(x) = initiallyCodedLines$(x)
                NEXT x
            CASE CHR$(27)
                END
            CASE "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"
                plsWt = TRUE
                attemptedLetters$(highlightedLetter, 2) = getCmd$
                numLines = 1
                DO WHILE workingLines$(numLines) <> ""
                    FOR let1 = 1 TO LEN(workingLines$(numLines))
                        currentLetter$ = MID$(workingLines$(numLines), let1, 1)
                        '                        LOCATE 1, 1: PRINT "currentLetter$: " + currentLetter$: g$ = P$
                        IF CHR$(highlightedLetter + 64) = UCASE$(currentLetter$) THEN
                            replacementLetter$ = getCmd$
                            letCase = ASC(MID$(workingLines$(numLines), let1, 1))
                            IF letCase >= 97 AND letCase <= 122 THEN replacementLetter$ = LCASE$(replacementLetter$)
                            newLines$(numLines) = newLines$(numLines) + replacementLetter$
                        ELSE
                            newLines$(numLines) = newLines$(numLines) + currentLetter$
                        END IF
                        '                        PRINT "**************************************************************************************************"
                        '                        PRINT "newLines$(numLines) = " + newLines$(numLines): k$ = P$
                    NEXT let1
                    numLines = numLines + 1
                LOOP
        END SELECT
        IF plsWt = TRUE THEN
            plsWt = FALSE
            f = 1
            DO WHILE newLines$(f) <> ""
                workingLines$(f) = newLines$(f)
                f = f + 1
            LOOP
            CALL DisplayScreen
        END IF
    LOOP UNTIL SolvedIt = TRUE
END SUB
 
FUNCTION SolvedIt
    rtn = TRUE
    FOR checkTheLine = 1 TO numberOfLines
        IF workingLines$(checkTheLine) <> answerLines$(checkTheLine) THEN rtn = FALSE
    NEXT checkTheLine
    SolvedIt = rtn
END FUNCTION
 
 
SUB DisplayScreen
    COLOR 11, 1: CLS
    LOCATE 1, 1: PRINT answerPhrase$
    'print out the quote
    numLines = 1
    DO WHILE leftPositions(numLines) <> 0
        'LOCATE 48, 1: PRINT "leftPositions(numLines) = " + S$(leftPositions(numLines)) + " ": c$ = P$
        LOCATE 11 + numLines, leftPositions(numLines)
        '        PRINT "numLines: " + S$(numLines) + "    workingLine$(numlines), LEN = " + workingLines$(numLines) + ",   " + S$(LEN(workinglines(numLines)))
        '        PRINT "initiallyCodedLines$(" + S$(numLines) + "): = " + initiallyCodedLines$(numLines)
        '        PRINT "answerLines$(numLines)" + answerLines$(numLines)
        '        f$ = P$
        FOR o = 1 TO LEN(workingLines$(numLines))
            wlc$ = MID$(workingLines$(numLines), o, 1)
            icl$ = MID$(initiallyCodedLines$(numLines), o, 1)
            al$ = MID$(answerLines$(numLines), o, 1)
            IF ASC(UCASE$(wlc$)) - 64 = highlightedLetter THEN 'if the letter is highlighted print 11 on 0
                COLOR 10, 0
            ELSEIF wlc$ = al$ THEN 'the letter is correct
                COLOR 14, 1
            ELSEIF wlc$ <> icl$ THEN 'the letter has been changed or not changed back to its original code
                COLOR 15, 1
            ELSE
                COLOR 10, 1
            END IF
            PRINT wlc$; ': f$ = P$
        NEXT o
        numLines = numLines + 1
    LOOP
    'print out the selectable letters
    spaces = 2
    FOR b = 1 TO 26
        IF b = highlightedLetter THEN
            COLOR 10, 0
        ELSE
            COLOR 14, 1
        END IF
        LOCATE 40, spaces: PRINT attemptedLetters$(b, 1)
        IF b = highlightedLetter THEN
            COLOR 10, 0
        ELSE
            COLOR 12, 1
        END IF
        LOCATE 42, spaces: PRINT attemptedLetters$(b, 2)
        spaces = spaces + 3
    NEXT b
END SUB
 
 
FUNCTION FileStatus
    IF _FILEEXISTS("Phrases.txt") = 0 THEN
        OPEN "Phrases.txt" FOR OUTPUT AS #1
        PRINT #1, "Tomorrow, and tomorrow, and tomorrow, Creeps in this petty pace from day to day, To the last syllable of recorded time; And all our yesterdays have lighted fools The way to dusty death. Out, out, brief candle! Life's but a walking shadow, a poor player, That struts and frets his hour upon the stage, And then is heard no more. It is a tale Told by an idiot, full of sound and fury, Signifying nothing."
        PRINT #1, "To be, or not to be: that is the question: Whether 'tis nobler in the mind to suffer The slings and arrows of outrageous fortune, Or to take arms against a sea of troubles, And by opposing end them? To die: to sleep; No more; and by a sleep to say we end The heart-ache and the thousand natural shocks That flesh is heir to, 'tis a consummation Devoutly to be wish'd. To die, to sleep; To sleep: perchance to dream: ay, there's the rub; For in that sleep of death what dreams may come When we have shuffled off this mortal coil, Must give us pause"
        PRINT #1, "If someone is able to show me that what I think or do is not right, I will happily change. For I seek the truth, by which no oe ever was truly harmed. Harmed is the person who continues in his self-deception and ignorance."
        PRINT #1, "Funny lines: Before you marry a person, you should first make them use a computer with slow internet to see who they really are. -- Someone asked me, if I were stranded on a desert island what book would I bring... " + CHR$(34) + "How to Build a Boat." + CHR$(34)
        PRINT #1, "Funny lines: I finally realized that people are prisoners of their own phones... that's why it's called a " + CHR$(34) + "cell" + CHR$(34) + " phone. -- Be decisive. Right or wrong, make a decision. The road is paved with flat squirrels who couldn't make a decision."
        PRINT #1, "Funny lines: If at first you don't succeed, then skydiving definitely isn't for you. -- My cell phone is acting up. I keep pressing the Home button but every time I look around, I'm still at work."
        PRINT #1, "Pangrams: Pack my box with five dozen liquor jugs. -- The quick brown fox jumps over the lazy dog. -- My girl wove six dozen plaid jackets before she quit."
        PRINT #1, "EOF"
        CLOSE #1
        numberOfPhrases = 7
    ELSE
        OPEN "Phrases.txt" FOR INPUT AS #1
        numberOfPhrases = 0
        DO
            numberOfPhrases = numberOfPhrases + 1
            LINE INPUT #1, lineCounting$
        LOOP UNTIL INSTR(lineCounting$, "EOF") <> 0
        numberOfPhrases = numberOfPhrases - 1
        CLOSE #1
    END IF
    FileStatus = numberOfPhrases
END FUNCTION
 
FUNCTION Center (text$)
    Center = INT((80 - LEN(text$)) / 2)
END FUNCTION
 
FUNCTION S$ (number)
    S$ = LTRIM$(STR$(number))
END FUNCTION
 
FUNCTION P$
    pause$ = INPUT$(1)
    IF pause$ = CHR$(27) THEN END
    P$ = pause$
END FUNCTION

Programs / Roman Numeral / Decimal Number converter

« on: September 03, 2021, 10:13:21 pm »

Code: QB64: [Select]

CONST TRUE = 1
CONST FALSE = 0
DIM SHARED romanNumeral$: romanNumeral$ = ""
DIM SHARED decimalNumber: decimalNumber = 0
 
PRINT "Type 1 or 'R' to convert decimal number to Roman Numeral"
PRINT "           or anything else to convert Roman Numeral to decimal number"
c$ = P$(TRUE)
IF c$ = "1" OR UCASE$(c$) = "R" THEN
    CALL ConvertToRoman
ELSE
    CALL ConvertToDecimal
END IF
 
SUB ConvertToDecimal
    decimalNumber = 0
    invalidInput:
    INPUT "Type in the Roman Numeral: ", romanNumeral$
    rn$ = UCASE$(romanNumeral$)
    FOR count = 1 TO LEN(rn$)
        a$ = MID$(rn$, count, 1)
        SELECT CASE a$
            CASE "I", "V", "X", "L", "C", "D", "M"
                'do nothing
            CASE ELSE
                GOTO invalidInput
        END SELECT
    NEXT count
    DO
        r$ = LEFT$(rn$, 1)
        SELECT CASE r$
            CASE "M"
                decimalNumber = decimalNumber + 1000
                rn$ = MID$(rn$, 2, LEN(rn$))
            CASE "C"
                IF LEFT$(rn$, 2) = "CM" THEN
                    decimalNumber = decimalNumber + 900
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSEIF LEFT$(rn$, 2) = "CD" THEN
                    decimalNumber = decimalNumber + 400
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSE
                    decimalNumber = decimalNumber + 100
                    rn$ = MID$(rn$, 2, LEN(rn$))
                END IF
            CASE "D"
                decimalNumber = decimalNumber + 500
                rn$ = MID$(rn$, 2, LEN(rn$))
            CASE "X"
                IF LEFT$(rn$, 2) = "XC" THEN
                    decimalNumber = decimalNumber + 90
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSEIF LEFT$(rn$, 2) = "XL" THEN
                    decimalNumber = decimalNumber + 40
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSE
                    decimalNumber = decimalNumber + 10
                    rn$ = MID$(rn$, 2, LEN(rn$))
                END IF
            CASE "L"
                decimalNumber = decimalNumber + 50
                rn$ = MID$(rn$, 2, LEN(rn$))
            CASE "I"
                IF LEFT$(rn$, 2) = "IX" THEN
                    decimalNumber = decimalNumber + 9
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSEIF LEFT$(rn$, 2) = "IV" THEN
                    decimalNumber = decimalNumber + 4
                    rn$ = MID$(rn$, 3, LEN(rn$))
                ELSE
                    decimalNumber = decimalNumber + 1
                    rn$ = MID$(rn$, 2, LEN(rn$))
                END IF
            CASE "V"
                decimalNumber = decimalNumber + 5
                rn$ = MID$(rn$, 2, LEN(rn$))
        END SELECT
    LOOP UNTIL rn$ = ""
    COLOR n15, 0: PRINT "Decimal number: " + S$(decimalNumber)
END SUB
 
SUB ConvertToRoman
    decimalNumber = 0
    romanNumeral$ = ""
    INPUT "Type in the decimal number: ", decimalNumber
    DO
        IF decimalNumber >= 1000 THEN
            romanNumeral$ = romanNumeral$ + "M"
            decimalNumber = decimalNumber - 1000
        ELSEIF decimalNumber >= 900 THEN
            romanNumeral$ = romanNumeral$ + "CM"
            decimalNumber = decimalNumber - 900
        ELSEIF decimalNumber >= 500 THEN
            romanNumeral$ = romanNumeral$ + "D"
            decimalNumber = decimalNumber - 500
        ELSEIF decimalNumber >= 400 THEN
            romanNumeral$ = romanNumeral$ + "CD"
            decimalNumber = decimalNumber - 400
        ELSEIF decimalNumber >= 100 THEN
            romanNumeral$ = romanNumeral$ + "C"
            decimalNumber = decimalNumber - 100
        ELSEIF decimalNumber >= 90 THEN
            romanNumeral$ = romanNumeral$ + "XC"
            decimalNumber = decimalNubmer - 90
        ELSEIF decimalNumber >= 50 THEN
            romanNumeral$ = romanNumeral$ + "L"
            decimalNumber = decimalNumber - 50
        ELSEIF decimalNumber >= 40 THEN
            romanNumeral$ = romanNumeral$ + "XL"
            decimalNumber = decimalNumber - 40
        ELSEIF decimalNumber >= 10 THEN
            romanNumeral$ = romanNumeral$ + "X"
            decimalNumber = decimalNumber - 10
        ELSEIF decimalNumber >= 9 THEN
            romanNumeral$ = romanNumeral$ + "IX"
            decimalNumber = decimalNumer - 9
        ELSEIF decimalNumber >= 5 THEN
            romanNumeral$ = romanNumeral$ + "V"
            decimalNumber = decimalNumber - 5
        ELSEIF decimalNumber >= 4 THEN
            romanNumeral$ = romanNumeral$ + "IV"
            decimalNumber = decimalNumber - 4
        ELSEIF decimalNumber >= 1 THEN
            romanNumeral$ = romanNumeral$ + "I"
            decimalNumber = decimalNumber - 1
        END IF
    LOOP UNTIL decimalNumber = 0
    COLOR 15, 0: PRINT "The Roman Numeral is " + romanNumeral$
END SUB
 
'for debugging
FUNCTION P$ (escape)
    pause$ = INPUT$(1)
    IF escape = TRUE AND pause$ = CHR$(27) THEN END
    P$ = pause$
END FUNCTION
FUNCTION S$ (number)
    rtn$ = ""
    rtn$ = STR$(number)
    rtn$ = LTRIM$(rtn$)
    S$ = rtn$
END FUNCTION

I thought this would be a lot more difficult than it was

Programs / Tic Tac Toe

« on: August 18, 2021, 02:59:29 pm »

I have a Tic Tac Toe app on my phone. I often win. I had to make my own. . . . I swear my apartment has turned into one big SELECT CASE

Code: QB64: [Select]

CONST TRUE = 1
CONST FALSE = 0
CONST xWon = 1
CONST oWon = 2
CONST tie = 3
CONST acrossTop = 1
CONST acrossMid = 2
CONST acrossBot = 3
CONST vertL = 4
CONST vertM = 5
CONST vertR = 6
CONST diagTL = 7
CONST diagBL = 8
CONST delay = 0.02
CONST computeR = 1
CONST playeR = 2
 
DIM SHARED gameString$: gameString$ = ""
DIM SHARED gameOver: gameOver = FALSE
 
RANDOMIZE TIMER
 
ON ERROR GOTO crap
GOTO beginning
 
crap:
PRINT "Error, line the error is on"
PRINT ERR, _ERRORLINE
CALL P(TRUE)
 
beginning:
WIDTH 80, 50
_FULLSCREEN
 
CALL StartTheGame
SUB EasyGame (firstMove)
    CALL PrintGrid
    FOR eachMove = 1 TO 9
        winner = 0
        IF firstMove = playeR THEN
            here = GetLocation
            gameString$ = gameString$ + "X" + S$(here)
            PrintX (here)
            winner = CheckTieOrWin
            IF winner <> 0 THEN
                CALL EndOfGame
                EXIT FOR
            END IF
            somewhereElse:
            here = INT(RND * 9) + 1
            IF INSTR(gameString$, S$(here)) <> 0 THEN GOTO somewhereElse
            gameString$ = gameString$ + "O" + S$(here)
            CALL PrintO(here)
            eachMove = eachMove + 1
            winner = CheckTieOrWin
            IF winner <> 0 THEN
                CALL EndOfGame
                EXIT FOR
            END IF
        ELSEIF firstMove = computeR THEN
            anotherSomewhereElse:
            here = INT(RND * 9) + 1
            IF INSTR(gameString$, S$(here)) <> 0 THEN GOTO anotherSomewhereElse
            gameString$ = gameString$ + "O" + S$(here)
            CALL PrintO(here)
            winner = CheckTieOrWin
            IF winner <> 0 THEN
                CALL EndOfGame
                EXIT FOR
            END IF
            here = GetLocation
            gameString$ = gameString$ + "X" + S$(here)
            PrintX (here)
            winner = CheckTieOrWin
            IF winner <> 0 THEN
                CALL EndOfGame
                EXIT FOR
            END IF
        ELSE
            PRINT "What": PRINT: PRINT "          the": PRINT: PRINT "                      FUCK!!!"
        END IF
    NEXT eachMove
    END
END SUB
 
SUB StartTheGame
    whoGoesFirst = 0
    repeat:
    COLOR 11, 13
    CLS
    a$ = "Player is X, Computer is O"
    LOCATE 15, Center(a$): PRINT a$
    a$ = "Who goes first?  [C]omputer or [P]layer "
    LOCATE 25, Center(a$): PRINT a$;
    answer$ = UCASE$(INPUT$(1))
    PRINT answer$
    IF answer$ <> "C" AND answer$ <> "P" AND answer$ <> "X" AND answer$ <> "O" THEN
        GOTO repeat
    ELSEIF answer$ = "C" OR answer$ = "O" THEN
        whoGoesFirst = computeR
    ELSEIF answer$ = "P" OR answer$ = "X" THEN
        whoGoesFirst = playeR
    END IF
 
    a$ = "Difficulty? [E]asy or [H]ard "
    LOCATE 30, Center(a$): PRINT a$;
    difficulty$ = UCASE$(INPUT$(1))
    PRINT difficulty$
    IF difficulty$ = "E" THEN
        CALL EasyGame(whoGoesFirst)
    ELSEIF difficulty$ = "H" THEN
        IF whoGoesFirst = computeR THEN
            CALL ComputerFirst
        ELSEIF whoGoesFirst = playeR THEN
            CALL PlayerFirst
        ELSE
            GOTO repeat
        END IF
    ELSE
        GOTO repeat
    END IF
 
END SUB
 
 
SUB PrintGrid
    COLOR 11, 13
    CLS
    FOR y = 4 TO 45
        LOCATE y, 30
        PRINT CHR$(219)
        LOCATE y, 50
        PRINT CHR$(219)
    NEXT y
    FOR x = 17 TO 63
        LOCATE 15, x
        PRINT CHR$(219)
        LOCATE 30, x
        PRINT CHR$(219)
    NEXT x
    LOCATE 9, 22: PRINT "1"
    LOCATE 9, 40: PRINT "2"
    LOCATE 9, 58: PRINT "3"
    LOCATE 23, 22: PRINT "4"
    LOCATE 23, 40: PRINT "5"
    LOCATE 23, 58: PRINT "6"
    LOCATE 37, 22: PRINT "7"
    LOCATE 37, 40: PRINT "8"
    LOCATE 37, 58: PRINT "9"
END SUB
 
SUB PrintX (location)
    x = 19: y = 4
    SELECT CASE location
        CASE 1
            LOCATE 9, 22: PRINT " "
            x = 19: y = 4
        CASE 2
            LOCATE 9, 40: PRINT " "
            x = 36: y = 4
        CASE 3
            LOCATE 9, 58: PRINT " "
            x = 53: y = 4
        CASE 4
            LOCATE 23, 22: PRINT " "
            x = 19: y = 18
        CASE 5
            LOCATE 23, 40: PRINT " "
            x = 36: y = 18
        CASE 6
            LOCATE 23, 58: PRINT " "
            x = 53: y = 18
        CASE 7
            LOCATE 37, 22: PRINT " "
            x = 19: y = 32
        CASE 8
            LOCATE 37, 40: PRINT " "
            x = 36: y = 32
        CASE 9
            x = 53: y = 32
            LOCATE 37, 58: PRINT " "
    END SELECT
    FOR count = 0 TO 9
        CALL PLOT(x + count, y + count)
    NEXT count
 
    CALL PLOT(x + 9, y)
    CALL PLOT(x + 8, y + 1)
    CALL PLOT(x + 7, y + 2)
    CALL PLOT(x + 6, y + 3)
    CALL PLOT(x + 5, y + 4)
    CALL PLOT(x + 4, y + 5)
    CALL PLOT(x + 3, y + 6)
    CALL PLOT(x + 2, y + 7)
    CALL PLOT(x + 1, y + 8)
    CALL PLOT(x, y + 9)
END SUB
 
SUB HLIN (xStart, xEnd, y)
    FOR count = xStart TO xEnd
        LOCATE y, count
        PRINT CHR$(219)
        _DELAY (delay)
    NEXT count
END SUB
 
SUB VLIN (y1, y2, x)
    FOR count = y1 TO y2
        LOCATE count, x
        PRINT CHR$(219)
        _DELAY (delay)
    NEXT count
END SUB
 
SUB PLOT (x, y)
    LOCATE y, x
    PRINT CHR$(219)
    _DELAY (delay)
END SUB
 
SUB PrintO (location)
    SELECT CASE location
        CASE 1
            x = 20: y = 4
            LOCATE 9, 22: PRINT " "
        CASE 2
            LOCATE 9, 40: PRINT " "
            x = 38: y = 4
        CASE 3
            LOCATE 9, 58: PRINT " "
            x = 55: y = 4
        CASE 4
            LOCATE 23, 22: PRINT " "
            x = 20: y = 18
        CASE 5
            LOCATE 23, 40: PRINT " "
            x = 38: y = 18
        CASE 6
            LOCATE 23, 58: PRINT " "
            x = 55: y = 18
        CASE 7
            LOCATE 37, 22: PRINT " "
            x = 20: y = 34
        CASE 8
            LOCATE 37, 40: PRINT " "
            x = 38: y = 34
        CASE 9
            LOCATE 37, 58: PRINT " "
            x = 55: y = 34
    END SELECT
 
    CALL HLIN(x, x + 4, y)
    CALL PLOT(x - 1, y + 1): CALL PLOT(x + 5, y + 1)
    CALL VLIN(y + 2, y + 6, x - 2): CALL VLIN(y + 2, y + 6, x + 6)
    CALL PLOT(x - 1, y + 7): CALL PLOT(x + 5, y + 7)
    CALL HLIN(x, x + 4, y + 8)
END SUB
 
SUB ComputerFirst
    CALL PrintGrid
    gameString$ = "O1"
    CALL PrintO(1)
    playersMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playersMove)
    CALL PrintX(playersMove)
    SELECT CASE gameString$
        CASE "O1X2", "O1X3", "O1X6", "O1X8", "O1X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "O1X4", "O1X5"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "O1X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
    END SELECT
    playersMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playersMove)
    CALL PrintX(playersMove)
    SELECT CASE gameString$
        CASE "O1X2O7X3", "O1X2O7X5", "O1X2O7X6", "O1X2O7X8", "O1X2O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "O1X2O7X4"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "O1X3O7X2", "O1X3O7X5", "O1X3O7X6", "O1X3O7X8", "O1X3O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "O1X3O7X4"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "O1X4O3X5", "O1X4O3X6", "O1X4O3X7", "O1X4O3X8", "O1X4O3X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "O1X4O3X2"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
        CASE "O1X5O3X4", "O1X5O3X6", "O1X5O3X7", "O1X5O3X8", "O1X5O3X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "O1X5O3X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "O1X6O7X2", "O1X6O7X3", "O1X6O7X5", "O1X6O7X8", "O1X6O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "O1X6O7X4"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
        CASE "O1X7O9X2", "O1X7O9X3", "O1X7O9X4", "O1X7O9X6", "O1X7O9X8"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
            CALL WinLine(diagTL)
        CASE "O1X7O9X5"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "O1X8O7X2", "O1X8O7X3", "O1X8O7X5", "O1X8O7X6", "O1X8O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "O1X8O7X4"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "O1X9O7X2", "O1X9O7X3", "O1X9O7X5", "O1X9O7X6", "O1X9O7X8"
            gameString$ = gamerstring$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "O1X9O7X4"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
    END SELECT
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
    playersMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playersMove)
    CALL PrintX(playersMove)
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
    SELECT CASE gameString$
        CASE "O1X2O7X4O9X3", "O1X2O7X4O9X5", "O1X2O7X4O9X6"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(acrossBot)
        CASE "O1X2O7X4O9X8"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
            CALL WinLine(diagTL)
        CASE "O1X3O7X4O9X2", "O1X3O7X4O9X5", "O1X3O7X4O9X6"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(acrossBot)
        CASE "O1X3O7X4O9X8"
            gamesring$ = gamestr4ing$ + "O5"
            CALL PrintO(5)
            CALL WinLine(diagTL)
        CASE "O1X4O3X2O5X6", "O1X4O3X2O5X7", "O1X4O3X2O5X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "O1X4O3X2O5X9"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "O1X5O3X2O8X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "O1X5O3X2O8X6", "O1X5O3X2O8X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "O1X5O3X2O8X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "O1X6O7X4O5X2", "O1X6O7X4O5X3", "O1X6O7X4O5X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "O1X6O7X4O5X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "O1X7O9X5O3X2", "O1X7O9X5O3X4", "O1X7O9X5O3X8"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(vertR)
        CASE "O1X7O9X5O3X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "O1X8O7X4O3X2", "O1X8O7X4O3X6", "O1X8O7X4O3X9"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
            CALL WinLine(diagBL)
        CASE "O1X8O7X4O3X5"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "O1X9O7X4O3X2"
            gameString$ = gameString$ + "O5"
            CALL PrintO(5)
            CALL WinLine(diagBL)
        CASE "O1X9O7X4O3X5", "O1X9O7X4O3X6", "O1X9O7X4O3X8"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
    END SELECT
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
    playersMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playersMove)
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
    CALL PrintX(playersMove)
    SELECT CASE gameString$
        CASE "O1X5O3X2O8X4O6X7" ', "O1X5O3X2O8X6O4X7"
            gameString$ = gamesring$ + "O9"
            CALL PrintO(9)
            CALL WinLine(vertR)
        CASE "O1X5O3X2O8X4O6X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(8)
        CASE "O1X5O3X2O8X6O4X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "O1X5O3X2O8X6O4X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(vertL)
        CASE "O1X5O3X2O8X9O4X7"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "O1X5O3X2O8X7O9X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(vertR)
        CASE "O1X5O3X2O8X7O9X6"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "O1X5O3X2O8X9O4X6"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(vertL)
    END SELECT
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
END SUB
 
SUB EndOfGame
    _DELAY (1)
    repeat:
    CLS
    COLOR 0, 13
    a$ = "Do you want to watch a replay? (Y / N) "
    LOCATE 20, Center(a$)
    PRINT a$;
    replay$ = UCASE$(INPUT$(1))
    PRINT replay$
    IF replay$ <> "Y" AND replay$ <> "N" THEN GOTO repeat
    IF replay$ = "Y" THEN CALL WatchReplay
    a$ = "Play again? (Y / N) "
    LOCATE 30, Center(a$)
    COLOR 0, 13: PRINT a$;
    tryAgain:
    again$ = UCASE$(INPUT$(1))
    PRINT again$
    IF again$ <> "Y" AND again$ <> "N" THEN GOTO tryAgain
    IF again$ = "Y" THEN CALL StartTheGame
END SUB
 
SUB WatchReplay
    CALL PrintGrid
    FOR countThroughString = 1 TO LEN(gameString$) STEP 2
        mover$ = MID$(gameString$, countThroughString, 1)
        play$ = MID$(gameString$, countThroughString + 1, 1)
        IF mover$ = "X" THEN
            CALL PrintX(VAL(play$))
        ELSEIF mover$ = "O" THEN
            CALL PrintO(VAL(play$))
        END IF
        _DELAY (0.8)
    NEXT countThroughString
    winner = CheckTieOrWin
    IF winner <> 0 THEN CALL EndOfGame
END SUB
 
FUNCTION CheckTieOrWin
    'allFilled = TRUE
    rtn = 0
    who$ = "X"
    IF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "2") <> 0 AND INSTR(gameString$, who$ + "3") <> 0 THEN
        CALL WinLine(acrossTop)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "4") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "6") <> 0 THEN
        CALL WinLine(acrossMid)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "7") <> 0 AND INSTR(gameString$, who$ + "8") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        CALL WinLine(acrossBot)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "4") <> 0 AND INSTR(gameString$, who$ + "7") <> 0 THEN
        CALL WinLine(vertL)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "2") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "8") <> 0 THEN
        CALL WinLine(vertM)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "3") <> 0 AND INSTR(gameString$, who$ + "6") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        CALL WinLine(vertR)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        CALL WinLine(diagTL)
        rtn = xWon
    ELSEIF INSTR(gameString$, who$ + "3") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "7") <> 0 THEN
        CALL WinLine(diagBL)
        rtn = xWon
    END IF
    who$ = "O"
    IF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "2") <> 0 AND INSTR(gameString$, who$ + "3") <> 0 THEN
        CALL WinLine(acrossTop)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "4") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "6") <> 0 THEN
        WinLine (acrossMid)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "7") <> 0 AND INSTR(gameString$, who$ + "8") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        WinLine (acrossBot)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "4") <> 0 AND INSTR(gameString$, who$ + "7") <> 0 THEN
        WinLine (vertL)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "2") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "8") <> 0 THEN
        CALL WinLine(vertM)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "3") <> 0 AND INSTR(gameString$, who$ + "6") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        CALL WinLine(vertR)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "1") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "9") <> 0 THEN
        CALL WinLine(diagTL)
        rtn = oWon
    ELSEIF INSTR(gameString$, who$ + "3") <> 0 AND INSTR(gameString$, who$ + "5") <> 0 AND INSTR(gameString$, who$ + "7") <> 0 THEN
        WinLine (diagBL)
        rtn = oWon
    ELSEIF LEN(gameString$) = 18 THEN
        rtn = tie
    END IF
    IF rtn <> 0 THEN
        CALL EndOfGame
    ELSE
        CheckTieOrWin = rtn
    END IF
END FUNCTION
 
SUB PlayerFirst
    CALL PrintGrid
    playerMove = GetLocation
    gameString$ = "X" + S$(playerMove)
    PrintX (playerMove)
    SELECT CASE playerMove
        CASE 1
            CALL X1
        CASE 2
            CALL X2
        CASE 3
            CALL X3
        CASE 4
            CALL X4
        CASE 5
            CALL X5
        CASE 6
            CALL X6
        CASE 7
            CALL X7
        CASE 8
            CALL X8
        CASE 9
            CALL X9
    END SELECT
    CALL EndOfGame
END SUB
 
SUB X1
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X1O5X2"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X1O5X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X1O5X4"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X1O5X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X1O5X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X1O5X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X1O5X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
    END SELECT
    playerMove = GetLocation
    '    COLOR 15, 0: LOCATE 46, 10: PRINT gameString$: COLOR 11, 13: CALL P(TRUE)
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X1O5X2O3X4", "X1O5X2O3X6", "X1O5X2O3X8", "X1O5X2O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X1O5X2O3X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X1O5X3O2X4", "X1O5X3O2X6", "X1O5X3O2X7", "X1O5X3O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X1O5X3O2X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X1O5X4O7X2", "X1O5X4O7X6", "X1O5X4O7X8", "X1O5X4O7X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X1O5X4O7X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X1O5X6O3X2", "X1O5X6O3X4", "X1O5X6O3X8", "X1O5X6O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X1O5X6O3X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X1O5X7O4X2", "X1O5X7O4X3", "X1O5X7O4X8", "X1O5X7O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X1O5X7O4X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X1O5X8O4X2", "X1O5X8O4X3", "X1O5X8O4X7", "X1O5X8O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X1O5X8O4X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X1O5X9O2X3", "X1O5X9O2X4", "X1O5X9O2X6", "X1O5X9O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X1O5X9O2X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X1O5X2O3X7O4X8", "X1O5X2O3X7O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X1O5X2O3X7O4X6"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X1O5X3O2X8O4X7", "X1O5X3O2X8O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X1O5X3O2X8O4X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X1O5X4O7X3O2X6", "X1O5X4O7X3O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X1O5X4O7X3O2X8"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X1O5X6O3X7O4X2", "X1O5X6O3X7O4X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X1O5X6O3X7O4X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X1O5X7O4X6O2X3", "X1O5X7O4X6O2X9"
            gamest4ring$ = gameastring$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X1O5X7O4X6O2X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X1O5X8O4X6O3X2", "X1O5X8O4X6O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X1O5X8O4X6O3X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X1O5X9O2X8O7X4", "X1O5X9O2X8O7X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X1O5X9O2X8O7X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
END SUB
 
SUB WinLine (direction)
    COLOR 10, 13
    SELECT CASE direction
        CASE acrossTop
            CALL HLIN(16, 62, 9)
        CASE acrossMid
            CALL HLIN(16, 62, 23)
        CASE acrossBot
            CALL HLIN(16, 62, 37)
        CASE vertL
            CALL VLIN(2, 44, 22)
        CASE vertM
            CALL VLIN(2, 44, 40)
        CASE vertR
            CALL VLIN(2, 44, 57)
        CASE diagTL
            FOR count = 0 TO 40
                CALL PLOT(count + 21, count + 4)
            NEXT count
        CASE diagBL
            y = 42 '48
            FOR count = 0 TO 40
                CALL PLOT(count + 21, y)
                y = y - 1
            NEXT count
    END SELECT
END SUB
 
SUB X2
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X2O5X1"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X2O5X3"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X2O5X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X8"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X2O5X1O3X4", "X2O5X1O3X6", "X2O5X1O3X8", "X2O5X1O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X2O5X1O3X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X2O5X3O1X4", "X2O5X3O1X6", "X2O5X3O1X7", "X2O5X3O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X2O5X3O1X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X2O5X4O1X3", "X2O5X4O1X6", "X2O5X4O1X7", "X2O5X4O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X2O5X4O1X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X2O5X6O3X1", "X2O5X6O3X4", "X2O5X6O3X8", "X2O5X6O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X2O5X6O3X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X7O1X3", "X2O5X7O1X4", "X2O5X7O1X6", "X2O5X7O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X2O5X7O1X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X2O5X8O1X3", "X2O5X8O1X4", "X2O5X8O1X6", "X2O5X8O1X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X2O5X8O1X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X2O5X9O3X1", "X2O5X9O3X4", "X2O5X9O3X6", "X2O5X9O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X2O5X9O3X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X2O5X1O3X7O4X8", "X2O5X1O3X7O4X9"
            gameString$ = gameString$ + "X6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X2O5X1O3X7O4X6"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X2O5X3O1X9O6X7", "X2O5X3O1X9O6X8"
            gameString$ = gameString$ + "4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X2O5X3O1X9O6X4"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X2O5X4O1X9O3X6", "X2O5X4O1X9O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X2O5X4O1X9O3X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X2O5X6O3X7O1X4", "X2O5X6O3X7O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X2O5X6O3X7O1X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X2O5X7O1X9O8X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X2O5X7O1X9O8X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X2O5X7O1X9O8X4"
            gameString$ = gasmestring$ + "O3"
            CALL PrintO(3)
        CASE "X2O5X8O1X9O7X4", "X2O5X8O1X9O7X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X2O5X8O1X9O7X3"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "X2O5X9O3X7O8X1"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X2O5X9O3X7O8X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X2O5X9O3X7O8X6"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
END SUB
 
SUB X3
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X3O5X1"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X3O5X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X3O5X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X3O5X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X3O5X7"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X3O5X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X3O5X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X3O5X1O2X4", "X3O5X1O2X6", "X3O5X1O2X7", "X3O5X1O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X3O5X1O2X8" '********
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X3O5X2O1X4", "X3O5X2O1X6", "X3O5X2O1X7", "X3O5X2O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X3O5X2O1X9" ' ***************
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X3O5X4O1X2", "X3O5X4O1X6", "X3O5X4O1X7", "X3O5X4O1X8"
            gameString$ = gamestgring$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X3O5X4O1X9" '***********
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X3O5X6O9X2", "X3O5X6O9X4", "X3O5X6O9X7", "X3O5X6O9X8"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X3O5X6O9X1" '***********
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X3O5X7O2X1", "X3O5X7O2X4", "X3O5X7O2X6", "X3O5X7O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X3O5X7O2X8" '*********
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X3O5X8O9X2", "X3O5X8O9X4", "X3O5X8O9X6", "X3O5X8O9X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X3O5X8O9X1" '************
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X3O5X9O6X1", "X3O5X9O6X2", "X3O5X9O6X7", "X3O5X9O6X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X3O5X9O6X4" '*******
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X3O5X1O2X8O4X7", "X3O5X1O2X8O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X3O5X1O2X8O4X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X3O5X2O1X9O6X7", "X3O5X2O1X9O6X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X3O5X2O1X9O6X4"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X3O5X4O1X9O6X2", "X3O5X4O1X9O6X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X3O5X4O1X9O6X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X3O5X6O9X1O2X4", "X3O5X6O9X1O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X3O5X6O9X1O2X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X3O5X7O2X8O9X4", "X3O5X7O2X8O9X6"
            gameString$ = gamest5ring$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X3O5X7O2X8O9X1"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X3O5X8O9X1O2X4", "X3O5X8O9X1O2X6"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X3O5X8O9X1O2X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X3O5X9O6X4O2X1", "X3O5X9O6X4O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X3O5X9O6X4O2X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
 
END SUB
 
SUB X4
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X4O5X1"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X4O5X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X4O5X3"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X4O5X6"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X4O5X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X4O5X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X4O5X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X4O5X1O7X2", "X4O5X1O7X6", "X4O5X1O7X8", "X4O5X1O7X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X4O5X1O7X3" '***********
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X4O5X2O1X3", "X4O5X2O1X6", "X4O5X2O1X7", "X4O5X2O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X4O5X2O1X9" '*************
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X4O5X3O1X2", "X4O5X3O1X6", "X4O5X3O1X7", "X4O5X3O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X4O5X3O1X9" '**************
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X4O5X6O1X2", "X4O5X6O1X3", "X4O5X6O1X7", "X4O5X6O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X4O5X6O1X9" '****************
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X4O5X7O1X2", "X4O5X7O1X3", "X4O5X7O1X6", "X4O5X7O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X4O5X7O1X9" '********************
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X4O5X8O7X1", "X4O5X8O7X2", "X4O5X8O7X6", "X4O5X8O7X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X4O5X8O7X3" '********************
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X4O5X9O7X1", "X4O5X9O7X2", "X4O5X9O7X6", "X4O5X9O7X8"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X4O5X9O7X3" '****************
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X4O5X1O7X3O2X6", "X4O5X1O7X3O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X4O5X1O7X3O2X8"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X4O5X2O1X9O3X6", "X4O5X2O1X9O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X4O5X2O1X9O3X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X4O5X3O1X9O6X2", "X4O5X3O1X9O6X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X4O5X3O1X9O6X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X4O5X6O1X9O3X2", "X4O5X6O1X9O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X4O5X6O1X9O3X7"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X4O5X7O1X9O8X3", "X4O5X7O1X9O8X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X4O5X7O1X9O8X2"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X4O5X8O7X3O1X2", "X4O5X8O7X3O1X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X4O5X8O7X3O1X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X4O5X9O7X3O6X1", "X4O5X9O7X3O6X8"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X4O5X9O7X3O6X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
END SUB
 
SUB X5
    gameString$ = gameString$ + "O1"
    CALL PrintO(1)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X5O1X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X6"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X5O1X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X8"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X5O1X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        'X5O1X2O8X
        CASE "X5O1X2O8X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X2O8X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X2O8X6"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X5O1X2O8X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X2O8X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            ' X5O1X3O7X
        CASE "X5O1X3O7X2", "X5O1X3O7X6", "X5O1X3O7X8", "X5O1X3O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "X5O1X3O7X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            '"X5O1X4O6X
        CASE "X5O1X4O6X2", "X5O1X4O6X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X4O6X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X4O6X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X4O6X8"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X5O1X6O4X2", "X5O1X6O4X3", "X5O1X6O4X8", "X5O1X6O4X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(vertL)
        CASE "X5O1X6O4X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X7O3X4", "X5O1X7O3X6", "X5O1X7O3X8", "X5O1X7O3X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X5O1X7O3X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X8O2X4", "X5O1X8O2X6", "X5O1X8O2X7", "X5O1X8O2X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(acrossTop)
        CASE "X5O1X8O2X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X9O3X4", "X5O1X9O3X6", "X5O1X9O3X7", "X5O1X9O3X8"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X5O1X9O3X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    SELECT CASE gameString$
        CASE "X5O1X2O8X3O7X4", "X5O1X2O8X3O7X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(acrossBot)
        CASE "X5O1X2O8X3O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "X5O1X2O8X4O6X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X2O8X4O6X7", "X5O1X2O8X4O6X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X2O8X6O4X3", "X5O1X2O8X6O4X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(vertL)
        CASE "X5O1X2O8X6O4X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X2O8X7O3X4", "X5O1X2O8X7O3X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X2O8X7O3X6"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X5O1X2O8X9O4X3", "X5O1X2O8X9O4X6"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(vertL)
        CASE "X5O1X2O8X9O4X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X3O7X4O6X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X3O7X4O6X8", "X5O1X3O7X4O6X9"
            gameString$ = gamestgring$ + "O2"
            CALL PrintO(2)
        CASE "X5O1X4O6X2O8X3", "X5O1X4O6X2O8X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X4O6X2O8X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X4O6X3O7X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X4O6X3O7X8", "X5O1X4O6X3O7X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X5O1X4O6X7O3X2", "X5O1X4O6X7O3X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(vertR)
        CASE "X5O1X4O6X7O3X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X5O1X4O6X8O2X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X4O6X8O2X7", "X5O1X4O6X8O2X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(acrossTop)
        CASE "X5O1X4O6X9O8X2", "X5O1X4O6X9O8X7"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X5O1X4O6X9O8X3"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X5O1X6O4X7O3X8", "X5O1X6O4X7O3X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X5O1X6O4X7O3X2"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X5O1X7O3X2O8X6", "X5O1X7O3X2O8X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X5O1X7O3X2O8X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X8O2X3O7X6", "X5O1X8O2X3O7X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "X5O1X8O2X3O7X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X9O3X2O8X4", "X5O1X9O3X2O8X7"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X5O1X9O3X2O8X6"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
 
END SUB
 
SUB X6
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X6O5X1"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X6O5X2"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X6O5X3"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X6O5X4"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X6O5X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X6O5X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X6O5X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X6O5X1O3X2", "X6O5X1O3X4", "X6O5X1O3X8", "X6O5X1O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X6O5X1O3X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X6O5X2O3X1", "X6O5X2O3X4", "X6O5X2O3X8", "X6O5X2O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X6O5X2O3X7" '***********
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X6O5X3O9X2", "X6O5X3O9X4", "X6O5X3O9X7", "X6O5X3O9X8"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X6O5X3O9X1"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X6O5X4O3X1", "X6O5X4O3X2", "X6O5X4O3X8", "X6O5X4O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X6O5X4O3X7" '********************
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X6O5X7O9X2", "X6O5X7O9X3", "X6O5X7O9X4", "X6O5X7O9X8"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X6O5X7O9X1" '**********************
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X6O5X8O9X2", "X6O5X8O9X3", "X6O5X8O9X4", "X6O5X8O9X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X6O5X8O9X1" '******************************
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X6O5X9O3X1", "X6O5X9O3X2", "X6O5X9O3X4", "X6O5X9O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X6O5X9O3X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X6O5X1O3X7O4X2", "X6O5X1O3X7O4X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X6O5X1O3X7O4X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X6O5X2O3X7O1X4", "X6O5X2O3X7O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X6O5X2O3X7O1X9"
            gameString$ = gameString$ + "4"
            CALL PrintO(4)
        CASE "X6O5X3O9X1O2X4", "X6O5X3O9X1O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X6O5X3O9X1O2X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X6O5X4O3X7O1X2", "X6O5X4O3X7O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X6O5X4O3X7O1X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(acrossTop)
        CASE "X6O5X7O9X1O4X2", "X6O5X7O9X1O4X8"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X6O5X7O9X1O4X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X6O5X8O9X1O3X2", "X6O5X8O9X1O3X4"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X6O5X8O9X1O3X7"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X6O5X9O3X7O8X1", "X6O5X9O3X7O8X4"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X6O5X9O3X7O8X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
 
END SUB
 
SUB X7
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X7O5X1"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X7O5X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X7O5X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X7O5X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X7O5X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X7O5X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X7O5X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X7O5X1O4X2", "X7O5X1O4X3", "X7O5X1O4X8", "X7O5X1O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X7O5X1O4X6" '**********************
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X7O5X2O1X3", "X7O5X2O1X4", "X7O5X2O1X6", "X7O5X2O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X7O5X2O1X9" '****************************
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X7O5X3O2X1", "X7O5X3O2X4", "X7O5X3O2X6", "X7O5X3O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X7O5X3O2X8" '*******************
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X7O5X4O1X2", "X7O5X4O1X3", "X7O5X4O1X6", "X7O5X4O1X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X7O5X4O1X9" '**********************
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X7O5X6O9X2", "X7O5X6O9X3", "X7O5X6O9X4", "X7O5X6O9X8"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X7O5X6O9X1" '******************
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X7O5X8O9X2", "X7O5X8O9X3", "X7O5X8O9X4", "X7O5X8O9X6"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X7O5X8O9X1" '******************
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X7O5X9O8X1", "X7O5X9O8X3", "X7O5X9O8X4", "X7O5X9O8X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X7O5X9O8X2"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    '    color 15,0:locate 45,10:?gamestring$:call p(true)
    SELECT CASE gameString$
        CASE "X7O5X1O4X6O2X3", "X7O5X1O4X6O2X9"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X7O5X1O4X6O2X8"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X7O5X2O1X9O8X3", "X7O5X2O1X9O8X4"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X7O5X2O1X9O8X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X7O5X3O2X8O9X4", "X7O5X3O2X8O9X6"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X7O5X3O2X8O9X1"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X7O5X4O1X9O8X3", "X7O5X4O1X9O8X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X7O5X4O1X9O8X2"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X7O5X6O9X1O4X2", "X7O5X6O9X1O4X8"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X7O5X6O9X1O4X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X7O5X8O9X1O4X2", "X7O5X8O9X1O4X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X7O5X8O9X1O4X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X7O5X9O8X2O4X1", "X7O5X9O8X2O4X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X7O5X9O8X2O4X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X7O5X6O9X1O4X2", "X7O5X6O9X1O4X8"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X7O5X6O9X1O4X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
END SUB
 
SUB X8
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X8O5X1"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X8O5X2"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X8O5X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X8O5X4"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X8O5X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X8O5X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X8O5X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X8O5X1O4X2", "X8O5X1O4X3", "X8O5X1O4X7", "X8O5X1O4X9"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X8O5X1O4X6" '**********
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X8O5X2O7X1", "X8O5X2O7X4", "X8O5X2O7X6", "X8O5X2O7X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X8O5X2O7X3" '******************
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X8O5X3O6X1", "X8O5X3O6X2", "X8O5X3O6X7", "X8O5X3O6X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X8O5X3O6X4" '&&&&&&&&&T
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X8O5X4O7X1", "X8O5X4O7X2", "X8O5X4O7X6", "X8O5X4O7X9"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X8O5X4O7X3" 'ERRRRRRRRRRRRRR
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X8O5X6O9X2", "X8O5X6O9X3", "X8O5X6O9X4", "X8O5X6O9X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X8O5X6O9X1" ' *(*******************
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X8O5X7O9X2", "X8O5X7O9X3", "X8O5X7O9X4", "X8O5X7O9X6"
            gameString$ = gamest4ring$ + "O1"
            CALL PrintO(1)
            CALL WinLine(diagTL)
        CASE "X8O5X7O9X1" '*************
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X8O5X9O7X1", "X8O5X9O7X2", "X8O5X9O7X4", "X8O5X9O7X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X8O5X9O7X3" '''''''''''''''''
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X8O5X1O4X6O3X2", "X8O5X1O4X6O3X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X8O5X1O4X6O3X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
        CASE "X8O5X2O7X3O1X4", "X8O5X2O7X3O1X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X8O5X2O7X3O1X9"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(vertL)
        CASE "X8O5X3O6X4O1X2", "X8O5X3O6X4O1X7"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X8O5X3O6X4O1X9"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X8O5X4O7X3O1X2", "X8O5X4O7X3O1X6"
            gameString$ = gameString$ + "O9"
            CALL PrintO(9)
            CALL WinLine(diagTL)
        CASE "X8O5X4O7X3O1X9"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X8O5X6O9X1O7X2", "X8O5X6O9X1O7X4"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X8O5X6O9X1O7X3"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X8O5X7O9X1O4X3", "X8O5X7O9X1O4X2"
            gamestreing$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X8O5X7O9X1O4X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X8O5X9O7X3O6X1", "X8O5X9O7X3O6X2"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X8O5X9O7X3O6X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
END SUB
 
SUB X9
    gameString$ = gameString$ + "O5"
    CALL PrintO(5)
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X9O5X1"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X9O5X2"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X9O5X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X9O5X4"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X9O5X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X9O5X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X9O5X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X9O5X1O2X3", "X9O5X1O2X4", "X9O5X1O2X6", "X9O5X1O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X9O5X1O2X8" '''''''''''''''''''''''''
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X9O5X2O4X1", "X9O5X2O4X3", "X9O5X2O4X7", "X9O5X2O4X8"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X9O5X2O4X6"
            gameString$ = gameString$ + "O3" '''''''''''''''''''''''''
            CALL PrintO(3)
        CASE "X9O5X3O6X1", "X9O5X3O6X2", "X9O5X3O6X7", "X9O5X3O6X8"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X9O5X3O6X4" '''''''''''''''''''
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
        CASE "X9O5X4O8X1", "X9O5X4O8X3", "X9O5X4O8X6", "X9O5X4O8X7"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X9O5X4O8X2"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X9O5X6O3X1", "X9O5X6O3X2", "X9O5X6O3X4", "X9O5X6O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X9O5X6O3X7" ''''''''''''''''
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X9O5X7O8X1", "X9O5X7O8X3", "X9O5X7O8X4", "X9O5X7O8X6"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X9O5X7O8X2"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
        CASE "X9O5X8O7X1", "X9O5X8O7X2", "X9O5X8O7X4", "X9O5X8O7X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X9O5X8O7X3" ''''''''''''''''''
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
    SELECT CASE gameString$
        CASE "X9O5X1O2X8O7X4", "X9O5X1O2X8O7X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
            CALL WinLine(diagBL)
        CASE "X9O5X1O2X8O7X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
        CASE "X9O5X2O4X6O3X1", "X9O5X2O4X6O3X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X9O5X2O4X6O3X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
        CASE "X9O5X3O6X4O2X1", "X9O5X3O6X4O2X7"
            gameString$ = gameString$ + "O8"
            CALL PrintO(8)
            CALL WinLine(vertM)
        CASE "X9O5X3O6X4O2X8"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
        CASE "X9O5X4O8X2O3X1", "X9O5X4O8X2O3X6"
            gameString$ = gameString$ + "O7"
            CALL PrintO(7)
            CALL WinLine(diagBL)
        CASE "X9O5X4O8X2O3X7"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X9O5X6O3X7O8X1", "X9O5X6O3X7O8X4"
            gameString$ = gameString$ + "O2"
            CALL PrintO(2)
            CALL WinLine(vertM)
        CASE "X9O5X6O3X7O8X2"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
        CASE "X9O5X7O8X2O4X1", "X9O5X7O8X2O4X3"
            gameString$ = gameString$ + "O6"
            CALL PrintO(6)
            CALL WinLine(acrossMid)
        CASE "X9O5X7O8X2O4X6"
            gameString$ = gameString$ + "O3"
            CALL PrintO(3)
        CASE "X9O5X8O7X3O6X1", "X9O5X8O7X3O6X2"
            gameString$ = gameString$ + "O4"
            CALL PrintO(4)
            CALL WinLine(acrossMid)
        CASE "X9O5X8O7X3O6X4"
            gameString$ = gameString$ + "O1"
            CALL PrintO(1)
    END SELECT
    playerMove = GetLocation
    gameString$ = gameString$ + "X" + S$(playerMove)
    CALL PrintX(playerMove)
END SUB
 
FUNCTION GetLocation
    nope:
    where$ = INPUT$(1)
    here = VAL(where$)
    IF here < 1 OR here > 9 OR INSTR(gameString$, where$) <> 0 THEN
        GOTO nope
    ELSE
        IF MID$(gameString$, LEN(gameString$) - 1, 1) = "X" THEN
            CALL PrintO(here)
        ELSE
            CALL PrintX(here)
        END IF
    END IF
    GetLocation = here
END FUNCTION
 
 
FUNCTION Center (this$)
    Center = INT((80 - LEN(this$)) / 2)
END FUNCTION
 
SUB P (onOff)
    pause$ = INPUT$(1)
    IF onOff = TRUE AND pause$ = CHR$(27) THEN END
END SUB
 
FUNCTION S$ (number)
    S$ = LTRIM$(STR$(number))
END FUNCTION

QB64 Discussion / Break Thru

« on: July 19, 2021, 02:47:54 pm »

This game is a clone of Break Out on the Atari 2600 and Arkanoid for the 8-bit Nintendo. I gave up trying to make a bonus drop creating 2 balls. Anyway, it came out pretty good. I'm thinking of doing another clone with graphics instead of text like this one. It will be my first foray into graphics of any kind. The graphics would be filled rectangles and a circle so I think it would be a good starting point.

Code: QB64: [Select]

' Creator: Jaze McAskill -- mcaskilljaze@gmail.com
 
WIDTH 80, 50
RANDOMIZE TIMER
TYPE coordinate
    x AS INTEGER
    y AS INTEGER
END TYPE
 
TYPE droppingLetter
    x AS INTEGER
    y AS SINGLE
    letter AS INTEGER
END TYPE
 
_FULLSCREEN
 
ON ERROR GOTO crap
GOTO beginning
crap:
PRINT "Error, error line"
PRINT ERR, _ERRORLINE
 
beginning:
CONST TRUE = 1
CONST FALSE = 0
CONST leftDirection = 19200 '   to make the code more readable with the left and right arrowkeys
CONST rightDirection = 19712 '
CONST upAndLeft = 1 'the ball always moves in one diagonal direction
CONST upAndRight = 2
CONST downAndLeft = 3
CONST downAndRight = 4
CONST theBackground = 0 '           to determine what the ball hit
CONST theBrick = 1
CONST theWall = 2
CONST thePaddle = 3
CONST theBall = 4
CONST theBonus = 5
CONST hitWallSound$ = "O2L30G"
CONST hitPaddleSound$ = "O3L30C"
CONST hitBrickSound$ = "O3L30G"
CONST deathSound$ = "O4L15CO3CO2CO1L10C"
CONST successBeep = "L9O2DL15DL9DL4F"
CONST letterE = 69 'to lengthen / expand the paddle
CONST letterS = 83 'to shrink the paddle
CONST letterPlus = 43 ' score increase
CONST letterMinus = 45 ' score decrease
CONST letterStar = 42 'score multiplier
 
'I share everything so I don't have to worry whether or not I was supposed to pass something. Plus it removes the need to pass the same variable multiple times
DIM SHARED creationBoard(2 TO 79, 2 TO 46) AS INTEGER 'the colors on the board when creating a level
FOR initializeArrayX = 2 TO 79
    FOR initializeArrayY = 2 TO 46
        creationBoard(initializeArrayX, initializeArrayY) = 1 'set the board to the background color
NEXT: NEXT
DIM SHARED brick AS coordinate: brick.x = 2: brick.y = 2 'start the creation board at 2, 2
DIM SHARED ball(1 TO 2) AS coordinate 'to track where the ball is on the board
DIM SHARED ballDirection(1 TO 2) AS INTEGER 'track the ball's direction using the directional constants above
DIM SHARED paddleLeft AS SINGLE ' the leftmost character of the paddle
DIM SHARED board(1 TO 80, 1 TO 48, 1 TO 2) AS INTEGER 'the board for the game
DIM SHARED numberOfBricks AS INTEGER 'the number of bricks currently on the board
DIM SHARED currentLevel AS INTEGER: currentLevel = 1 'start at level 1
DIM SHARED numberOfGuys AS INTEGER: numberOfGuys = 5
DIM SHARED score AS INTEGER: scorte = 0
DIM SHARED spaceToStart: spaceToStart = FALSE 'whether or not the spacebar was pushed to begin the level
DIM SHARED debugMode AS INTEGER: debugMode = FALSE 'to bounce the ball off the bottom or to decrement numberOfGuys
DIM SHARED penUp, currentColor, eraserOn AS INTEGER: penUp = TRUE: currentColor = 0: eraserOn = FALSE
DIM SHARED mute AS INTEGER: mute = -1 ' -1 mute is off (sound on)
DIM SHARED lastLevelCreated AS INTEGER: lastLevelCreated = 0
DIM SHARED changeBallSomewhat AS INTEGER: changeBallSomewhat = 0 'used to move the ball a little bit to avoid never hitting all of the bricks
DIM levelChecking AS INTEGER: levelChecking = 0 'used in the following loop to check what is the highest level
DIM SHARED activeLetter AS droppingLetter: activeLetter.x = 0: activeLetter.y = 0: activeLetter.letter = 0
DIM SHARED paddleLength AS INTEGER: paddleLength = 8
DIM SHARED activeBall AS INTEGER 'as is or both if 3
 
CALL Menu
 
SUB Menu
    printTheMenu = TRUE 'used to stop the menu from flickering
    DO
        IF printTheMenu = TRUE THEN
            COLOR 14, 1
            CLS
            LOCATE 20, 1
            PRINT CenterText$("Menu")
            PRINT CenterText$("------")
            PRINT
            PRINT CenterText$("1.) Instructions")
            PRINT
            PRINT CenterText$("2.) Create A Level")
            PRINT
            PRINT CenterText$("3.) Play The Game")
            PRINT
            PRINT CenterText$("4.) Exit")
            printTheMenu = FALSE
        END IF
        menuCommand$ = INKEY$
        SELECT CASE menuCommand$
            CASE "1"
                CALL Instructions
                printTheMenu = TRUE
            CASE "2"
                CALL CreationMain
                printTheMenu = TRUE
            CASE "3"
                CALL Main
                printTheMenu = TRUE
        END SELECT
    LOOP UNTIL menuCommand$ = "4"
    END
END SUB
 
SUB Instructions
    COLOR 10, 1
    CLS
    LOCATE 2
    PRINT CenterText$("Level Creator")
    PRINT CenterText$("---------------")
 
    PRINT CenterText$("The available commands are listed at the bottom of the screen.")
    PRINT CenterText$("When the pen is up, the cursor moves without adding to the level")
    PRINT CenterText$("being created. When the pen is down the current brick is added")
    PRINT CenterText$("to the level being created. The other commands are self explanatory.")
    COLOR 12, 1
    PRINT CenterText$("If no levels have been created, the default level is used.")
    PRINT CenterText$("If you progress beyond all levels created, the last level created repeats.")
    PRINT
    PRINT
    COLOR 14, 1
    PRINT CenterText$("Game")
    PRINT CenterText$("------")
 
    PRINT CenterText$("The object of the game is to progress to the next level by")
    PRINT CenterText$("destroying all of the bricks. To do this you must position the")
    PRINT
    COLOR 15, 1
    PRINT CenterText$(CHR$(219) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(219))
    PRINT
    COLOR 14, 1
    PRINT CenterText$("under the ball so that it is reflected toward the bricks using")
    PRINT CenterText$("the left and right arrow keys.")
    LOCATE 24, 21
    PRINT "Push ";: COLOR 13, 1: PRINT "[SPACEBAR]";: COLOR 14, 1: PRINT " to set the ball in motion."
    PRINT: PRINT
    COLOR 13, 1:
    LOCATE , 5: PRINT "     Available Commands                         Bonus Drops": COLOR 14, 1: PRINT
    LOCATE , 5: PRINT "+ to increase the game speed               E = Expand paddle": PRINT
    LOCATE , 5: PRINT "- to decrease the game speed               S = Shrink paddle": PRINT
    LOCATE , 5: PRINT "P to pause the game                        + = Plus 15 points": PRINT
    LOCATE , 5: PRINT "M to toggle mute on and off                - = Minus 15 points": PRINT
    LOCATE , 2: PRINT "[ESC] to return to the main menu           * = Score multiplier (-1, 1.5 or 2)": PRINT
    PRINT: PRINT
    PRINT CenterText$("Push C to turn on debug mode and O to turn it off.")
    LOCATE 48
    COLOR 15, 1
    PRINT CenterText$("Push any key to continue.")
    CALL P(FALSE)
END SUB
 
FUNCTION CenterText$ (thisString$)
    returnString$ = SPACE$(INT((80 - LEN(thisString$)) / 2)) + thisString$
    CenterText$ = returnString$
END FUNCTION
 
SUB PrintBrick (x, y, onOrOff)
    IF onOrOff = TRUE THEN
        useColor = board(x, y, 2) 'print the brick instead of erasing it, pick up the color there
    ELSEIF onOrOff = FALSE THEN
        useColor = 1
    END IF
    FOR across = 0 TO 5
        LOCATE y, x + across
        COLOR useColor
        PRINT CHR$(219)
        board(x + across, y, 1) = 219
        board(x + across, y, 2) = useColor
    NEXT across
    IF onOrOff = FALSE THEN 'brick is destroyed
        numberOfBricks = numberOfBricks - 1
        score = score + 5
        chanceOfLetter = INT(RND * 100) + 1
        IF chanceOfLetter <= 25 AND activeLetter.letter = 0 THEN ' 25% chance of bonus
            pickingLetter = INT(RND * 5) + 1 'choose which bonus to activate
            SELECT CASE pickingLetter
                CASE 1
                    activeLetter.letter = letterE
                CASE 2
                    activeLetter.letter = letterS
                CASE 3
                    activeLetter.letter = letterPlus
                CASE 4
                    activeLetter.letter = letterMinus
                CASE 5
                    activeLetter.letter = letterStar
            END SELECT
            activeLetter.x = x + 3 'place the falling letter near the center of destroyed brick
            activeLetter.y = y + 1
            CALL PrintLetter(TRUE)
        END IF
        CALL PrintBoard
    END IF
END SUB
 
SUB PrintLetter (onOrOff)
    IF INT(activeLetter.y) < 47 THEN 'whether the bonus letter is done falling
        IF onOrOff = TRUE THEN 'display the bonus letter
            clr = 9
        ELSE
            clr = 1 'remove bonus letter from display
        END IF
        CALL PlaceChar(activeLetter.x, activeLetter.y, activeLetter.letter, clr) 'put the letter on the board
    ELSEIF activeLetter.y >= 47 THEN 'activate the letter or ignore it
        IF paddleLeft <= activeLetter.x AND activeLetter.x <= paddleLeft + paddleLength - 1 THEN 'letter was caught
            SELECT CASE activeLetter.letter 'which letter to activate
                CASE letterE 'lengthen the paddle
                    IF paddleLength <= 10 THEN paddleLength = paddleLength + 2
                    CALL PrintPaddle(TRUE)
                CASE letterS 'shrink the paddle
                    IF paddleLength >= 8 THEN
                        CALL PrintPaddle(FALSE)
                        paddleLength = paddleLength - 2
                        CALL PrintPaddle(TRUE)
                    ELSEIF paddleLength > 5 AND paddleLength <= 7 THEN
                        CALL PrintPaddle(FALSE)
                        paddleLength = paddleLength - 1
                        CALL PrintPaddle(TRUE)
                    END IF
                CASE letterPlus 'increase score
                    score = score + 15
                CASE letterMinus ' decrease score
                    score = score - 15
                CASE letterStar 'multiply the score
                    DIM multiplier AS SINGLE
                    multiplier = INT(RND * 3) + 1
                    IF multiplier = 1 THEN
                        multiplier = -1
                    ELSEIF multiplier = 3 THEN
                        multiplier = 1.5
                    END IF
                    score = INT(score * multiplier)
            END SELECT 'action has been done with selected bonus letter
        END IF ' the letter has finished being caught
        activeLetter.x = 0: activeLetter.y = 0: activeLetter.letter = 0 'the letter is no longer active
    END IF
END SUB
 
SUB PrintLevel (cl)
    'clear the playing field
    FOR x = 1 TO 80: FOR y = 1 TO 48 'make the board blue
            board(x, y, 1) = 219 '    ASCII code of board space
            board(x, y, 2) = 1 '      color of board space
    NEXT y: NEXT x
    COLOR 1, 1: CLS
    'print left, right and top borders and put them on the board
    FOR y = 1 TO 48
        LOCATE y, 1: COLOR 12, 1: PRINT CHR$(219) 'print the left border to the screen
        LOCATE y, 80: COLOR 12, 1: PRINT CHR$(219) 'print the right border to the screen
        CALL PlaceChar(1, y, 219, 12) ' put the position, ASCII code and color on the board to make the left border
        CALL PlaceChar(80, y, 219, 12) ' same to make the left border on the board
    NEXT y
    FOR x = 1 TO 80
        LOCATE 1, x: COLOR 12, 1: PRINT CHR$(219) 'print the top border to the screen
        CALL PlaceChar(x, 1, 219, 12) ' put the top border on the board
    NEXT x
    paddleLeft = INT(RND * (72 - 2 + 1)) + 2 'position the paddle to start
    paddleLength = 8
    CALL PrintPaddle(TRUE) ' put the paddle on the board with the left at x coordinate 36
    activeBall = 1
    ball(activeBall).x = paddleLeft + 4: ball(activeBall).y = 47 ' position the ball/moving ball
    CALL PrintBall(activeBall, TRUE) ' put the ball on the board
    ballDirection(activeBall) = INT(RND * 2) + 1 'randomize the starting direction of the ball as up and left or up and right
    IF _FILEEXISTS("Highest Level") THEN
        OPEN "Highest Level" FOR INPUT AS #1
        INPUT #1, highLev$
        highestLevel = VAL(highLev$)
        CLOSE #1
    ELSE
        highestLevel = 0
    END IF
    filename$ = ""
    IF currentLevel < highestLevel THEN
        filename$ = "Level " + S$(currentLevel)
    ELSEIF highestLevel <> 0 THEN
        filename$ = "Level " + S$(highestLevel)
    END IF
    IF filename$ <> "" THEN
        OPEN filename$ FOR INPUT AS #1 'open the file with the level information
        FOR xCounting = 2 TO 79 ' x coordinate of the board
            FOR yCounting = 2 TO 46 ' y coordinate of the board
                INPUT #1, boardColor$ ' get the color of the board at xCounting, yCounting
                board(xCounting, yCounting, 2) = VAL(boardColor$) 'color the board at xCounting, yCounting
        NEXT: NEXT
        CLOSE #1
    ELSE
        FOR x = 2 TO 79
            CALL PlaceChar(x, 2, 219, 14) 'put a yellow (14) block (219) at x, y on the board
            CALL PlaceChar(x, 4, 219, 14)
            CALL PlaceChar(x, 6, 219, 14)
        NEXT x
        lastLevelCreated = 1
    END IF
    numberOfBricks = 0 ' after a level has been put on the board, count the number of bricks on it
    FOR brickCountingY = 2 TO 46 'with this set to 47 the ball was being counted as a brick sometimes
        FOR brickCountingX = 2 TO 79 STEP 6 'each brick is 6 blocks long
            IF board(brickCountingX, brickCountingY, 2) <> 1 THEN
                numberOfBricks = numberOfBricks + 1
            END IF
    NEXT: NEXT
    CALL PrintBoard 'print the board to the screen
    spaceToStart = FALSE 'spacebar has yet to be puched to start the current level
END SUB
 
SUB Main
    CALL PrintLevel(currentLevel) 'put the current level on the board and print it out
    printOutBoard = FALSE ' to avoid flicker of the board being constantly printed, the need to print it is false
    delaySpeed = 0.029 'delay to use inside the main DO-LOOP
    activeBall = 1
    DO
        debugging$ = INKEY$ 'using strings instead of _KEYDOWN(code) is easier. i initially added INKEY$ for debugging
        IF spaceToStart = TRUE THEN ' the spacebar has been hit to start the game
            IF activeBall <> 3 THEN
                CALL PrintBall(activeBall, FALSE)
                CALL MoveBall(activeBall)
                CALL PrintBall(activeBall, TRUE)
            ELSE
                CALL PrintBall(1, FALSE)
                CALL PrintBall(2, FALSE)
                CALL MoveBall(1)
                CALL MoveBall(2)
                CALL PrintBall(1, TRUE)
                CALL PrintBall(2, TRUE)
            END IF
            IF _KEYDOWN(leftDirection) = -1 THEN 'the left arrow key had been pushed
                CALL PrintPaddle(FALSE) ' remove the paddle from the board
                paddleLeft = paddleLeft - 1.5 ' move the paddle leftward
                CALL PrintPaddle(TRUE) ' put the paddle on the board at the new position
                printOutBoard = TRUE 'it is now needed to print the board to the screen
            ELSEIF _KEYDOWN(rightDirection) = -1 THEN
                CALL PrintPaddle(FALSE)
                paddleLeft = paddleLeft + 1.5
                CALL PrintPaddle(TRUE)
                printOutBoard = TRUE
            END IF
            IF printOutBoard = TRUE THEN 'print the board to the screen
                CALL PrintBoard ' print the board to the screen
                printOutBoard = FALSE 'stop the board from being printed now
            END IF
            IF numberOfBricks = 0 THEN 'there are no bricks left on the board
                currentLevel = currentLevel + 1 'increment the current level
                activeLetter.letter = 0: activeLetter.x = 0: activeLetter.y = 0
                CALL PrintLevel(currentLevel) 'put the newest level on the board
                spaceToStart = FALSE 'the spacebar has not been pressed since the new level has been output
                score = score + 200 '200 points for finishing a level
                IF mute = -1 THEN PLAY successBeep '1 is mute, -1 is note muted
            END IF
            IF activeLetter.letter <> 0 THEN
                CALL PrintLetter(FALSE)
                activeLetter.y = activeLetter.y + 0.5
                CALL PrintLetter(TRUE)
                printOutBoard = TRUE
            END IF
        END IF
        IF debugging$ = "C" THEN debugMode = TRUE
        IF debugging$ = "O" THEN debugMode = FALSE
        IF _KEYDOWN(32) = -1 THEN ' the spacebar has been pushed
            spaceToStart = TRUE ' the spacebar has been pushed
            printOutBoard = TRUE ' it is needed to print the board to the screen
        END IF
        _DELAY (delaySpeed) ' insert a delay to make the movement playable and visible
        IF numberOfGuys = 0 THEN CALL EndOfGame
        IF score MOD 750 = 0 AND score <> 0 THEN numberOfGuys = numberOfGuys + 1 ' new guy every 2,000 points
        IF debugging$ = "+" THEN 'increase the game speed
            delaySpeed = delaySpeed - 0.005
            IF delaySpeed < 0 THEN delaySpeed = 0 'don't allow a negative delay
        END IF
        IF debugging$ = "-" THEN delaySpeed = delaySpeed + 0.005 'decrease the game speed
        IF debugging$ = "m" OR debugging$ = "M" THEN mute = mute * -1 'turn mute on or off
        IF debugging$ = "p" OR debugging$ = "P" THEN pause$ = INPUT$(1) 'pause the game
        IF debugging$ = CHR$(27) THEN EXIT DO 'end the game and return to the main menu
    LOOP
END SUB
 
SUB EndOfGame
    COLOR 15, 0
    CLS
    PRINT "Game over"
    CALL P(FALSE)
END SUB
 
SUB MoveBall (whichOne)
    changeBallSomewhat = changeBallSomewhat + 1 'keep track of the number of times the ball has moved to occasionally nudge it
    SELECT CASE ballDirection(whichOne)
        CASE upAndRight
            CALL MoveUpAndRight(whichOne)
        CASE upAndLeft
            CALL MoveUpAndLeft(whichOne)
        CASE downAndRight
            CALL MoveDownAndRight(whichOne)
        CASE downAndLeft
            CALL MoveDownAndLeft(whichOne)
    END SELECT
END SUB
 
FUNCTION Report (x, y) 'determine what element is at specified x, y location
    'if color  12 then border, 1 then background, 15 then paddle, 11 ball, 9 bonus, else brick
    rtn = -1 'initialize what should be returned
    SELECT CASE board(x, y, 2)
        CASE 12
            rtn = theWall
        CASE 1
            rtn = theBackground
        CASE 15
            rtn = thePaddle
        CASE 11
            rtn = theBall
        CASE 9
            rtn = theBonus
        CASE ELSE
            rtn = theBrick
    END SELECT
    Report = rtn
END FUNCTION
 
SUB MoveUpAndRight (thisBall)
    SELECT CASE Report(ball(thisBall).x + 1, ball(thisBall).y - 1) 'report one away from where the ball currently is
        CASE theBackground, theBall ' move it even if both balls are in the same place
            ball(thisBall).x = ball(thisBall).x + 1
            ball(thisBall).y = ball(thisBall).y - 1
            IF changeBallSomewhat MOD 100 = 0 AND ball(thisBall).x + 1 < 80 THEN ball(thisBall).x = ball(thisBall).x + 1
        CASE theWall
            IF mute = -1 THEN PLAY hitWallSound
            IF ball(thisBall).x + 1 = 80 THEN
                'hit the right wall
                ballDirection(thisBall) = upAndLeft
            ELSEIF ball(thisBall).y - 1 = 1 THEN
                'hit top wall
                ballDirection(thisBall) = downAndRight
            END IF
        CASE theBrick
            IF mute = -1 THEN PLAY hitBrickSound
            leftSideOfBrick = FindBrickLeft(ball(thisBall).x + 1)
            vertOfBrick = FindBrickVertical(ball(thisBall).y - 1)
            CALL PrintBrick(leftSideOfBrick, vertOfBrick, FALSE)
            ballDirection(thisBall) = downAndRight
    END SELECT
END SUB
 
SUB MoveUpAndLeft (b)
    SELECT CASE Report(ball(b).x - 1, ball(b).y - 1)
        CASE theBackground, theBall, theBonus
            ball(b).x = ball(b).x - 1
            ball(b).y = ball(b).y - 1
            IF changeBallSomewhat MOD 100 = 0 AND ball(b).x - 1 > 1 THEN ball(b).x = ball(b).x - 1
        CASE theWall
            IF mute = -1 THEN PLAY hitWallSound
            IF ball(b).x - 1 = 1 THEN
                ballDirection(b) = upAndRight
            ELSEIF ball(b).y - 1 = 1 THEN 'hit the top
                ballDirection(b) = downAndLeft
            END IF
        CASE theBrick
            IF mute = -1 THEN PLAY hitBrickSound
            leftSideOfBrick = FindBrickLeft(ball(b).x - 1)
            vertOfBrick = FindBrickVertical(ball(b).y - 1)
            CALL PrintBrick(leftSideOfBrick, vertOfBrick, FALSE)
            ballDirection = downAndLeft
    END SELECT
END SUB
 
SUB MoveDownAndRight (var)
    SELECT CASE Report(ball(var).x + 1, ball(var).y + 1)
        CASE theBackground, theBall, theBonus
            IF ball(var).y + 1 = 48 THEN
                IF debugMode = FALSE THEN
                    CALL PrintBall(var, FALSE) 'remove the ball the fell from the screen
                    IF activeBall <> 3 THEN 'activeBall is 1 or 2
                        score = score - 50
                        spaceToStart = FALSE
                        CALL PrintPaddle(FALSE)
                        paddleLength = 8
                        paddleLeft = INT(RND * (72 - 2 + 1)) + 2
                        activeBall = 1
                        ball(activeBall).x = paddleLeft + 4: ball(activeBall).y = 47
                        CALL PrintBall(activeBall, TRUE)
                        CALL PrintPaddle(TRUE)
                        ballDirection(activeBall) = INT(RND * 2) + 1
                        IF mute = -1 THEN PLAY deathSound
                        numberOfGuys = numberOfGuys - 1
                        CALL PrintBoard
                    ELSEIF activeBall = 3 THEN
                        IF var = 1 THEN
                            activeBall = 2
                        ELSEIF var = 2 THEN
                            activeBall = 1
                        END IF
                        ball(var).x = 0
                        ball(var).y = 0
                        COLOR 10, 0: LOCATE 10, 1
                        PRINT "ball(var).x, ball(var).y"
                        PRINT "ball(" + S$(var) + ").x, ball(+"; S$(var) + ").y"
                        PRINT S$(ball(var).x) + ", " + S$(ball(var).y)
                        PRINT "activeBall: " + S$(activeBall)
                        CALL P(TRUE)
                    ELSE
                        LOCATE 40, 1: COLOR 15, 0: PRINT "MoveDownAndRight has active ball<>1, 2 or 3": CALL P(TRUE)
                    END IF
                ELSE 'debug mode is on (true)
                    IF mute = -1 THEN PLAY hitWallSound
                    ballDirection(var) = upAndRight
                    ball(var).x = ball(var).x + 1
                    ball(var).y = ball(var).y - 1
                    IF changeBallSomewhat MOD 100 = 0 AND ball(var).x + 1 < 80 THEN ball(var).x = ball(var).x + 1
                END IF
            ELSE 'debug is on
                ball(var).x = ball(var).x + 1
                ball(var).y = ball(var).y + 1
            END IF
        CASE theWall
            IF mute = -1 THEN PLAY hitWallSound
            IF ball(var).x + 1 = 80 THEN ballDirection(var) = downAndLeft
        CASE theBrick
            IF mute = -1 THEN PLAY hitBrickSound
            leftSideOfBrick = FindBrickLeft(ball(var).x + 1)
            vertOfBrick = FindBrickVertical(ball(var).y + 1)
            CALL PrintBrick(leftSideOfBrick, vertOfBrick, FALSE)
            ballDirection(var) = upAndRight
        CASE thePaddle
            IF mute = -1 THEN PLAY hitPaddleSound
            ballDirection(var) = upAndRight
    END SELECT
END SUB
 
SUB MoveDownAndLeft (i)
    SELECT CASE Report(ball(i).x - 1, ball(i).y + 1)
        CASE theBackground, theBall, theBonus
            IF ball(i).y + 1 = 48 THEN
                IF debugMode = FALSE THEN
                    CALL PrintBall(i, FALSE)
                    IF activeBall <> 3 THEN 'only one ball was active
                        score = score - 50
                        spaceToStart = FALSE
                        CALL PrintPaddle(FALSE)
                        paddleLeft = INT(RND * (72 - 2% + 1)) + 2
                        paddleLength = 8
                        activeBall = 1
                        ball(activeBall).x = paddleLeft + 4: ball(activeBall).y = 47
                        CALL PrintBall(activeBall, TRUE)
                        CALL PrintPaddle(TRUE)
                        ballDirection(activeBall) = INT(RND * 2) + 1
                        IF mute = -1 THEN PLAY deathSound
                        numberOfGuys = numberOfGuys - 1
                        CALL PrintBoard
                    ELSE 'one ball fell off the screen
                        IF i = 1 THEN
                            activeBall = 2
                        ELSEIF i = 2 THEN
                            activeBall = 1
                        END IF
                        ball(i).x = 0
                        ball(i).y = 0
                    END IF
                ELSE 'in debug mode
                    IF mute = -1 THEN PLAY hitWallSound
                    ballDirection(i) = upAndLeft
                    ball(i).x = ball(i).x - 1
                    ball(i).y = ball(i).y - 1
                    IF changeBallSomewhat MOD 100 = 0 AND ball(i).x - 1 > 1 THEN ball(i).x = ball(i).x + 1
                END IF
            ELSE 'not at bottom of screen
                ball(i).x = ball(i).x - 1
                ball(i).y = ball(i).y + 1
            END IF
        CASE theWall
            IF mute = -1 THEN PLAY hitWallSound
            IF ball(i).x - 1 = 1 THEN ballDirection(i) = downAndRight
        CASE theBrick
            IF mute = -1 THEN PLAY hitBrickSound
            leftSideOfBrick = FindBrickLeft(ball(i).x - 1)
            vertOfBrick = FindBrickVertical(ball(i).y + 1)
            CALL PrintBrick(leftSideOfBrick, vertOfBrick, FALSE)
            ballDirection(i) = upAndLeft
        CASE thePaddle
            IF mute = -1 THEN PLAY hitPaddleSound
            ballDirection(i) = upAndLeft
    END SELECT
END SUB
 
FUNCTION FindBrickLeft (x) 'this returns the x coordinate of the brick that was hit
    rtn = 0
    FOR cnt = 2 TO 79 STEP 6
        IF cnt <= x AND x <= cnt + 5 THEN rtn = cnt
    NEXT cnt
    FindBrickLeft = rtn
END FUNCTION
 
FUNCTION FindBrickVertical (y)
    rtn = 0
    FOR cnt = 2 TO 47
        IF cnt = y THEN rtn = cnt
    NEXT
    FindBrickVertical = rtn
END FUNCTION
 
SUB PrintBall (whichBall, onOrOff) 'put the ball on the board or remove it from the board to effect position change
    IF onOrOff = TRUE THEN
        useColor = 11
    ELSEIF onOrOff = FALSE THEN
        useColor = 1
    END IF
    CALL PlaceChar(ball(whichBall).x, ball(whichBall).y, 254, useColor)
    CALL PrintBoard
END SUB
 
SUB PrintPaddle (onOrOff)
    IF onOrOff = TRUE THEN
        theColor = 15
    ELSEIF onOrOf = FALSE THEN
        theColor = 1
    END IF
    IF paddleLeft < 2 THEN paddleLeft = 2
    IF paddleLeft > 80 - paddleLength THEN paddleLeft = 80 - paddleLength
    FOR across = 0 TO paddleLength - 1
        LOCATE 48, INT(paddleLeft) + across: COLOR theColor: PRINT CHR$(219)
        CALL PlaceChar(INT(paddleLeft) + across, 48, 219, theColor)
    NEXT across
END SUB
 
SUB PlaceChar (X, Y, char, clr) 'put the character ASCII with specified color on the board
    board(X, Y, 1) = char 'character
    board(X, Y, 2) = clr ' color
END SUB
 
SUB PrintBoard 'print the current board configurationg to the screen and update the current stats displayed
    FOR y = 2 TO 48: FOR x = 2 TO 79
            this$ = CHR$(board(x, y, 1))
            theColor = board(x, y, 2)
            COLOR theColor, 1
            LOCATE y, x
            PRINT this$
            IF BrickIsThere(x, y) = TRUE THEN
                xCo = FindBrickLeft(x)
                yCo = FindBrickVertical(y)
                CALL PrintBrick(xCo, yCo, TRUE)
            END IF
    NEXT x: NEXT y
    LOCATE 1, 2: COLOR 10, 12
    PRINT "  Level " + S$(currentLevel) + "       ";
    PRINT "Men: " + S$(numberOfGuys) + "       ";
    PRINT "Bricks remaining: " + S$(numberOfBricks) + "       ";
    PRINT "Score: " + S$(score) + "    "
END SUB
 
FUNCTION BrickIsThere (xCoord, yCoord)
    x = xCoord: y = yCoord
    rtn = FALSE
    IF board(x, y, 2) <> 11 AND board(x, y, 2) <> 15 AND board(x, y, 2) <> 12 AND board(x, y, 2) <> 9 AND board(x, y, 2) <> 1 THEN rtn = TRUE
    BrickIsThere = rtn
END FUNCTION
 
SUB CreationMain 'main subroutine for the level creation feature
    penUp = TRUE
    eraserOn = FALSE
    currentColor = 0
    brick.x = 2
    brick.y = 2
    FOR countX = 2 TO 79
        FOR countY = 2 TO 46
            creationBoard(countX, countY) = 1
    NEXT: NEXT
    CALL PrintBackdrop
    CALL PrintCreationBoard
    CALL PrintCreationBrick
    printOutCurrentBoard = FALSE
    DO
        whichCommand$ = INKEY$
        SELECT CASE whichCommand$
            CASE "P", "p"
                IF penUp = TRUE THEN
                    penUp = FALSE
                    CALL PutBrickOnBoard
                ELSEIF penUp = FALSE AND eraserOn = FALSE THEN
                    penUp = TRUE
                END IF
                CALL PrintBackdrop
                printOutCurrentBoard = TRUE
            CASE "E", "e"
                IF eraserOn = FALSE THEN
                    eraserOn = TRUE
                    currentColor = 1
                    penUp = FALSE
                    CALL PutBrickOnBoard
                ELSEIF eraserOn = TRUE THEN
                    eraserOn = FALSE
                    currentColor = 0
                    penUp = TRUE
                END IF
                printOutCurrentBoard = TRUE
            CASE "C", "c" 'game uses 12, 15, 11, 1 and 9, 17
                IF currentColor = 0 THEN
                    currentColor = 2
                ELSEIF currentColor = 8 THEN
                    currentColor = 10
                ELSEIF currentColor = 10 THEN
                    currentColor = 13
                ELSEIF currentColor = 14 THEN
                    currentColor = 16
                ELSEIF currentColor = 16 THEN
                    currentColor = 18
                ELSEIF currentColor < 31 THEN
                    currentColor = currentColor + 1
                ELSEIF currentColor = 31 THEN
                    currentColor = 0
                END IF
                printOutCurrentBoard = TRUE
                IF penUp = FALSE THEN CALL PutBrickOnBoard
            CASE "A", "a"
                penUp = TRUE
                eraserOn = FALSE
                currentColor = 0
                FOR xCount = 2 TO 79
                    FOR yCount = 2 TO 46
                        creationBoard(xCount, yCount) = 1
                NEXT: NEXT
                printOutCurrentBoard = TRUE
            CASE "s", "S"
                IF SaveBoard$ = "END" THEN EXIT DO
            CASE CHR$(0) + "H" ' up
                IF brick.y > 2 THEN
                    brick.y = brick.y - 1
                    IF penUp = FALSE THEN CALL PutBrickOnBoard
                    printOutCurrentBoard = TRUE
                END IF
            CASE CHR$(0) + "K" ' left
                IF brick.x > 7 THEN
                    brick.x = brick.x - 6
                    IF penUp = FALSE THEN CALL PutBrickOnBoard
                    printOutCurrentBoard = TRUE
                END IF
            CASE CHR$(0) + "P" ' down
                IF brick.y < 47 THEN
                    brick.y = brick.y + 1
                    IF penUp = FALSE THEN CALL PutBrickOnBoard
                    printOutCurrentBoard = TRUE
                END IF
            CASE CHR$(0) + "M" ' right
                IF brick.x < 73 THEN
                    brick.x = brick.x + 6
                    IF penUp = FALSE THEN CALL PutBrickOnBoard
                    printOutCurrentBoard = TRUE
                END IF
            CASE CHR$(27)
                EXIT DO
        END SELECT
        IF printOutCurrentBoard = TRUE THEN
            CALL PrintBackdrop
            CALL PrintCreationBoard
            CALL PrintCreationBrick
            printOutCurrentBoard = FALSE
        END IF
    LOOP
END SUB
 
FUNCTION SaveBoard$
    COLOR 10, 0
    CLS
    hghstLvl = 0
    IF _FILEEXISTS("Highest Level") THEN
        OPEN "Highest Level" FOR INPUT AS #1
        INPUT #1, hl$
        highestLevel = VAL(hl$)
        CLOSE #1
        highestLevel = highestLevel + 1
        OPEN "Highest Level" FOR OUTPUT AS #1
        PRINT #1, S$(highestLevel)
        CLOSE #1
    ELSE
        OPEN "Highest Level" FOR OUTPUT AS #1
        PRINT #1, S$(1)
        CLOSE #1
        highestLevel = 1
    END IF
 
    filename$ = "Level " + S$(highestLevel)
    LOCATE 10, 10
    PRINT "The game board has been saved as " + CHR$(34) + "Level " + S$(highestLevel) + CHR$(34)
    PRINT
    IF highestLevel > 1 THEN PRINT "It will automatically be loaded after Level " + S$(highestLevel - 1) + " is completed."
    PRINT
    OPEN filename$ FOR OUTPUT AS #1
    FOR x = 2 TO 79
        FOR y = 2 TO 46
            COLOR 10, 0: LOCATE 15, 15: PRINT "Working"
            stringOut$ = S$(creationBoard(x, y))
            IF LEN(stringOut$) = 1 THEN stringOut$ = " " + stringOut$
            PRINT #1, stringOut$
            COLOR 0, 0: LOCATE 15, 15: PRINT "Working"
    NEXT: NEXT
    CLOSE #1
    COLOR 10, 0
    a$ = "Push " + CHR$(34) + "A" + CHR$(34) + " to make (a)nother level"
    LOCATE 30, (80 - LEN(a$)) / 2
    PRINT a$
    b$ = "Push any other key to exit."
    PRINT: PRINT
    PRINT CenterText$(b$)
    pause$ = INPUT$(1)
    IF UCASE$(pause$) = "A" THEN
        CALL CreationMain
    ELSE
        SaveBoard$ = "END"
    END IF
END FUNCTION
 
SUB PutBrickOnBoard
    FOR counting = 0 TO 5
        creationBoard(brick.x + counting, brick.y) = currentColor
    NEXT counting
END SUB
 
SUB PrintCreationBrick
    IF penUp = TRUE AND eraserOn = FALSE THEN
        LOCATE brick.y, brick.x
        COLOR 15, 1
        PRINT CHR$(219)
    ELSEIF penUp = FALSE AND eraserOn = TRUE THEN
        LOCATE brick.y, brick.x
        COLOR 7, 1
        PRINT "-"
    ELSE
        LOCATE brick.y, brick.x
        COLOR currentColor, 1
        PRINT CHR$(219)
    END IF
    FOR count = 1 TO 5
        LOCATE brick.y, brick.x + count
        IF eraserOn = TRUE THEN
            COLOR 7, 1
            PRINT "-"
        ELSE
            COLOR currentColor, 1
            PRINT CHR$(219)
        END IF
    NEXT
END SUB
 
 
SUB PrintCreationBoard
    CALL PrintBackdrop
    FOR y = 2 TO 46
        FOR x = 2 TO 79
            COLOR creationBoard(x, y), 1
            LOCATE y, x
            PRINT CHR$(219)
    NEXT: NEXT
END SUB
 
SUB PrintBackdrop
    COLOR 1, 1: CLS
    COLOR 12, 1
    FOR x = 1 TO 80
        LOCATE 1, x: PRINT CHR$(219)
    NEXT
    FOR y = 1 TO 48
        LOCATE y, 1: PRINT CHR$(219)
        LOCATE y, 80: PRINT CHR$(219)
    NEXT
    COLOR 14, 1
    LOCATE 47, 3
    PRINT "Use the Arrow Keys To Move      P - Pen ";
    IF penUp = TRUE THEN
        COLOR 10, 1
        PRINT "up";
        COLOR 14, 1
        PRINT "/";
        COLOR 7, 1
        PRINT "down";
    ELSE
        COLOR 7, 1
        PRINT "up";
        COLOR 14, 1
        PRINT "/";
        COLOR 10, 1
        PRINT "down";
    END IF
    PRINT "       ";
    IF currentColor = 0 THEN
        COLOR 0, 7
    ELSE
        COLOR currentColor, 0
    END IF
    PRINT "C - Cycle colors"
    LOCATE 48, 2
    COLOR 14, 1: PRINT "E - Eraser ";
    'LOCATE 20, 20: COLOR 15, 0: PRINT "eraserOn = " + S$(eraserOn): CALL P
    '    LOCATE 48, 26
    IF eraserOn = TRUE THEN
        COLOR 10, 1
        PRINT "On";
        COLOR 14, 1: PRINT "/";
        COLOR 7, 1
        PRINT "Off";
    ELSE
        COLOR 7, 1
        PRINT "On";
        COLOR 14, 1
        PRINT "/";
        COLOR 10, 1
        PRINT "Off";
    END IF
    COLOR 14, 1
    PRINT "     A - Clear All";
    PRINT "     S - Save     [ESC] - End Without Save"
    CALL PrintCreationBrick
    '    LOCATE 45, 10: COLOR 10, 1: PRINT "eraserOn = " + S$(eraserOn)
END SUB
 
SUB P (EndAllowed)
    pause$ = INPUT$(1)
    IF pause$ = CHR$(27) AND EndAllowed = TRUE THEN END
END SUB
 
FUNCTION S$ (number)
    S$ = LTRIM$(STR$(number))
END FUNCTION

QB64 Discussion / Password generator

« on: July 17, 2021, 03:50:23 pm »

Makes sure one of each character type is in the password. All passwords contain an uppercase letter, a lowercase letter and an integer with the length give by the user. User must input which special characters are valid. No very user friendly. For example if you try to make a two character password, the program goes into an endless loop while it tries to find a password with an uppercase, lowercase and integer. If you add special characters, the password length has to be at least four. I like this better than chrome generating a password.

Code: QB64: [Select]

'Creator: Jaze C McAskill
 
CONST FALSE = 0
CONST TRUE = 1
 
RANDOMIZE TIMER
CLS
PRINT "Special characters? ";
specialCharsYN$ = UCASE$(INPUT$(1))
 
characterSet$ = "" 'define the list of characters from which to make the password
FOR upperLower = 65 TO 64 + 26
    characterSet$ = characterSet$ + CHR$(upperLower) 'add upper case letters
    characterSet$ = characterSet$ + CHR$(upperLower + (96 - 64)) 'add lower case letters
NEXT
 
FOR integers = 48 TO 48 + 9
    characterSet$ = characterSet$ + CHR$(integers) 'add numbers
NEXT integers
 
IF specialCharsYN$ = "Y" THEN 'get special characters from user
    PRINT
    PRINT "Type in character set to use, <ENTER> to stop."
    another$ = ""
    DO
        characterSet$ = characterSet$ + another$ 'add provided special characters
        another$ = INPUT$(1): PRINT another$ + " ";
    LOOP UNTIL another$ = CHR$(13)
END IF
 
PRINT: PRINT
INPUT "Password length: "; pwlength
 
makePwAgain: 'place to return to if the password is missing an upper case, lower case, integer or special character
pw$ = "": newChar$ = ""
 
FOR pickAcharFromCharacterSet = 1 TO pwlength 'loop from 1 to the length of the password to be generated
    newChar$ = MID$(characterSet$, INT(RND * LEN(characterSet$) + 1), 1) 'pick a new character from the predefined set
    pw$ = pw$ + newChar$ 'add it to the password
NEXT
 
intInPw = FALSE '      used to make sure and integer is in the password
upperCaseInPw = FALSE ' same for upper case
lowerCaseInPw = FALSE ' lower case
specialCharInPw = FALSE ' special character
 
'the specialChar checking is the one I can't see yet
FOR parsing = 1 TO LEN(pw$) 'check each character in the generated password to make sure one of each is there
    IF ASC(MID$(pw$, parsing, 1)) >= 65 AND ASC(MID$(pw$, parsing, 1)) < 65 + 26 THEN 'there is an uppercase letter
        upperCaseInPw = TRUE
    ELSEIF ASC(MID$(pw$, parsing, 1)) >= 96 AND ASC(MID$(pw$, parsing, 1)) < 96 + 65 THEN 'there is a lowercase letter
        lowerCaseInPw = TRUE
    ELSEIF VAL(MID$(pw$, parsing, 1)) >= 0 AND VAL(MID$(pw$, parsing, 1)) < 10 THEN 'there is an integer
        intInPw = TRUE
    END IF
NEXT parsing
'program knows if pw$ has an int, an upper case and a lower case
 
IF specialCharsYN$ = "Y" THEN 'check to make sure a special character was added
    FOR parsing = (26 * 2 + 10) + 1 TO LEN(characterSet$) 'skip the uppercase, lowercase and integers in the set from wich the password is made
        ifThisCharIsInPW$ = MID$(characterSet$, parsing, 1) ' cycle throgh the special characters
        FOR parsing2 = 1 TO LEN(pw$)
            IF MID$(pw$, parsing2, 1) = ifThisCharIsInPW$ THEN specialCharInPw = TRUE
        NEXT parsing2
    NEXT parsing
ELSE
    specialCharInPw = TRUE
END IF
 
IF intInPw = FALSE OR upperCaseInPw = FALSE OR lowerCaseInPw = FALSE OR specialCharInPw = FALSE THEN GOTO makePwAgain
PRINT pw$

Programs / Function for the difference in minutes between two times

« on: July 16, 2021, 02:21:23 pm »

I previously posted this but later found an error. It takes two strings containing the time and date. It assumes the first string is the earlier of the two times. The time strings are in the format with one or two digits for hours, month and day. Assumes the time is in 12 hour time. For example, one valid string is 1:25 PM 12/7/2021

Code: QB64: [Select]

FUNCTION GetDifference (earlierTime$, moreRecentTime$)
    colonPosition1 = INSTR(earlierTime$, ":") 'format is H:MM #M M/D/YYYY to HH:MM #M MM/DD/YYYY so finging the colon is needed
    colonPosition2 = INSTR(moreRecentTime$, ":") 'same
    hours1 = VAL(LEFT$(earlierTime$, colonPosition1 - 1)) 'hours portion of the time
    hours2 = VAL(LEFT$(moreRecentTime$, colonPosition2 - 1))
    minutes1 = VAL(MID$(earlierTime$, colonPosition1 + 1, 2)) ' minutes portion of the time
    minutes2 = VAL(MID$(moreRecentTime$, colonPosition2 + 1, 2))
    IF MID$(earlierTime$, colonPosition1 + 4, 1) = "P" AND hours1 <> 12 THEN hours1 = hours1 + 12 'convert to 24hr
    IF MID$(moreRecentTime$, colonPosition2 + 4, 1) = "P" AND hours2 <> 12 THEN hours2 = hours2 + 12
    month1 = VAL(LTRIM$(MID$(earlierTime$, INSTR(earlierTime$, "/") - 2, 2))) 'the month of the earlier string
    month2 = VAL(LTRIM$(MID$(moreRecentTime$, INSTR(moreRecentTime$, "/") - 2, 2))) 'month of the later string
    rightCut1$ = MID$(earlierTime$, INSTR(earlierTime$, "/") + 1, LEN(earlierTime$)) 'cut the string to find the 2nd "/"
    rightcut2$ = MID$(moreRecentTime$, INSTR(moreRecentTime$, "/") + 1, LEN(moreRecentTime$))
    day1 = VAL(LEFT$(rightCut1$, INSTR(rightCut1$, "/") - 1)) 'get the day of the month
    day2 = VAL(LEFT$(rightcut2$, INSTR(rightcut2$, "/") - 1))
    year1 = VAL(MID$(rightCut1$, INSTR(rightCut1$, "/") + 1, 4)) 'and finally the year
    year2 = VAL(MID$(rightcut2$, INSTR(rightcut2$, "/") + 1, 4))
    IF hours1 = 24 THEN hours1 = 0 'puts midnight to hour 0
    IF hours2 = 24 THEN hours2 = 0
    minutesDifferent = 0 'initialize the number of minutes the two times differ
    currentMinute = minutes1 'hours, minutes, days, months and years need to stay the same to exit the following loop
    currentHour = hours1
    currentDay = day1
    currentMonth = month1
    currentYear = year1
    DO
        minutesDifferent = minutesDifferent + 1 'increment the number of minutes different
        currentMinute = currentMinute + 1 'move the counter for exiting the loop
        IF currentMinute = 60 THEN '60 minutes is the next hour
            currentMinute = 0
            currentHour = currentHour + 1
            IF currentHour = 24 THEN 'go to the next day
                currentHour = 0
                currentDay = currentDay + 1
                IF currentDay >= 28 THEN 'see if the months needs to be incremented and do so when it is needed
                    SELECT CASE currentMonth
                        CASE 4, 6, 9, 11 'April, June, September and November have 30 days
                            IF currentDay = 31 THEN 'increment the month
                                currentMonth = currentMonth + 1
                                currentDay = 1
                            END IF
                        CASE 1, 3, 5, 7, 8, 10, 12 'January, March, May, July, August, October and December
                            IF currentDay = 32 THEN 'increment the month
                                currentMonth = currentMonth + 1
                                currentDay = 1
                            END IF
                        CASE 2 'february
                            IF currentDay = 29 AND currentYear MOD 4 <> 0 THEN 'if not a leap year, increment the month
                                currentMonth = 3
                                currentDay = 1
                            ELSEIF currentDay = 30 AND currentYear MOD 4 = 0 THEN 'if is leap year, increment month
                                currentMonth = 3
                                currentDay = 1
                            END IF
                    END SELECT
                    IF currentMonth = 13 THEN 'increment the year
                        currentYear = currentYear + 1
                        currentMonth = 1
                    END IF
                END IF
            END IF
        END IF
    LOOP UNTIL (currentHour = hours2 AND currentMinute = minutes2 AND currentMonth = month2 AND currentDay = day2 AND currentYear = year2)
    GetDifference = minutesDifferent
END FUNCTION
 

Pages: [1] 2

News:

Show Posts

Topics - Jaze

QB64 Discussion / Time Calculator

QB64 Discussion / Highlight% changes by itself

QB64 Discussion / Fickle Increment variable

QB64 Discussion / big number

QB64 Discussion / Strangest Error. Anyone know why?

QB64 Discussion / There is definitely an error but for the life of me I can't see it

QB64 Discussion / is this a buig, am I blind or do I just not know something abiout the code?

QB64 Discussion / Trouble understanding MID$( )

Programs / CryptoGram finished!

QB64 Discussion / I'm stumped by this error

Programs / Roman Numeral / Decimal Number converter

Programs / Tic Tac Toe

QB64 Discussion / Break Thru

QB64 Discussion / Password generator

Programs / Function for the difference in minutes between two times