DEFINT A-Z

DECLARE SUB ClearLine ()
DECLARE FUNCTION RemoveColor$ (te$)
DECLARE FUNCTION TextYesNo% (Text$, which)
DECLARE SUB AddToCommand (SB%, a$)
DECLARE SUB Paus ()
DECLARE SUB DoCursor (m%)
DECLARE SUB Oprint (a$)
DECLARE FUNCTION KbIn$ (l%, a$, cc$, SB%)

CONST MaxScroll = 60
CONST MAXARRAYSIZE = 60

COMMON SHARED TextMode
COMMON SHARED BwMode   'configurable
COMMON SHARED MusicOn
COMMON SHARED SoundOn
COMMON SHARED AllUpper 'configurable
COMMON SHARED Box1Size 'This is set by code, not configurable
COMMON SHARED Box2Size 'This is set by code, not configurable
COMMON SHARED a$
COMMON SHARED Lo AS INTEGER
COMMON SHARED Fbuff AS STRING * 8960 'For Fonts
COMMON SHARED ScrollArray() AS STRING * 96
COMMON SHARED bs1$, bs2$, bs3$, bs4$, bs5$, bs6$, bs0$, bsb$

DIM SHARED ScrollArray(MAXARRAYSIZE, 1 TO 2) AS STRING * 96
DIM SHARED TransColor(0 TO 20) AS INTEGER
DIM SHARED ScrollCommandCount AS INTEGER
DIM SHARED ScrollBackCommand$(MaxScroll)
DIM SHARED OldX1, oldx2, OldX3 AS INTEGER
DIM SHARED OldBG, OldFG, Flash
DIM SHARED Oldx4, X1, X2, X3, BG, FG

DEFSNG A-Z
SUB AddToCommand (SB%, b$)

IF SB% = 1 AND b$ <> "" THEN
    IF ScrollCommandCount >= 1 THEN
        IF UCASE$(ScrollBackCommand$(ScrollCommandCount)) = UCASE$(b$) THEN
            EXIT SUB
        END IF
    END IF

    IF ScrollCommandCount >= MaxScroll THEN
        ScrollCommandCount = MaxScroll
        FOR x = 1 TO MaxScroll - 1: ScrollBackCommand$(x) = ScrollBackCommand$(x + 1)
        NEXT x
    ELSE
        ScrollCommandCount = ScrollCommandCount + 1
    END IF
    ScrollBackCommand$(ScrollCommandCount) = b$
END IF

END SUB

DEFINT A-Z
SUB ClearLine
    Oprint "`7" + STRING$(Box2Size, 8) + STRING$(Box2Size - 1, " ") + STRING$(Box2Size, 8)
END SUB

DEFSNG A-Z
SUB DoCursor (m%)

STATIC cc AS INTEGER 'So that it's maintained for each call into this routine

IF m% = 3 THEN cc = cc + 1: IF cc > 3 THEN cc = 0

    IF cc = 0 THEN CCode$ = "`8"
    IF cc = 1 THEN CCode$ = "`7"
    IF cc = 2 THEN CCode$ = "`%"
    IF cc = 3 THEN CCode$ = "`7"

    IF m% = 0 THEN Oprint CCode$ + "\" + CHR$(8)
    IF m% = 1 THEN Oprint CCode$ + "³" + CHR$(8)
    IF m% = 2 THEN Oprint CCode$ + "/" + CHR$(8)
    IF m% = 3 THEN Oprint CCode$ + "Ä" + CHR$(8)

END SUB

DEFINT A-Z
SUB InitTextLib

OldX1 = -1: oldx2 = -1: OldX3 = -1 'Cursor positioning, I think.

IF BwMode = 0 THEN
    TransColor(0) = 0: TransColor(1) = 4: TransColor(2) = 2
    TransColor(3) = 6: TransColor(4) = 1: TransColor(5) = 5
    TransColor(6) = 3: TransColor(7) = 7
    TransColor(10) = 8: TransColor(11) = 12: TransColor(12) = 10
    TransColor(13) = 14: TransColor(14) = 9: TransColor(15) = 13
    TransColor(16) = 11: TransColor(17) = 15
ELSE
    TransColor(0) = 0: TransColor(1) = 7: TransColor(2) = 7
    TransColor(3) = 7: TransColor(4) = 7: TransColor(5) = 7
    TransColor(6) = 7: TransColor(7) = 7
    TransColor(10) = 7: TransColor(11) = 7: TransColor(12) = 7
    TransColor(13) = 7: TransColor(14) = 7: TransColor(15) = 7
    TransColor(16) = 7: TransColor(17) = 15
END IF

END SUB

FUNCTION KbIn$ (l%, a$, cc$, SB%) 'cc=input color 'SB%=Scrollback!

Lmax = l%

DIM LL AS LONG
DIM m AS INTEGER

m = 0

V1 = ScrollCommandCount + 1
V2 = ScrollItemCount + 1

IF TempCommand$ <> "" THEN
    V1 = TempCommandNumber1
    IF TempCommand$ = "*" THEN TempCommand$ = ""
END IF

Abort = 0: Oprint "`%`" + cc$ + a$
Incount = 0

Party:
 
    i$ = INKEY$
    IF i$ = "" THEN
        DoCursor m
        m = m + 1: IF m > 3 THEN m = 0
        Paus
        GOTO Party
    END IF
Rikey:
    IF SoundOn <> 0 THEN PLAY "mbt255l63o1d"
    IF LEN(i$) < 1 THEN GOTO SkipRolling

    '*** New stuff added on 10/13/97 for ScrollBack buffer!!!
    IF SB% = 1 THEN
        IF ScrollCommandCount > 0 AND V1 > 1 THEN
            IF LEN(i$) = 2 AND ASC(RIGHT$(i$, 1)) = 72 THEN 'up arrow
                IF V1 >= (ScrollCommandCount + 1) THEN TempCommand$ = a$
                Oprint " " + CHR$(8)
                Oprint STRING$(LEN(a$), 8)
                Oprint STRING$(LEN(a$), " ")
                Oprint STRING$(LEN(a$), 8)
                V1 = V1 - 1: IF V1 < 1 THEN V1 = 1
                Oprint "`%`" + cc$ + ScrollBackCommand$(V1)
                a$ = ScrollBackCommand$(V1)
                GOTO Party
            END IF
        END IF
        IF ScrollCommandCount > 0 AND V1 < (ScrollCommandCount + 1) THEN
            IF LEN(i$) = 2 AND ASC(RIGHT$(i$, 1)) = 80 THEN 'Down Arrow
                Oprint " " + CHR$(8)
                Oprint STRING$(LEN(a$), 8)
                Oprint STRING$(LEN(a$), " ")
                Oprint STRING$(LEN(a$), 8)
                V1 = V1 + 1: IF V1 >= (ScrollCommandCount + 1) THEN V1 = ScrollCommandCount + 1
                IF V1 <= ScrollCommandCount THEN
                    Oprint "`%`" + cc$ + ScrollBackCommand$(V1)
                    a$ = ScrollBackCommand$(V1)
                ELSE
                    Oprint "`%`" + cc$ + TempCommand$
                    a$ = TempCommand$
                END IF
                GOTO Party
            END IF
        END IF
    END IF

'---------------------------------------------------------------------------
SkipRolling:     'To skip the above stuff under normal keystrokes :)

    IF i$ = CHR$(8) THEN
        v = LEN(a$)
        te$ = " " + CHR$(8) + CHR$(8) + " " + CHR$(8)
        IF v > 0 THEN
            Oprint "`%`" + cc$ + te$
            v = v - 1
            a$ = LEFT$(a$, LEN(a$) - 1)
        END IF
    END IF

    IF i$ = CHR$(13) THEN GOTO Angela
    IF i$ = CHR$(27) THEN Abort = 1: a$ = "": GOTO Angela
    I2$ = UCASE$(i$)
    IF I2$ > CHR$(&H1F) THEN
        IF LEN(a$) < Lmax THEN
            Oprint "`%`" + cc$ + i$
            a$ = a$ + i$
            Incount = Incount + TookIn
            IF m = 0 THEN Oprint "`%ù" + CHR$(8) + "`" + cc$
            IF m = 1 THEN Oprint "`#o" + CHR$(8) + "`" + cc$
            IF m = 2 THEN Oprint "`5O" + CHR$(8) + "`" + cc$
        END IF
    END IF
GOTO Party

Angela:

AddToCommand SB%, a$
KbIn$ = a$
Oprint " " + CHR$(8)
TempCommand$ = ""

END FUNCTION

SUB Oprint (a$)

IF AllUpper > 0 THEN a$ = UCASE$(a$)

'DoTokenize (a$) 'This added to create "TOKENS" out of key words in the text!
WHILE INSTR(a$, "“")
    MID$(a$, INSTR(a$, "“"), 1) = CHR$(34)
WEND
WHILE INSTR(a$, "”")
    MID$(a$, INSTR(a$, "”"), 1) = CHR$(34)
WEND

Esc = 0: CCode = 0: Yuk$ = "": n = 0: Didit = 0
t = 0

PPRINT: FOR xz = 1 TO LEN(a$)
    hot$ = MID$(a$, xz, 1)
    GOSUB Opt
NEXT xz

IF Didit <> 0 THEN
    OldBG = 0: OldFG = 3: Flash = 0
    COLOR 3, 0
    Didit = 0
END IF
EXIT SUB

Opt:
IF hot$ = CHR$(8) THEN ntt = POS(n) - 1: IF ntt < 1 THEN ntt = 1
IF hot$ = CHR$(8) THEN LOCATE CSRLIN, ntt: RETURN
IF hot$ = CHR$(27) THEN Esc = 1: Yuk$ = CHR$(27): RETURN
IF Esc THEN IF (hot$ >= "A" AND hot$ <= "Z") OR (hot$ >= "a" AND hot$ <= "z") THEN GOSUB ANSI: Esc = 0: Yuk$ = "": RETURN
IF Esc THEN Yuk$ = Yuk$ + hot$: RETURN
IF CCode THEN
    CCode = 0
    IF BwMode = 1 THEN
        IF hot$ = "%" THEN COLOR 15 + Flash: OldFG = 15
        IF hot$ = "7" THEN COLOR 7 + Flash: OldFG = 7
    ELSE
        IF hot$ = "}" THEN COLOR 0 + Flash: OldFG = 0
        IF hot$ = "1" THEN COLOR 1 + Flash: OldFG = 1
        IF hot$ = "2" THEN COLOR 2 + Flash: OldFG = 2
        IF hot$ = "3" THEN COLOR 3 + Flash: OldFG = 3
        IF hot$ = "4" THEN COLOR 4 + Flash: OldFG = 4
        IF hot$ = "5" THEN COLOR 5 + Flash: OldFG = 5
        IF hot$ = "6" THEN COLOR 6 + Flash: OldFG = 6
        IF hot$ = "7" THEN COLOR 7 + Flash: OldFG = 7
        IF hot$ = "8" THEN COLOR 8 + Flash: OldFG = 8
        IF hot$ = "9" THEN COLOR 9 + Flash: OldFG = 9
        IF hot$ = "0" THEN COLOR 10 + Flash: OldFG = 10
        IF hot$ = "!" THEN COLOR 11 + Flash: OldFG = 11
        IF hot$ = "@" THEN COLOR 12 + Flash: OldFG = 12
        IF hot$ = "#" THEN COLOR 13 + Flash: OldFG = 13
        IF hot$ = "$" THEN COLOR 14 + Flash: OldFG = 14
        IF hot$ = "%" THEN COLOR 15 + Flash: OldFG = 15
        IF hot$ = "^" THEN COLOR 15 + Flash: OldFG = 15
        IF hot$ = "a" THEN COLOR , 1: OldBG = 1: Didit = 1
        IF hot$ = "b" THEN COLOR , 2: OldBG = 2: Didit = 1
        IF hot$ = "c" THEN COLOR , 3: OldBG = 3: Didit = 1
        IF hot$ = "d" THEN COLOR , 4: OldBG = 4: Didit = 1
        IF hot$ = "e" THEN COLOR , 5: OldBG = 5: Didit = 1
        IF hot$ = "f" THEN COLOR , 6: OldBG = 6: Didit = 1
        IF hot$ = "g" THEN COLOR , 7: OldBG = 7: Didit = 1
        IF hot$ = "h" THEN COLOR , 0: OldBG = 0: Didit = 1
        IF hot$ = "&" THEN '** produce a RANDOM foreground color!
            c = INT(15 * RND(1)) + 1
            COLOR c + Flash: OldFG = c
        END IF
        IF hot$ = "i" THEN '** produce a RANDOM background color!
            c = INT(8 * RND(1))
            COLOR , c: OldBG = c
            Didit = 1
        END IF
        IF hot$ = "`" THEN '** toggle flashing on & off
            IF Flash = 16 THEN Flash = 0 ELSE Flash = 16
            COLOR OldFG + Flash
            : Didit = 1
        END IF
        IF hot$ = "(" THEN '** force flashing off regardless or prior state
            Flash = 0
            COLOR OldFG
        END IF
    END IF
    RETURN
END IF
IF hot$ = "`" THEN CCode = 1: Yuk$ = "`": RETURN
IF hot$ = CHR$(10) OR hot$ = "{" OR hot$ = "}" THEN RETURN'Ignore Line Feed or TOKEN char.

PRINT hot$;
'IF LineBreak <> 0 THEN
'    IF hot$ = " " AND POS(n) > 68 THEN PRINT : PRINT " "; ' to allow the left-side spacer column
'END IF
RETURN

'****************************************************************************
'  Ansi-Translation routines: call to print ANSI escape-coded strings.
'****************************************************************************

ANSI:
Esc = 0

IF hot$ <> "m" THEN GOTO NotM

p1 = -1: p2 = -1: p3 = -1: p4 = -1
p1 = VAL(MID$(Yuk$, 3, 2))
'nul1 = 0: nul2 = 0: nul3 = 0
nul1 = INSTR(Yuk$, ";")
IF nul1 < 1 THEN GOTO Tzer ELSE p2 = VAL(MID$(Yuk$, nul1 + 1, 2))
nul2 = INSTR(nul1 + 1, Yuk$, ";")
IF nul2 < 1 THEN GOTO Tzer ELSE p3 = VAL(MID$(Yuk$, nul2 + 1, 2))
nul3 = INSTR(nul2 + 1, Yuk$, ";")
IF nul3 > 0 THEN p4 = VAL(MID$(Yuk$, nul3 + 1, 2))
Tzer:

n = 0: t = 0
X1 = -1: X2 = -1: X3 = -1: x4 = Oldx4

IF p1 = 0 OR p2 = 0 OR p3 = 0 OR p4 = 0 THEN OldX1 = 0: oldx2 = 37: OldX3 = 40: Oldx4 = 0: x4 = 0
IF p1 = 5 OR p2 = 5 OR p3 = 5 OR p4 = 5 THEN Oldx4 = 1: x4 = 1

IF p1 = 1 THEN X1 = p1 ELSE IF p1 >= 30 AND p1 < 40 THEN X2 = p1 ELSE IF p1 >= 40 THEN X3 = p1
IF p2 = 1 THEN X1 = p2 ELSE IF p2 >= 30 AND p2 < 40 THEN X2 = p2 ELSE IF p2 >= 40 THEN X3 = p2
IF p3 = 1 THEN X1 = p3 ELSE IF p3 >= 30 AND p3 < 40 THEN X2 = p3 ELSE IF p3 >= 40 THEN X3 = p3
IF p4 = 1 THEN X1 = p4 ELSE IF p4 >= 30 AND p4 < 40 THEN X2 = p4 ELSE IF p4 >= 40 THEN X3 = p4

IF X2 = -1 THEN X2 = oldx2
IF X3 = -1 THEN X3 = OldX3
IF X1 = -1 THEN X1 = OldX1

t = TransColor((X2 - 30) + (X1 * 10))
IF x4 = 1 THEN t = t + 16
n = TransColor(X3 - 40)

grk:
IF X3 >= 0 AND X2 >= 0 THEN COLOR t, n: OldFG = t: OldBG = n: GOTO Gif
IF X2 >= 0 AND X3 < 0 THEN COLOR t: OldFG = t: GOTO Gif
IF X3 >= 0 AND X2 < 0 THEN COLOR , n: OldBG = n

Gif:
OldX1 = X1
oldx2 = X2
OldX3 = X3

Yuk$ = "": RETURN

NotM:
IF UCASE$(hot$) <> "F" AND UCASE$(hot$) <> "H" THEN GOTO NotF

IF Yuk$ = CHR$(27) + "[" THEN
    X2 = 1: X1 = 1
    GOTO Petty
END IF
IF INSTR(Yuk$, "?") > 0 THEN
    X2 = 1
    X1 = VAL(MID$(Yuk$, INSTR(2, Yuk$, "?") + 1, 2))
    GOTO Petty
END IF
IF INSTR(Yuk$, ";") = 0 THEN
    X2 = 1: X1 = VAL(MID$(Yuk$, 3, 2))
    GOTO Petty
END IF

X1 = VAL(MID$(Yuk$, 3, 2))
X2 = VAL(MID$(Yuk$, INSTR(4, Yuk$, ";") + 1, 2))

Petty:
IF X1 > 24 THEN X1 = 24 ELSE IF X1 < 1 THEN X1 = 1
IF X2 > 80 THEN X2 = 80 ELSE IF X2 < 1 THEN X2 = 1
LOCATE X1, X2
RETURN

NotF:
IF hot$ = "A" OR hot$ = "B" OR hot$ = "C" OR hot$ = "D" THEN v = VAL(MID$(Yuk$, INSTR(Yuk$, "[") + 1, 2)) ELSE GOTO NotN
IF v < 1 THEN v = 1
a = CSRLIN: b = POS(n)

IF hot$ = "A" THEN
    IF a - v < 1 THEN LOCATE 1, b: RETURN
    LOCATE a - v, b: RETURN
END IF
IF hot$ = "B" THEN
    IF a + v > 24 THEN LOCATE 24, b: RETURN
    LOCATE a + v, b: RETURN
END IF
IF hot$ = "C" THEN
    IF b + v > 80 THEN LOCATE a, 80: RETURN
    LOCATE a, b + v: RETURN
END IF
IF hot$ = "D" THEN
    IF b - v < 1 THEN LOCATE a, 1: RETURN
    LOCATE a, b - v: RETURN
END IF
RETURN

NotN:
IF hot$ <> "K" THEN GOTO NotK
a1 = CSRLIN: a2 = POS(0): d = 80 - a2: IF d > 0 THEN PRINT STRING$(d, " ");
Yuk$ = "": LOCATE a1, a2: RETURN

NotK:
'IF hot$ = "J" THEN COLOR 7, 0: CLS : StatLine: Yuk$ = "": RETURN
IF hot$ = "J" THEN COLOR 7, 0: CLS : Yuk$ = "": RETURN
IF hot$ = "s" THEN Savedxx = POS(0): Savedyy = CSRLIN: RETURN
IF hot$ = "u" THEN LOCATE Savedyy, Savedxx: RETURN

Yuk$ = "": RETURN

'****** Notes about the OPRINT procedure:

'** This nifty bit of code has been over 2 years in the making. It started off
'** small but has grown to not only allow COLOR codes (`1, `2, `3 etc) but
'** ALSO ansi support. So this routine could be used to print ANSI-code
'** strings as well! It's probably not "optimized" as well as it could be,
'** but it works! It's main purpose is to simplify the QuickBASIC printing
'** of colors. The code "COLOR 14: print "TEST ";:COLOR 9:print "COLORS!";
'** could be simplified as "Oprint "`$TEST `9COLORS!" -- in fact, there are
'** color codes for all foreground, background, and flashing so entire ANSI
'** pictures can be "emulated" in color codes -- but it has been modified to
'** also accept ANSI-encoded strings as well. :)

END SUB

DEFSNG A-Z
SUB Paus

IF nolag = 1 THEN EXIT SUB
J! = TIMER
DO WHILE ABS(TIMER - J) < .001: LOOP

END SUB

DEFINT A-Z
FUNCTION RemoveColor$ (b$)

FOR x = 1 TO LEN(b$)
    IF MID$(b$, x, 1) = "`" THEN
        MID$(b$, x, 1) = CHR$(1)
        IF x < LEN(b$) THEN MID$(b$, x + 1, 1) = CHR$(1)
    END IF
NEXT x
bs0$ = ""
FOR x = 1 TO LEN(b$)
    IF MID$(b$, x, 1) <> CHR$(1) THEN bs0$ = bs0$ + MID$(b$, x, 1)
NEXT x
RemoveColor$ = bs0$: bs0$ = ""
END FUNCTION

FUNCTION TextYesNo (Text$, which)

Oprint "`2" + Text$
t$ = UCASE$(KbIn$(1, "", "%", 0))
'ClearLine

IF which = 1 THEN
    IF t$ = "Y" THEN TextYesNo = 1: GOTO TExtYNOut
END IF
IF which = 2 THEN
    TextYesNo = VAL(t$): GOTO TExtYNOut
END IF
IF which = 3 THEN
    IF t$ = "q" OR t$ = "Q" THEN TextYesNo = 1: GOTO TExtYNOut
    IF t$ = "u" OR t$ = "U" THEN TextYesNo = 2: GOTO TExtYNOut
    IF t$ = "r" OR t$ = "R" THEN TextYesNo = 3: GOTO TExtYNOut
    IF t$ = "s" OR t$ = "S" THEN TextYesNo = 4: GOTO TExtYNOut
END IF

TextYesNo = 0
TExtYNOut: ClearLine
END FUNCTION