Bload Compressor/2

 BBS: Inland Empire Archive
Date: 12-27-92 (06:20)             Number: 243
From: RICH GELDREICH               Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Bload Compressor/2             Conf: (2) Quik_Bas

'Page 2 of ENCODE13.BAS begins here.
REDIM image(32000): DEF SEG = VARSEG(image(0))
BLOAD "coolfile.bci", VARPTR(image(0)) 'Load the compressed data.

PRINT "Press a key to decompress.": B$ = INPUT$(1): SCREEN 13

'Call the asm routine to decompress the image.
Decom13 VARSEG(image(0)), VARPTR(image(0)): B$ = INPUT$(1)

'Compresses a SCREEN 13 image to a BLOADable file. Use the ASM sub
'Decom13 to decompress the image back to the screen. This routine
'currently crawls, because I didn't optimize it that much.
'The entire palette is also saved to the compressed file,
SUB Compress13 (F$)
    OPEN F$ FOR OUTPUT AS #1: CLOSE : OPEN F$ FOR BINARY AS #1
    'Store the BLOAD header and image signature.
    a$ = CHR$(&HFD) + CHR$(0) + CHR$(&HA0) + STRING$(4, 0) + "RG"
    PUT #1, , a$
    'Initialize a 4k disk output buffer
    IOBuffer$ = SPACE$(4096): IOPointer = 1
    CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0
    'Write the screen's palette.
    OUT &H3C7, 0: FOR a = 0 TO 767: WriteByte INP(&H3C9): NEXT

    DoneFlag = False: xl = 0: yl = 0: xh = 319: yh = 199
    xp = xl: yp = yl 'coordinate of next point to compress

    InitRingBuffer   'clear the ring buffer
    InitLZ77         'initialize the linked list pool
    'prime the look ahead buffer
    S = 0: R = BufferSize - MaxMatch
    FOR LookAheadLength = 0 TO MaxMatch - 1
        IF DoneFlag THEN
            EXIT FOR
        ELSE
            RingBuffer(R + LookAheadLength) = GetPixel
        END IF
    NEXT
    'find first string
    FindString R
    DO
        'if match too small(less than 3 chars), the just output
        'a single character
        IF Match.Length <= Threshold THEN
            OutputChar RingBuffer(R): Last.Match.Length = 1
        ELSE
            'output a string match token
            Last.Match.Length = Match.Length
            'Send  the match's distance,  instead of its position in
            'the ring buffer, because the decompressor is not using a
            'ring buffer to store the decompressed data.
            Match.Distance = (R - Match.Position) AND (BufferSize - 1)
            OutputMatch
        END IF
        'prime the look ahead buffer with more characters
        FOR a = 0 TO Last.Match.Length - 1
            IF DoneFlag THEN EXIT FOR 'exit this loop if no more chars
            'delete string at S, then store a new char at S
            DeleteString S: RingBuffer(S) = GetPixel
            'keep a "ghost buffer" at the end of the ring buffer to
            'avoid using a logical AND on all of our buffer pointers
            IF S < (MaxMatch - 1) THEN
                RingBuffer(S + BufferSize) = RingBuffer(S)
            END IF
            S = (S + 1) AND (BufferSize - 1)
            R = (R + 1) AND (BufferSize - 1)
            'if not last time through loop then just add string to the
            'linked list pool, otherwise add it and find a match
            '(this could be optimized so the IF/THEN conditional  is
            'removed from inside this loop)
            IF a = (Last.Match.Length - 1) THEN
                FindString R
            ELSE
                MakeString R
            END IF
        NEXT
        FOR a = a TO Last.Match.Length - 1
            'this loop is active when no more characters are available
            'from the input stream
            'Kill string at S, not sure if this is needed because
            'we're  not  storing any characters in its place. I see
            'no reason to do it,   but  this  is one of those little
            'quirks that all LZSS implementations I've seen have... ?

            DeleteString S
            S = (S + 1) AND (BufferSize - 1)
            R = (R + 1) AND (BufferSize - 1)
            LookAheadLength = LookAheadLength - 1
            IF LookAheadLength THEN
                IF a = (Last.Match.Length - 1) THEN
                    FindString R
                ELSE
'Continued on page 3

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