DEFINT A-Z

DECLARE SUB esleep (waitval!)
DECLARE SUB PicLoad (a$, WhichType)
DECLARE FUNCTION GetPicNum (a$)
DECLARE FUNCTION RemoveColor$ (b$)
DECLARE SUB Oprint (a$)
DECLARE FUNCTION MouseY ()
DECLARE FUNCTION MouseX ()
DECLARE SUB GetMousePix ()
DECLARE FUNCTION CheckHiLite% ()
DECLARE SUB DrawMousePix ()
DECLARE SUB PutMousePix ()
DECLARE SUB ShowArray (Style%, WhichArray%)
DECLARE SUB CreateArray (text$, ml%, WhichArray%, StartOver%)
DECLARE FUNCTION GetScrollTopY% (Which%)
DECLARE FUNCTION GetScrollBotY% (Which%)
DECLARE SUB ShowScrollbar (Which%)
DECLARE FUNCTION CheckArrow$ (selected%, b$)

CONST MAXARRAYSIZE = 60
CONST ROOMPICS = 43

DECLARE SUB GPrint (text$, TX, TY, Col)

'**** Declaration for palette routines ********
TYPE PaletteType
Red AS INTEGER
Green AS INTEGER
Blue AS INTEGER
END TYPE

'************************ functions for palette routines ************
DECLARE SUB FadeIn ()
DECLARE SUB FadeOut ()
DECLARE SUB PaletteSet (nColor%, pInfo AS ANY)
DECLARE SUB PaletteGet (nColor%, pInfo AS ANY)
DECLARE SUB PalLoad (a$)
DECLARE SUB loadfil (b$, pixelno)

'*********************************** data for palette routines ******
DIM SHARED Pal AS PaletteType
DIM SHARED pData(0 TO 255, 1 TO 3)
'********************************************************************

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$

'****** Variables for the Scrolling Box #1
DIM SHARED ScrollArray(MAXARRAYSIZE, 1 TO 2) AS STRING * 96
DIM SHARED box1(9640) AS INTEGER     'For Graphic Image
DIM SHARED ArrayMax(2) AS INTEGER
DIM SHARED TopLine(2) AS INTEGER
DIM SHARED ScrollTopY(2) AS INTEGER
DIM SHARED ScrollBotY(2) AS INTEGER

SUB AddLine (WhichArray, text$, ResetColors)

IF WhichArray = 1 THEN Wid = Box1Size: ml = 13
IF WhichArray = 2 THEN Wid = Box2Size: ml = 8

IF TextMode = 0 THEN
    IF ResetColors > 0 THEN
        FOR x1 = 1 TO ArrayMax(WhichArray)
            IF LEFT$(ScrollArray(x1, WhichArray), 2) = "`%" THEN
                ScrollArray(x1, WhichArray) = "`7" + RIGHT$(ScrollArray(x1, WhichArray), LEN(ScrollArray(x1, WhichArray)) - 2)
            END IF
        NEXT x1
    END IF
    IF LEFT$(text$, 2) = "`!" THEN
        CreateArray "`!" + RemoveColor$(text$), Wid, WhichArray, 0
        TopLine(WhichArray) = ArrayMax(WhichArray) - (ml - 1)
        IF TopLine(WhichArray) < 1 THEN TopLine(WhichArray) = 1
    ELSE
        CreateArray "`%" + RemoveColor$(text$), Wid, WhichArray, 0
        TopLine(WhichArray) = ArrayMax(WhichArray) - (ml - 1)
        IF TopLine(WhichArray) < 1 THEN TopLine(WhichArray) = 1
        ShowArray 0, WhichArray
    END IF
ELSE
    CreateArray text$, Wid, WhichArray, 1
    ShowArray 0, WhichArray
END IF
END SUB

FUNCTION CheckHiLite

IF MouseX >= 147 AND MouseY >= 14 AND MouseX <= 319 AND MouseY <= 115 THEN
    CheckHiLite = 1: EXIT FUNCTION
END IF
IF MouseX >= 0 AND MouseY >= 117 AND MouseX <= 319 AND MouseY <= 183 THEN
    CheckHiLite = 2: EXIT FUNCTION
END IF
IF MouseX >= 0 AND MouseY >= 185 AND MouseX <= 319 AND MouseY <= 199 THEN
    CheckHiLite = 3: EXIT FUNCTION
END IF

CheckHiLite = 0
 
END FUNCTION

SUB CreateArray (b$, ml, WhichArray, StartOver)

IF StartOver > 0 THEN ArrayMax(WhichArray) = 0

HiLiteAll$ = ""
IF LEFT$(b$, 2) = "`%" THEN HiLiteAll$ = "`%"
IF LEFT$(b$, 2) = "`!" THEN HiLiteAll$ = "`!"

ct = 0: sp = 0
z1 = LEN(b$)
FOR x1 = 1 TO z1
    IF MID$(b$, x1, 1) = " " THEN sp = x1
    IF MID$(b$, x1, 1) = "`" THEN
        x1 = x1 + 1
    ELSE
        IF MID$(b$, x1, 1) <> CHR$(13) THEN
            ct = ct + 1
        ELSE
            ct = 0: sp = 0
        END IF
        IF ct >= ml AND x1 < z1 THEN 'ready to line wrap only if there is more to print.
            MID$(b$, sp, 1) = CHR$(13) 'Insert a carriage return
            'and now back up to where we left off
            x1 = sp + 1: ct = 0: sp = 0
        END IF
    END IF
NEXT x1

x1 = INSTR(b$, CHR$(13))
WHILE x1 > 0
    ArrayMax(WhichArray) = ArrayMax(WhichArray) + 1
    IF ArrayMax(WhichArray) > MAXARRAYSIZE THEN
        FOR y = 2 TO MAXARRAYSIZE
            ScrollArray(y - 1, WhichArray) = ScrollArray(y, WhichArray)
        NEXT y
        ArrayMax(WhichArray) = ArrayMax(WhichArray) - 1
    END IF
    ScrollArray$(ArrayMax(WhichArray), WhichArray) = HiLiteAll$ + LEFT$(b$, x1 - 1)
    b$ = RIGHT$(b$, LEN(b$) - x1)
    x1 = INSTR(b$, CHR$(13))
WEND

IF LEN(b$) > 0 THEN
    ArrayMax(WhichArray) = ArrayMax(WhichArray) + 1
    IF ArrayMax(WhichArray) > MAXARRAYSIZE THEN
        FOR y = 2 TO MAXARRAYSIZE
            ScrollArray(y - 1, WhichArray) = ScrollArray(y, WhichArray)
        NEXT y
        ArrayMax(WhichArray) = ArrayMax(WhichArray) - 1
    END IF
    ScrollArray(ArrayMax(WhichArray), WhichArray) = HiLiteAll$ + b$
END IF

TopLine(WhichArray) = 1

END SUB

SUB FadeIn

DIM tT(1 TO 3)
FOR i = 1 TO 64
WAIT &H3DA, 8, 8
  FOR o = 0 TO 255
    PaletteGet o, Pal
    tT(1) = Pal.Red
    tT(2) = Pal.Green
    tT(3) = Pal.Blue
    IF tT(1) < pData(o, 1) THEN tT(1) = tT(1) + 1
    IF tT(2) < pData(o, 2) THEN tT(2) = tT(2) + 1
    IF tT(3) < pData(o, 3) THEN tT(3) = tT(3) + 1
    Pal.Red = tT(1)
    Pal.Green = tT(2)
    Pal.Blue = tT(3)
    PaletteSet o, Pal
  NEXT o
NEXT i

END SUB

SUB FadeOut

DIM tT(1 TO 3)
FOR i = 0 TO 255
  PaletteGet i, Pal
  pData(i, 1) = Pal.Red
  pData(i, 2) = Pal.Green
  pData(i, 3) = Pal.Blue
NEXT i
FOR i = 1 TO 64
WAIT &H3DA, 8, 8
  FOR o = 0 TO 255
    PaletteGet o, Pal
    tT(1) = Pal.Red
    tT(2) = Pal.Green
    tT(3) = Pal.Blue
    IF tT(1) > 0 THEN tT(1) = tT(1) - 1
    IF tT(2) > 0 THEN tT(2) = tT(2) - 1
    IF tT(3) > 0 THEN tT(3) = tT(3) - 1
    Pal.Red = tT(1)
    Pal.Green = tT(2)
    Pal.Blue = tT(3)
    PaletteSet o, Pal
  NEXT o
NEXT i

END SUB

FUNCTION GetScrollBotY (WhichArray)
GetScrollBotY = ScrollBotY(WhichArray)
END FUNCTION

FUNCTION GetScrollTopY (WhichArray)
GetScrollTopY = ScrollTopY(WhichArray)
END FUNCTION

' by Ken Rockot (Insane7773@aol.com)
SUB GPrint (a$, TX, TY, Col)

IF TextMode <> 0 THEN EXIT SUB
IF AllUpper > 0 THEN a$ = UCASE$(a$)

IF LEFT$(a$, 1) = "`" THEN b$ = LEFT$(a$, 2) ELSE b$ = ""
a$ = RemoveColor$(a$)
IF b$ = "`%" THEN Col = 255
IF b$ = "`!" THEN Col = 254
IF b$ = "`7" THEN Col = 247

keepx = TX

'IF ml > 0 THEN 'Format string for multicolumn printing.
'    ct = 0: sp = 0
'    FOR x = 1 TO LEN(a$)
'        IF MID$(a$, x, 1) = " " THEN sp = x
'        ct = ct + 1
'        IF ct >= ml THEN 'ready to line wrap
'            MID$(a$, sp, 1) = CHR$(13) 'Insert a carriage return
'            'and now back up to where we left off
'            x = sp + 1: ct = 0: sp = 0
'        END IF
'    NEXT x
'END IF

DEF SEG = VARSEG(Fbuff)
FOR c = 1 TO LEN(a$)
   IF MID$(a$, c, 1) = CHR$(13) THEN
       TX = keepx
       TY = TY + 7
   ELSE
       'Ptr! = 35 * (ASC(MID$(a$, c, 1)))
       Ptr = 35 * (ASC(MID$(a$, c, 1)))
       'Ptr = 0
       FOR y = 0 TO 6
          FOR x = 0 TO 4
             'Clr = PEEK(VARPTR(Fbuff) + Ptr!)
             Clr = PEEK(VARPTR(Fbuff) + Ptr)
             'Clr = PEEK(VARPTR(Fbuff) + (35 * (ASC(MID$(a$, c, 1)))) + Ptr)
             'Ptr! = Ptr! + 1
             Ptr = Ptr + 1
             IF Clr THEN PSET (x + TX, y + TY), Col
          NEXT x
       NEXT y
       TX = TX + 6
   END IF
NEXT c
END SUB

SUB HiLite (SelectedArea, SetOn)

IF SelectedArea = 1 THEN
    IF SetOn = 0 THEN
        LINE (147, 14)-(319, 115), 248, B
        LINE (148, 15)-(318, 114), 247, B
    ELSE
        LINE (147, 14)-(319, 115), 255, B
        LINE (148, 15)-(318, 114), 255, B
    END IF
END IF

IF SelectedArea = 2 THEN
    IF SetOn = 0 THEN
        LINE (0, 117)-(319, 183), 248, B
        LINE (1, 118)-(318, 182), 247, B
    ELSE
        LINE (0, 117)-(319, 183), 255, B
        LINE (1, 118)-(318, 182), 255, B
    END IF
END IF

IF SelectedArea = 3 THEN
    IF SetOn = 0 THEN
        LINE (0, 185)-(319, 199), 248, B
        LINE (1, 186)-(318, 198), 247, B
    ELSE
        LINE (0, 185)-(319, 199), 255, B
        LINE (1, 186)-(318, 198), 255, B
    END IF
END IF
END SUB

SUB loadfil (b$, pixelno)

b$ = "bsvs\" + b$ + ".bsv"
DEF SEG = &HA000
BLOAD b$, pixelno
DEF SEG
END SUB

SUB LoadFonts

OPEN "LUNATIX2.DAT" FOR BINARY SHARED AS #2
GET #2, , Fbuff
CLOSE #2

END SUB

SUB PaletteGet (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C7, nColor%
pInfo.Red = INP(&H3C9)
pInfo.Green = INP(&H3C9)
pInfo.Blue = INP(&H3C9)

END SUB

SUB PaletteSet (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C8, nColor%
OUT &H3C9, pInfo.Red
OUT &H3C9, pInfo.Green
OUT &H3C9, pInfo.Blue

END SUB

DEFSNG A-Z
SUB PalLoad (a$)
DIM Pal2(255, 2)

a$ = "pals\" + a$ + ".pal"

OPEN a$ FOR RANDOM SHARED AS #2 LEN = 6
FIELD #2, 6 AS s$
FOR l = 0 TO 255
    GET #2, l + 1
    Pal2(l, 0) = INT(VAL(MID$(s$, 1, 2)))
    Pal2(l, 1) = INT(VAL(MID$(s$, 3, 2)))
    Pal2(l, 2) = INT(VAL(MID$(s$, 5, 2)))
  
    OUT &H3C8, l
    OUT &H3C9, Pal2(l, 0)
    OUT &H3C9, Pal2(l, 1)
    OUT &H3C9, Pal2(l, 2)
NEXT l

CLOSE #2
END SUB

DEFINT A-Z
SUB PicLoad (a$, WhichType)
DIM Pal2(255, 2) AS INTEGER

IF TextMode <> 0 THEN EXIT SUB

FontRecs = 35 'How many records at the top of the file are fonts? (Skip them)
FieldSize = 256: RecsPerFile = 61: RecsPerPal = 6: RecsPerBsv = 250

IF WhichType = 1 THEN
    WhichPic = GetPicNum(a$)
    LINE (3, 3)-(142, 112), 0, BF
ELSE
    WhichPic = VAL(a$)
    FadeOut
    CLS
END IF

OPEN "LUNATIX2.DAT" FOR RANDOM SHARED AS #2 LEN = FieldSize
o = 0: l = 0
FIELD #2, 256 AS b$
FOR x = 1 TO RecsPerPal
    IF WhichType = 1 THEN
        GET #2, ((WhichPic - 1) * (RecsPerFile + RecsPerPal)) + FontRecs + x
    ELSE
        BaseOffset = (ROOMPICS * (RecsPerFile + RecsPerPal)) + FontRecs
        BaseOffset = BaseOffset + (WhichPic - 1) * (RecsPerBsv + RecsPerPal)
        GET #2, BaseOffset + x
    END IF
    FOR y = 1 TO LEN(b$) STEP 2
        Pal2(l, o) = INT(VAL(MID$(b$, y, 2)))
        o = o + 1
        IF o > 2 THEN
            OUT &H3C8, l
            OUT &H3C9, Pal2(l, 0)
            OUT &H3C9, Pal2(l, 1)
            OUT &H3C9, Pal2(l, 2)
            o = 0: l = l + 1
        END IF
    NEXT y
NEXT x

IF WhichType = 1 THEN
    OPEN "temp.pic" FOR OUTPUT SHARED AS #3
    FOR y = 1 TO RecsPerFile
        GET #2, ((WhichPic - 1) * (RecsPerFile + RecsPerPal)) + RecsPerPal + FontRecs + y
        IF y < RecsPerFile THEN
            PRINT #3, b$;
        ELSE
            PRINT #3, LEFT$(b$, 51);
        END IF
    NEXT y
    CLOSE #2: CLOSE #3
    DEF SEG = VARSEG(box1(0))
    BLOAD "temp.pic", VARPTR(box1(0))
    DEF SEG
    PUT (3, 3), box1, PSET
END IF

IF WhichType = 2 THEN
    FadeOut
    OPEN "temp.pic" FOR OUTPUT SHARED AS #3
    PRINT #3, CHR$(253) + CHR$(0) + CHR$(160) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(250);
    BaseOffset = (ROOMPICS * (RecsPerFile + RecsPerPal)) + RecsPerPalFile + FontRecs
    BaseOffset = BaseOffset + (WhichPic - 1) * (RecsPerBsv + RecsPerPal) + RecsPerPal
    FOR y = 1 TO RecsPerBsv
        GET #2, BaseOffset + y
        PRINT #3, b$;
    NEXT y
    CLOSE #2: CLOSE #3

    DEF SEG = &HA000
    BLOAD "temp.pic", 0
    DEF SEG
END IF

KILL "temp.pic"

END SUB

SUB ShowArray (Style, WhichArray)

IF TextMode <> 0 THEN
    IF Style = 0 THEN
        FOR x1 = 1 TO ArrayMax(WhichArray)
            IF AllUpper > 0 THEN
                Oprint UCASE$(RTRIM$(ScrollArray$(x1, WhichArray))) + CHR$(13)
            ELSE
                Oprint RTRIM$(ScrollArray$(x1, WhichArray)) + CHR$(13)
            END IF
        NEXT x1
    END IF
    EXIT SUB
END IF

IF WhichArray = 1 THEN
    BOXCOLOR = 1
    LEFTX = 152: TOPY = 19: BOTY = 103
    FitLines = 13: FontColor = 8
ELSE
    BOXCOLOR = 0
    LEFTX = 5: TOPY = 122: BOTY = 171
    FitLines = 8: FontColor = 247
END IF

'style-0 = Refresh Entire Display
'style-1 = Down 1 line (box goes up)

IF Style = 3 THEN
    IF TopLine(WhichArray) + (FitLines - 1) < ArrayMax(WhichArray) THEN
        TopLine(WhichArray) = TopLine(WhichArray) + FitLines
        IF TopLine(WhichArray) + (FitLines - 1) > ArrayMax(WhichArray) THEN
            TopLine(WhichArray) = ArrayMax(WhichArray) - (FitLines - 1)
            IF TopLine(WhichArray) < 1 THEN TopLine(WhichArray) = 1
        END IF
        Style = 0
    ELSE
        EXIT SUB
    END IF
END IF

IF Style = 4 THEN
    IF TopLine(WhichArray) > 1 THEN
        TopLine(WhichArray) = TopLine(WhichArray) - FitLines
        IF TopLine(WhichArray) < 1 THEN TopLine(WhichArray) = 1
        Style = 0
    ELSE
        EXIT SUB
    END IF
END IF

IF TopLine(WhichArray) + (FitLines - 1) > ArrayMax(WhichArray) THEN
    LastLine = ArrayMax(WhichArray)
ELSE
    LastLine = TopLine(WhichArray) + (FitLines - 1)
END IF

IF Style = 1 THEN
    IF TopLine(WhichArray) + (FitLines - 1) < ArrayMax(WhichArray) THEN
        GET (LEFTX - 2, TOPY + 5)-(308, BOTY + 9), box1
        PUT (LEFTX - 2, TOPY - 2), box1, PSET
        LINE (LEFTX - 2, BOTY + 1)-(308, BOTY + 9), BOXCOLOR, BF'Block out the bottom row
        LINE (LEFTX - 2, TOPY - 2)-(308, TOPY - 1), BOXCOLOR, BF'Block out 2 lines on top
        TopLine(WhichArray) = TopLine(WhichArray) + 1
        GPrint RTRIM$(ScrollArray$(TopLine(WhichArray) + (FitLines - 1), WhichArray)), (LEFTX), (BOTY), FontColor
        ShowScrollbar WhichArray
    END IF
    EXIT SUB
END IF

IF Style = 2 THEN
    IF TopLine(WhichArray) > 1 THEN
        GET (LEFTX - 2, TOPY - 2)-(308, BOTY + 2), box1
        PUT (LEFTX - 2, TOPY + 5), box1, PSET
        LINE (LEFTX - 2, TOPY - 2)-(308, TOPY + 4), BOXCOLOR, BF'Block out the top row
        LINE (LEFTX - 2, BOTY + 7)-(308, BOTY + 9), BOXCOLOR, BF'Block out bottom 3 lines
        TopLine(WhichArray) = TopLine(WhichArray) - 1
        GPrint RTRIM$(ScrollArray$(TopLine(WhichArray), WhichArray)), (LEFTX), (TOPY), FontColor
        ShowScrollbar WhichArray
    END IF
    EXIT SUB
END IF

IF Style = 0 THEN
    LINE (LEFTX - 2, TOPY - 2)-(308, BOTY + 9), BOXCOLOR, BF
    FOR x = TopLine(WhichArray) TO LastLine
        GPrint RTRIM$(ScrollArray$(x, WhichArray)), (LEFTX), (TOPY), FontColor
        TOPY = TOPY + 7
    NEXT x
    ShowScrollbar WhichArray
    EXIT SUB
END IF

END SUB

SUB ShowScrollbar (WhichArray)

IF WhichArray = 1 THEN
    yz = 25: yq = 104
    FitLines = 13
END IF
IF WhichArray = 2 THEN
    yz = 128: yq = 172
    FitLines = 8
END IF
y3 = yq - yz 'Max Pixels we're dealing with here!

'** Now do some MATH to figure out the SIZE of the BLOCK to make!!!

IF ArrayMax(WhichArray) > 0 THEN
    x = ((TopLine(WhichArray) - 1) * y3) / ArrayMax(WhichArray)
ELSE
    x = (TopLine(WhichArray) - 1) * y3
END IF
y1 = yz + x

IF ArrayMax(WhichArray) > 0 THEN
    y = (FitLines * y3) / ArrayMax(WhichArray)
ELSE
    y = FitLines * y3
END IF
IF y > y3 THEN y = y3
IF TopLine(WhichArray) + (FitLines - 1) >= ArrayMax(WhichArray) THEN
    y2 = yq
ELSE
    y2 = y1 + y - 1
END IF

LINE (310, yz)-(316, yq), 248, BF 'Erase the entire block.
LINE (310, y1)-(316, y2), 7, BF
LINE (310, y1)-(316, y1), 255
LINE (310, y1)-(310, y2), 255
LINE (311, y2)-(316, y2), 248
LINE (316, y1 + 1)-(316, y2), 248
'** draw a black line above and below it!
LINE (310, y1 - 1)-(316, y1 - 1), 0
LINE (310, y2 + 1)-(316, y2 + 1), 0

'** Store values for our Mouse Scrolling Routine!
ScrollTopY(WhichArray) = y1 - 2
ScrollBotY(WhichArray) = y2 + 2

END SUB