DEFINT A-Z
'
' This program is used to create the LUNATIX2.DAT file!
'
' GIF concatenation program.
' Based on a program by James Kurth.
' With code from qbasic.com for the GIF loader.
'
DECLARE SUB ConvertPic (a$, Which)
DECLARE SUB MakePalFile (PalFile$, Which)
DECLARE SUB gifload (a$)

DIM SHARED pal(255, 2) AS INTEGER
DIM SHARED put$(255, 2)
DIM SHARED box1(7701) AS INTEGER

DIM SHARED Resource$
DIM SHARED FBuff(0) AS STRING * 8960 'For Fonts

Resource$ = "LUNATIX2.DAT"

SCREEN 13

'*** FIRST THINGS FIRST -- let's place the FONTS at the beginning of the file!
'OPEN "lunatix.fnt" FOR BINARY AS 1
OPEN "example.fnt" FOR BINARY AS 1
GET #1, , FBuff(0)
CLOSE #1
OPEN Resource$ FOR OUTPUT SHARED AS #1
    PRINT #1, FBuff(0);
CLOSE #1

'*** Now, let's convert all the 140x110 picture images!

ConvertPic "ExitDoor", 1
ConvertPic "BathRoom", 1
ConvertPic "Author", 1
ConvertPic "OddWard1", 1
ConvertPic "constr", 1
ConvertPic "hottub", 1
ConvertPic "hall5", 1
ConvertPic "hall2", 1
ConvertPic "hall3", 1
ConvertPic "lab2", 1
ConvertPic "Pipes", 1
ConvertPic "Fans", 1
ConvertPic "hall1", 1
ConvertPic "MeetRoom", 1
ConvertPic "Office1", 1
ConvertPic "CAFLADY", 1
ConvertPic "CAFE", 1
ConvertPic "CHAIR1", 1
ConvertPic "GUARD", 1
ConvertPic "HALLWAY4", 1
ConvertPic "CLOSET", 1
ConvertPic "ESC_DOOR", 1
ConvertPic "ELEVATOR", 1
ConvertPic "KANDI", 1
ConvertPic "TODD", 1
ConvertPic "NAPOL-1", 1
ConvertPic "SOCRAT-1", 1
ConvertPic "GROUNDS", 1
ConvertPic "ROOM1-10", 1
ConvertPic "ROOM1-4", 1
ConvertPic "ROOM1-5", 1
ConvertPic "ROOM1-6", 1
ConvertPic "ROOM1-7", 1
ConvertPic "ROOM1-8", 1
ConvertPic "ROOM1-9", 1
ConvertPic "CLOSET2", 1
ConvertPic "CLOSET3", 1
ConvertPic "hall6", 1
ConvertPic "hall7", 1
ConvertPic "escdoor2", 1
ConvertPic "OddWard2", 1
ConvertPic "Goats2", 1
ConvertPic "ExitDor2", 1

ConvertPic "Title3", 2
ConvertPic "PlayArea", 2
ConvertPic "Title", 2
ConvertPic "Title2", 2
ConvertPic "Winner", 2

END

SUB ConvertPic (a$, Which)

file$ = "gifs\" + a$ + ".gif"
'PalFile$ = "pals\" + a$ + ".pal"
'SavFile$ = "bsvs\" + a$ + ".bsv"
'PicFile$ = "pics\" + a$ + ".pic"
PalFile$ = a$ + ".pal"
SavFile$ = a$ + ".bsv"
PicFile$ = a$ + ".pic"
pixelx! = 0
pixely! = 0
IF Which = 1 THEN
    pixelex! = 139
    pixeley! = 109
ELSE
    pixelex! = 319
    pixeley! = 199
END IF

pixelstart! = pixelx! + (pixely! * 320)
pixelend! = pixelex! + (pixeley! * 320)

CLS
DEF SEG = &HA000
gifload file$
REM SLEEP 1

'*** Special instance for "playarea.gif"
IF UCASE$(a$) = "PLAYAREA" THEN
    FOR x = 0 TO 319
        FOR y = 0 TO 199
            IF POINT(x, y) = 10 THEN
                PSET (x, y), 255
            END IF
        NEXT
    NEXT
END IF

' BSAVE file starting at pixel# <pixels> through pixel# <pixelend>
IF Which = 2 THEN
    BSAVE SavFile$, pixelstart!, pixelend! + 1
END IF
DEF SEG

'**** Now save a PALETTE FILE
MakePalFile PalFile$, Which

'**** Now save it as a PIC file!

IF Which = 1 THEN
    GET (0, 0)-(139, 109), box1
    DEF SEG = VARSEG(box1(0))
    BSAVE PicFile$, VARPTR(box1(0)), 15404
    DEF SEG

    OPEN PicFile$ FOR RANDOM SHARED AS #1 LEN = 256
    FIELD #1, 256 AS b$
    OPEN Resource$ FOR APPEND SHARED AS #2
    FOR y = 1 TO 61
        GET #1, y
        IF y < 61 THEN
            PRINT #2, b$;
        ELSE
            PRINT #2, LEFT$(b$, 51);
            PRINT #2, STRING$(205, "*"); 'filler space!
        END IF
    NEXT y
    CLOSE #1: CLOSE #2
    KILL PicFile$
END IF

IF Which = 2 THEN
    OPEN SavFile$ FOR RANDOM SHARED AS #1 LEN = 256
    FIELD #1, 256 AS b$
    OPEN Resource$ FOR APPEND SHARED AS #2
    FOR y = 1 TO 251
        GET #1, y
        IF y = 1 THEN PRINT #2, RIGHT$(b$, LEN(b$) - 7);
        IF y = 251 THEN PRINT #2, LEFT$(b$, 7);
        IF y > 1 AND y < 251 THEN PRINT #2, b$;
    NEXT y
    CLOSE #1: CLOSE #2
    KILL SavFile$
END IF

END SUB

DEFSNG A-Z
SUB gifload (a$)
DEFINT A-Z
DIM Prefix(4095), Suffix(4095), OutStack(4095), shiftout%(8)
DIM Ybase AS LONG, powersof2(11) AS LONG, WorkCode AS LONG

FOR a% = 0 TO 7: shiftout%(8 - a%) = 2 ^ a%: NEXT a%
FOR a% = 0 TO 11: powersof2(a%) = 2 ^ a%: NEXT a%
IF a$ = "" THEN INPUT "GIF file"; a$: IF a$ = "" THEN END
IF INSTR(a$, ".") = 0 THEN a$ = a$ + ".gif"
OPEN a$ FOR BINARY AS #1
a$ = "      ": GET #1, , a$
IF a$ <> "GIF87a" THEN PRINT "Not a GIF87a file.": END
GET #1, , TotalX: GET #1, , TotalY: GOSUB GetByte
NumColors = 2 ^ ((a% AND 7) + 1): NoPalette = (a% AND 128) = 0
GOSUB GetByte: Background = a%
GOSUB GetByte: IF a% <> 0 THEN PRINT "Bad screen descriptor.": END
IF NoPalette = 0 THEN P$ = SPACE$(NumColors * 3): GET #1, , P$
DO
    GOSUB GetByte
    IF a% = 44 THEN
        EXIT DO
    ELSEIF a% <> 33 THEN
        PRINT "Unknown extension type.": END
    END IF
    GOSUB GetByte
    DO: GOSUB GetByte: a$ = SPACE$(a%): GET #1, , a$: LOOP UNTIL a% = 0
LOOP
GET #1, , XStart: GET #1, , YStart: GET #1, , XLength: GET #1, , YLength
XEnd = XStart + XLength: YEnd = YStart + YLength: GOSUB GetByte
IF a% AND 128 THEN PRINT "Can't handle local colormaps.": END
Interlaced = a% AND 64: PassNumber = 0: PassStep = 8
GOSUB GetByte
ClearCode = 2 ^ a%
EOSCode = ClearCode + 1
FirstCode = ClearCode + 2: NextCode = FirstCode
StartCodeSize = a% + 1: CodeSize = StartCodeSize
StartMaxCode = 2 ^ (a% + 1) - 1: MaxCode = StartMaxCode

BitsIn = 0: BlockSize = 0: BlockPointer = 1
x% = XStart: y% = YStart: Ybase = y% * 320&

' Screen 13 went here
DEF SEG = &HA000
IF NoPalette = 0 THEN
    OUT &H3C7, 0: OUT &H3C8, 0
    FOR a% = 1 TO NumColors * 3: OUT &H3C9, ASC(MID$(P$, a%, 1)) \ 4: NEXT a%
END IF

LINE (0, 0)-(319, 199), Background, BF
DO
    GOSUB GetCode
    IF Code <> EOSCode THEN
        IF Code = ClearCode THEN
            NextCode = FirstCode
            CodeSize = StartCodeSize
            MaxCode = StartMaxCode
            GOSUB GetCode
            CurCode = Code: LastCode = Code: LastPixel = Code
            IF x% < 320 THEN POKE x% + Ybase, LastPixel
            x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine
        ELSE
            CurCode = Code: StackPointer = 0
            IF Code > NextCode THEN EXIT DO
            IF Code = NextCode THEN
                CurCode = LastCode
                OutStack(StackPointer) = LastPixel
                StackPointer = StackPointer + 1
            END IF

            DO WHILE CurCode >= FirstCode
                OutStack(StackPointer) = Suffix(CurCode)
                StackPointer = StackPointer + 1
                CurCode = Prefix(CurCode)
            LOOP

            LastPixel = CurCode
            IF x% < 320 THEN POKE x% + Ybase, LastPixel
           
            x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine

            FOR a% = StackPointer - 1 TO 0 STEP -1
                IF x% < 320 THEN POKE x% + Ybase, OutStack(a%)
                x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine
            NEXT a%

            IF NextCode < 4096 THEN
                Prefix(NextCode) = LastCode
                Suffix(NextCode) = LastPixel
                NextCode = NextCode + 1
                IF NextCode > MaxCode AND CodeSize < 12 THEN
                    CodeSize = CodeSize + 1
                    MaxCode = MaxCode * 2 + 1
                END IF
            END IF
            LastCode = Code
        END IF
    END IF
LOOP UNTIL DoneFlag OR Code = EOSCode
CLOSE #1
EXIT SUB

GetByte: a$ = " ": GET #1, , a$: a% = ASC(a$): RETURN

NextScanLine:
    IF Interlaced THEN
        y% = y% + PassStep
        IF y% >= YEnd THEN
            PassNumber = PassNumber + 1
            SELECT CASE PassNumber
            CASE 1: y% = 4: PassStep = 8
            CASE 2: y% = 2: PassStep = 4
            CASE 3: y% = 1: PassStep = 2
            END SELECT
        END IF
    ELSE
        y% = y% + 1
    END IF
    x% = XStart: Ybase = y% * 320&: DoneFlag = y% > 199
RETURN
GetCode:
    IF BitsIn = 0 THEN GOSUB ReadBufferedByte: LastChar = a%: BitsIn = 8
    WorkCode = LastChar \ shiftout%(BitsIn)
    DO WHILE CodeSize > BitsIn
        GOSUB ReadBufferedByte: LastChar = a%
        WorkCode = WorkCode OR LastChar * powersof2(BitsIn)
        BitsIn = BitsIn + 8
    LOOP
    BitsIn = BitsIn - CodeSize
    Code = WorkCode AND MaxCode
RETURN
ReadBufferedByte:
    IF BlockPointer > BlockSize THEN
        GOSUB GetByte: BlockSize = a%
        a$ = SPACE$(BlockSize): GET #1, , a$
        BlockPointer = 1
    END IF
    a% = ASC(MID$(a$, BlockPointer, 1)): BlockPointer = BlockPointer + 1
RETURN

END SUB

SUB MakePalFile (PalFile$, Which)

'IF which = 1 THEN
    OPEN Resource$ FOR APPEND SHARED AS #1
'ELSE
'    OPEN PalFile$ FOR OUTPUT AS #1
'END IF
FOR l = 0 TO 255
OUT &H3C7, l
pal(l, 0) = INP(&H3C9)
pal(l, 1) = INP(&H3C9)
pal(l, 2) = INP(&H3C9)
q$ = STR$(pal(l, 0))
r$ = STR$(pal(l, 1))
s$ = STR$(pal(l, 2))
IF pal(l, 0) < 10 THEN q$ = "0" + MID$(STR$(pal(l, 0)), 2, 1)
IF pal(l, 1) < 10 THEN r$ = "0" + MID$(STR$(pal(l, 1)), 2, 1)
IF pal(l, 2) < 10 THEN s$ = "0" + MID$(STR$(pal(l, 2)), 2, 1)
'PRINT #1, q$; " "; r$; " "; s$
PRINT #1, LTRIM$(q$); LTRIM$(r$); LTRIM$(s$);
NEXT l
CLOSE #1

END SUB

DEFSNG A-Z
SUB wipeout
FOR l = 0 TO 255
OUT &H3C8, l
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT l
END SUB