NOMAINWIN
 DIM LZW(1, 1)
 DIM JDlzw(1)
 DIM JDch$(1)
 LET maxBits = 20          ' maximum bit width of the dictionary: minimum=12; maximum=21
 LET resetDictionary = 1   ' flag to reset the dictionary when it gets full: 1=TRUE; 0=FALSE
 LET printDictionary = 0   ' output encoding and decoding dictionaries to files
 LET maxChunkSize = 2 ^ 14 ' maximum size of the data buffer
 LET dSize = 2 ^ maxBits   ' maximum dictionary size
 LET JDext$ = ".lzw"       ' file extension used for created archives
 FILEDIALOG "Select a file to test LZW...", "*.*", inputName$
 IF inputName$ = "" THEN END
 DO ' get fullPath\ and fileName.ext
    P = X
    X = INSTR(inputName$, "\", (X + 1))
 LOOP UNTIL X = 0
 filePath$ = LEFT$(inputName$, P)
 fileName$ = MID$(inputName$, (P + 1))
 DO ' get fileName and .ext
    P = X
    X = INSTR(fileName$, ".", (X + 1))
 LOOP UNTIL X = 0
 fileExt$ = MID$(fileName$, P)
 fileName$ = LEFT$(fileName$, (P - 1))

 GOSUB [lzwEncode]
 GOSUB [lzwDecode]

 END

''''''''''''''''''''''''''''''''''''''''
' Start LZW Encoder ''''''''''''''''''''
[lzwEncode]
 REDIM LZW(dSize, 4)
 LET EMPTY=-1:PREFIX=0:BYTE=1:FIRST=2:LESS=3:MORE=4:bmxCorrect=1
 LET bitsRemain=0:remainIndex=0:tagCount=0:currentBitSize=8:fileTag$=""
 FOR dNext = 0 TO 255                                       ' initialize dictionary for LZW
 '  LZW(dNext, PREFIX) = EMPTY                              ' prefix index of '<index>' <B>
 '  LZW(dNext, BYTE)   = dNext                              ' byte value of <index> '<B>'
    LZW(dNext, FIRST)  = EMPTY                              ' first index to use <index><B> as prefix
 '  LZW(dNext, LESS)   = EMPTY                              ' lesser index of binary search tree for <B>
 '  LZW(dNext, MORE)   = EMPTY                              ' greater index of binary search tree for <B>
 NEXT dNext
 OPEN inputName$ FOR INPUT AS #lzwIN
 IF LOF(#lzwIN) < 2 THEN
    CLOSE #lzwIN
    END
 END IF
 OPEN fileName$ + fileExt$ + JDext$ FOR OUTPUT AS #lzwOUT
 GOSUB [StartFileChunk]
 chnkPoint = 1
 IF maxBits < 12 THEN maxBits = 12
 IF maxBits > 21 THEN maxBits = 21
 settings = maxBits - 12                                    ' setting for dictionary size; 1st decimal +12
 IF resetDictionary THEN settings = settings + 100          ' setting for dictionary type; 2nd decimal even=static, odd=adaptive
 #lzwOUT, CHR$(settings);                                   ' save settings as 1st byte of output
 orgIndex = ASC(LEFT$(fileChunk$, 1))                       ' read 1st byte into <index>
 WHILE fileChunk$ <> ""                                     ' while the buffer is not empty
    DO                                                      ' begin the main encoder loop
        chnkPoint = chnkPoint + 1
        savIndex = FIRST                                    ' initialize the save-to index
        prvIndex = orgIndex                                 ' initialize the previous index in search
        newByte = ASC(MID$(fileChunk$, chnkPoint, 1))       ' read <B>
        dSearch = LZW(orgIndex, FIRST)                      ' first search index for this <index> in the dictionary
        WHILE (dSearch > EMPTY)                             ' while <index> is present in the dictionary
            IF LZW(dSearch, BYTE) = newByte THEN EXIT WHILE ' if <index><B> is found
            IF newByte < LZW(dSearch, BYTE) THEN            ' else if new <B> is less than <index><B>
                savIndex = LESS                             ' follow lesser binary tree
            ELSE
                savIndex = MORE                             ' else follow greater binary tree
            END IF
            prvIndex = dSearch                              ' set previous <index>
            dSearch = LZW(dSearch, savIndex)                ' read next search <index> from binary tree
        WEND
        IF dSearch = EMPTY THEN                             ' if <index><B> was not found in the dictionary
            GOSUB [WriteIndex]                              ' write <index> to the output
            IF dNext < dSize THEN                           ' save <index><B> into the dictionary
                LZW(prvIndex, savIndex) = dNext
                LZW(dNext, PREFIX) = orgIndex
                LZW(dNext, BYTE)   = newByte
                LZW(dNext, FIRST)  = EMPTY
                LZW(dNext, LESS)   = EMPTY
                LZW(dNext, MORE)   = EMPTY
                IF dNext = (2 ^ currentBitSize) THEN currentBitSize = currentBitSize + 1
                dNext = dNext + 1
            ELSE                                            ' else reset the dictionary... or maybe not
                IF resetDictionary THEN
                    GOSUB [PrintEncode]
                    REDIM LZW(dSize, 4)
                    FOR dNext = 0 TO 255
                        LZW(dNext, FIRST)  = EMPTY
                    NEXT dNext
                    currentBitSize = 8
                    bmxCorrect = 0
                END IF
            END IF
            orgIndex = newByte                              ' set <index> = <B>
        ELSE                                                ' if <index><B> was found in the dictionary,
            orgIndex = dSearch                              ' then set <index> = <index><B>
        END IF
    LOOP WHILE chnkPoint < chunk                            ' loop until the chunk has been processed
    GOSUB [GetFileChunk]                                    ' refill the buffer
 WEND                                                       ' loop until the buffer is empty
 GOSUB [WriteIndex]
 IF bitsRemain > 0 THEN #lzwOUT, CHR$(remainIndex);
 CLOSE #lzwOUT
 CLOSE #lzwIN
 IF bmxCorrect THEN ' correct the settings, if needed
    IF (currentBitSize < maxBits) OR resetDictionary THEN
        IF currentBitSize < 12 THEN currentBitSize = 12
        OPEN fileName$ + fileExt$ + JDext$ FOR BINARY AS #lzwOUT
        #lzwOUT, CHR$(currentBitSize - 12);
        CLOSE #lzwOUT
    END IF
 END IF
 GOSUB [PrintEncode]
 REDIM LZW(1, 1)
 RETURN

[WriteIndex]
 X = orgIndex                             ' add remaining bits to input
 IF bitsRemain > 0 THEN X = remainIndex + (X * (2 ^ bitsRemain))
 bitsRemain = bitsRemain + currentBitSize ' add current bit size to output stack
 WHILE bitsRemain > 7                     ' if 8 or more bits are to be written
    #lzwOUT, CHR$(X MOD 256);             ' attatch lower 8 bits to output string
    X = INT(X / 256)                      ' shift input value down by 2^8
    bitsRemain = bitsRemain - 8           ' adjust counters
 WEND
 remainIndex = X                          ' retain trailing bits for next write
 RETURN

' End LZW Encoder ''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''

[StartFileChunk]
 sizeOfFile = LOF(#lzwIN)    ' set EOF marker
 bytesRemaining = sizeOfFile ' set EOF counter
 chunk = maxChunkSize        ' set max buffer size
[GetFileChunk]
 fileChunk$ = ""
 IF bytesRemaining < 1 THEN RETURN
 IF chunk > bytesRemaining THEN chunk = bytesRemaining
 bytesRemaining = bytesRemaining - chunk
 fileChunk$ = INPUT$(#lzwIN, chunk)
 chnkPoint = 0
 RETURN

''''''''''''''''''''''''''''''''''''''''
[PrintEncode]
 IF printDictionary < 1 THEN RETURN
 OPEN "Encode_" + fileTag$ + fileName$ + ".txt" FOR OUTPUT AS #dictOUT
 FOR X = 0 TO 255
    LZW(X, PREFIX) = EMPTY
    LZW(X, BYTE)   = X
 NEXT X
 FOR X = dNext TO 0 STEP -1
    tmpIndex = X
    tmp$ = CHR$(LZW(tmpIndex, BYTE))
    WHILE LZW(tmpIndex, PREFIX) > EMPTY
        tmpIndex = LZW(tmpIndex, PREFIX)
        tmp$ = CHR$(LZW(tmpIndex, BYTE)) + tmp$
    WEND
    #dictOUT, X; ":"; tmp$
 NEXT X
 CLOSE #dictOUT
 tagCount = tagCount + 1
 fileTag$ = STR$(tagCount) + "_"
 RETURN

[PrintDecode]
 IF printDictionary < 1 THEN RETURN
 OPEN "Decode_" + fileTag$ + fileName$ + ".txt" FOR OUTPUT AS #dictOUT
 FOR X = dNext TO 0 STEP -1
    tmpIndex = X
    tmp$ = JDch$(tmpIndex)
    WHILE JDlzw(tmpIndex) > EMPTY
        tmpIndex = JDlzw(tmpIndex)
        tmp$ = JDch$(tmpIndex) + tmp$
    WEND
    #dictOUT, X; ":"; tmp$
 NEXT X
 CLOSE #dictOUT
 tagCount = tagCount + 1
 fileTag$ = STR$(tagCount) + "_"
 RETURN
''''''''''''''''''''''''''''''''''''''''