;https://en.wikipedia.org/wiki/LZW

Structure tINFOENTRY
    First.l
    Second.l
EndStructure

Structure ByteArray
    Byte.a[0]
EndStructure

Structure LongArray
    Long.l[0]
EndStructure

Macro __CHECKBITS()
;   If  CurrentTableEntry+257 >= (1<<CurrentBitSize)
;       CurrentBitSize+1
;   EndIf
    CurrentBitSize  +   Bool(CurrentTableEntry+257 >= (1<<CurrentBitSize))
EndMacro


Global Dim RenderedString.a(1000000)
Global RenderedLength;.l

Procedure WriteEntry(*DataPtr.ByteArray,*DataOffset.Long, *BitOffset.Long,Entry.l,EntrySize.l)

    Protected LocalValue.a  =   *DataPtr\Byte[*DataOffset\l]

    For i   =   1   To  EntrySize

        ; Frisches byte immer löschen
        If  *BitOffset\l    =   #NUL
            LocalValue  =   #NUL
        EndIf

        TestBit = Entry&1
        Entry>>1

        LocalValue | (TestBit<<*BitOffset\l)

        *BitOffset\l+1

        If  *BitOffset\l    >   7;=8
            *BitOffset\l    =   #NUL
            *DataPtr\Byte[*DataOffset\l] = LocalValue
            *DataOffset\l   +   1
            LocalValue      =   *DataPtr\Byte[*DataOffset\l]
        EndIf

    Next

    *DataPtr\Byte[*DataOffset\l] = LocalValue

EndProcedure


Procedure ReadEntry(*DataPtr.ByteArray,*DataOffset.Long, *BitOffset.Long,*Entry.Long,EntrySize.l)

    Protected TestByte.a    = *DataPtr\Byte[*DataOffset\l] >> *BitOffset\l

    For i   =   1   To  EntrySize

        TestBit =  TestByte&1

        Entry | (TestBit<<BitOffset)

        BitOffset   +   1

        TestByte    >>  1
        *BitOffset\l    +   1

        If  *BitOffset\l    >   7;=8
            *BitOffset\l    =   #NUL
            *DataOffset\l   +   1
            TestByte            =   *DataPtr\Byte[*DataOffset\l]
        EndIf

    Next

    *Entry\l = Entry

EndProcedure


Procedure AddTable(*Table.tINFOENTRY,Index,First, Second)
    *Table+Index*SizeOf(tINFOENTRY)
    *Table\First = First
    *Table\Second = Second
EndProcedure


Procedure IsTable(*Table.tINFOENTRY,MaxSize,First,Second)

    If  First>256
        Counter + First -   256
        *Table + (First-256)*SizeOf(tINFOENTRY)
    EndIf

    If Counter  <   MaxSize
        MaxSize-1
        For i   =   Counter To  MaxSize
            If(*Table\First = First) And (*Table\Second = Second)
                ProcedureReturn i+256
            EndIf
            *Table+SizeOf(tINFOENTRY)
        Next
    EndIf

    ProcedureReturn -1
EndProcedure


Procedure ComputeString(*Table,Value)

    RenderedLength =    #NUL

    If  Value   <   256
        RenderedString(RenderedLength) = Value-256
        RenderedLength + 1
        ProcedureReturn
    EndIf

    Value-256
    *TablePtr.tINFOENTRY = *Table+Value*SizeOf(tINFOENTRY)
    Value = *TablePtr\First-256

    While   Value   >=  0
        RenderedString(RenderedLength) = *TablePtr\Second
        RenderedLength+1
        *TablePtr = *Table + Value*SizeOf(tINFOENTRY)
        Value = *TablePtr\First-256
    Wend

    RenderedString(RenderedLength) = *TablePtr\Second
    RenderedLength+1
    RenderedString(RenderedLength) = *TablePtr\First
    RenderedLength+1

EndProcedure

Procedure CompressData(*DataBlock, DataSize)

    Protected *InfoTable.tINFOENTRY = AllocateMemory(SizeOf(tINFOENTRY)*1000000)

    Protected *DataPtr.ByteArray = *DataBlock
    Protected *Compressed = AllocateMemory(DataSize*2)
    Protected *CompressedPtr.ByteArray = *Compressed
    Protected CompressedOffset     = 8
    Protected CurrentBitSize       = 9
    Protected *DebugPtr            = *Compressed
    Protected DebugOffset          = 8

    First           =   *DataPtr\Byte[DataOffset]
    DataOffset  +   1
    DataEnd     =   DataSize    -   1

    For i   =   DataOffset  To  DataEnd
        Second = *DataPtr\Byte[i]

        ; Prüfen, ob First/Second schon so in der Tabelle vorkommen.
        Index = IsTable(*InfoTable,CurrentTableEntry,First,Second)
        If  Index   <>  -1
            First = Index
        Else

            ; Die neue Kombination in die Liste eintragen.
            AddTable(*InfoTable,CurrentTableEntry,First,Second)
            CurrentTableEntry+1

            ; Prüfen, ob die Bitbreite noch stimmt.
            __CHECKBITS()

            WriteEntry(*Compressed,@CompressedOffset,@CompressedBitOffset,First,CurrentBitSize)

            First = Second
        EndIf

    Next

    ; Prüfen, ob die Bitbreite noch stimmt.
    __CHECKBITS()

    WriteEntry(*Compressed,@CompressedOffset,@CompressedBitOffset,First,CurrentBitSize)

    ; Datenblock zusammenstellen:
    If  CompressedBitOffset
        CompressedOffset+1
    EndIf

    *Compressed = ReAllocateMemory(*Compressed,CompressedOffset)

    PokeL(*Compressed,CompressedOffset-8)
    PokeL(*Compressed+4,DataSize)

    FreeMemory(*InfoTable)

    ProcedureReturn *Compressed

EndProcedure


Procedure DecompressData(*Compressed)

    Protected *InfoTable.tINFOENTRY = AllocateMemory(SizeOf(tINFOENTRY)*1000000)
    Protected *DataPtr.ByteArray
    Protected *CompressedPtr.ByteArray

    CompressedSize = PeekL(*Compressed)+8

    DataBlockSize = PeekL(*Compressed+4)
    *DataBlock = AllocateMemory(DataBlockSize)
    *DataPtr.ByteArray = *DataBlock
    CompressedOffset = 8
    CurrentBitSize = 9

    ReadEntry(*Compressed,@CompressedOffset,@CompressedBitOffset,@First,CurrentBitSize)
    *DataPtr\Byte[DataOffset] = First
    DataOffset+1

    While   DataOffset<DataBlockSize

        ; Den nächsten Eintrag auslesen.
        ReadEntry(*Compressed,@CompressedOffset,@CompressedBitOffset,@Second,CurrentBitSize)

        If Second   <=  CurrentTableEntry+255
            ComputeString(*InfoTable,Second)
        Else
            ComputeString(*InfoTable,First)
        EndIf

        AdditionalChar = RenderedLength-1

        For i   =   AdditionalChar  To  0   Step    -1
            *DataPtr\Byte[DataOffset] = RenderedString(i)
            DataOffset+1
        Next

        If Second   >   CurrentTableEntry+255
            *DataPtr\Byte[DataOffset] = RenderedString(AdditionalChar)
            DataOffset+1
        EndIf

        AddTable(*InfoTable,CurrentTableEntry,First,RenderedString(AdditionalChar))
        CurrentTableEntry+1

        ; Prüfen, ob die Bitbreite noch stimmt.
;       n   =   CurrentTableEntry+258
;       While   n >= (1<<CurrentBitSize)-1
;           CurrentBitSize+1
;       Wend

            CurrentBitSize  +   Bool(CurrentTableEntry+259  >= (1<<CurrentBitSize))

        First = Second
    Wend

    FreeMemory(*InfoTable)

    ProcedureReturn *DataBlock

EndProcedure


OpenFile(0,"MCEd.pb")
Define.l length = Lof(0)
Define *Buffer = AllocateMemory(length)
ReadData(0,*Buffer,length)
CloseFile(0)

OpenConsole()
PrintN("Komprimieren")
t0 = ElapsedMilliseconds()
*Compressed = CompressData(*Buffer,length)
t0  =   ElapsedMilliseconds()-t0

PrintN("Originallänge : "+Str(PeekL(*Compressed+4)))
PrintN("Komprimiert   : "+Str(PeekL(*Compressed)))

CreateFile(0,"Test.IC7")
WriteData(0,*Compressed,PeekL(*Compressed))
CloseFile(0)

; OpenFile(0,"Test.cpr")
; Define.l length = Lof(0)
; Define *Compressed = AllocateMemory(length)
; ReadData(0,*Compressed,length)
; CloseFile(0)

PrintN("Dekomprimieren")
t1  =   ElapsedMilliseconds()
*Decompressed = DecompressData(*Compressed)
t1 = ElapsedMilliseconds()-t1
CreateFile(0,"TestLZW.txt")
WriteData(0,*Decompressed,PeekL(*Compressed+4))
CloseFile(0)


MessageRequester("Ergebnis","Komprimieren : "+Str(t0)+#CRLF$+"Dekomprimieren : "+Str(t1),#PB_MessageRequester_Ok)
; IDE Options = PureBasic 5.31 (Windows - x64)
; CursorPosition = 245
; FirstLine = 87
; Folding = --
; EnableXP
; Executable = Lzw2.exe
; DisableDebugger