A Gif decoder/p1

 BBS: Inland Empire Archive
Date: 11-23-92 (22:35)             Number: 282
From: RICH GELDREICH               Refer#: NONE
  To: HARVEY PARISIEN               Recvd: NO  
Subj: A Gif decoder/p1               Conf: (2) Quik_Bas

'Cheap, no frills GIF decompressor for the VGA's 320x200x256 mode.
'By Rich Geldreich 1992 (Public domain, use as you wish.)
'Sorry for no documentation, I wanted to crunch it to 150 lines...
DEFINT A-Z
DIM Prefix(4095), Suffix(4095), OutStack(4095), ShiftOut(8)

'The following line is for the QB environment(slow).
DIM Ybase AS LONG, Powersof2(11) AS LONG, WorkCode AS LONG
'For more speed, unremark the next line and remark the one above,
'before you compile... (Change back when inside the environment.)
'DIM Ybase AS INTEGER, Powersof2(11) AS INTEGER, WorkCode AS INTEGER

FOR A = 0 TO 7: ShiftOut(8 - A) = 2 ^ A: NEXT
FOR A = 0 TO 11: Powersof2(A) = 2 ^ A: NEXT
A$ = COMMAND$: 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: 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
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 'bad GIF if this happens
            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)
<<-to be continued on next message->>

--- MsgToss 2.0b
 * Origin: Computer Co-Op - Voorhees, NJ | Ted Hare (1:266/29)