Strict

Type THuffmanNode
   Field Frequency : Int
   Field Char      : Byte
   Field LeftNode  : THuffmanNode
   Field RightNode : THuffmanNode
   
   Method Compare:Int(Node:Object)
      If THuffmanNode(Node).Frequency < Self.Frequency Then
         Return 1
      ElseIf THuffmanNode(Node).Frequency > Self.Frequency
         Return -1
      Else
         Return 0
      EndIf
   End Method
End Type

Type THuffmanSymbol
   Field Char   : Byte
   Field Length : Byte
   Field Code   : Short
End Type

Function HuffmanCompress:Int(InBank:TBank, OutBank:TBank)
   Global Alphabet:THuffmanSymbol[256], Offset:Int, OutBank2:TBank

   Local TempBuffer:Byte[], Size:Int, CurrentChar:Byte, LastChar:Byte
   Local Index:Int, Frequency:Int, Node:THuffmanNode, NodeList:TList
   Local Count:Int, CurrentLink:TLink
   
   OutBank2 = OutBank
   
   NodeList = CreateList()
   
   ' Alphabet anlegen
   Size = InBank.Size()
   TempBuffer = New Byte[Size]
   MemCopy TempBuffer, InBank.Buf(), Size
   TempBuffer.Sort(False)
   
   CurrentChar = TempBuffer[0]
   For Index = 1 To Size-1
      LastChar    = CurrentChar
      CurrentChar = TempBuffer[Index]
      
      If CurrentChar = LastChar Then Frequency :+ 1
      
      If Index = Size-1 Then
         Node = New THuffmanNode
         Node.Frequency = Frequency+1
         Node.Char      = LastChar
         NodeList.AddLast(Node)
         
         If CurrentChar <> LastChar Then
            Node = New THuffmanNode
            Node.Frequency = 1
            Node.Char      = CurrentChar
            NodeList.AddLast(Node)
         EndIf
         Exit
      ElseIf CurrentChar <> LastChar Then
         Node = New THuffmanNode
         Node.Frequency = Frequency+1
         Node.Char      = LastChar
         NodeList.AddLast(Node)
         Frequency = 0
      EndIf
   Next
   
   
   ' Baum erstellen
   Count = NodeList.Count()
   For Index = Count To 2 Step -1
      CurrentLink = NodeList.Lastlink()

      Node = New THuffmanNode
      Node.LeftNode  = THuffmanNode(CurrentLink.PrevLink().Value())
      Node.RightNode = THuffmanNode(CurrentLink.Value())
      Node.Frequency = Node.LeftNode.Frequency +..
                       Node.RightNode.Frequency
      
      NodeList.InsertBeforeLink(Node, CurrentLink.PrevLink())
   
      CurrentLink.PrevLink().Remove()
      CurrentLink.Remove()
   
      NodeList.Sort(False)
      FlushMem()
   Next
   
   ' Alphabet anlegen
   For Index = 0 To 255
      Alphabet[Index] = Null
   Next
   CreateAlphabet(THuffmanNode(NodeList.FirstLink().Value()))
   
   ' OutBank auf die maximale Größe erweitern
   OutBank.Resize(Size+3*256+1+2)
   
   For Index = 0 To Size+3*256+1+1
      OutBank.PokeByte(Index, 0)
   Next
   
   ' Originalgröße abspeichern
   OutBank.Pokeint(0, Size)
   
   ' Alphabet abspeichern
   Count = 0 ; Offset = 40
   'Print "Alphabet: "
   For Index = 0 To 255
      If Alphabet[Index] <> Null Then
         WriteBits(Index, 8)
         WriteBits(Alphabet[Index].Length-1, 4)
         WriteBits(Alphabet[Index].Code, Alphabet[Index].Length)
         Count :+ 1
      EndIf
   Next
   
   ' Anzahl an Zeichen im Alphabet
   OutBank.PokeByte(4, Count-1)
   
   ' Komprimierten Code abspeichern(Nutzdaten)
   For Index = 0 To Size-1
      CurrentChar = InBank.PeekByte(Index)
      WriteBits(Alphabet[CurrentChar].Code, Alphabet[CurrentChar].Length)
   Next
   
   ' Auf volle Bytes aufrunden
   If (Offset Mod 8) = 0 Then
      OutBank.Resize(Offset/8)
      Return Offset/8
   Else
      OutBank.Resize(Offset/8+1)
      Return Offset/8+1
   EndIf
   
   Function CreateAlphabet:Int(Node:THuffmanNode, Code:String="")
      Local Index:Int
      
      If Node.LeftNode = Null Then
         ' Node = Blatt -> neues Zeichen
         Alphabet[Node.Char] = New THuffmanSymbol
         Alphabet[Node.Char].Char = Node.Char
         Alphabet[Node.Char].Code = BinToDec(Code)
         Alphabet[Node.Char].Length = Code.Length
      Else
         CreateAlphabet(Node.LeftNode, Code+"0")
         CreateAlphabet(Node.RightNode, Code+"1")
      EndIf
   End Function
   
   Function WriteBits(Value:Int, Length:Byte)
      Local Offset2:Int, Offset3:Int, Split1:Byte, Split2:Byte
   
      Offset2 = Offset/8     ' Byteposition(Segment)
      Offset3 = Offset Mod 8 ' Bitsposition(Offset)

      Value :& ((1 Shl Length)-1)
   
      If Offset3 + Length > 8 Then
         ' Bits müssen auf 2 Bytes verteilt werden
         Split1 = Value Shr (Length-(8-Offset3))
         Split2 = Value & ((1 Shl (Length-(8-Offset3)))-1)
      
         WriteBits(Split1, 8-Offset3)
         WriteBits(Split2, Length-(8-Offset3))
      Else
         ' Bits passen in ein Byte
         Value = (Value Shl (8-Length)) Shr Offset3
         OutBank2.PokeByte(Offset2, OutBank2.PeekByte(Offset2) | Value)
         Offset :+ Length
      EndIf
   End Function

   Function BinToDec:Int(Binary:String)
      Local Index:Int, Value:Int
      
      For Index = Binary.Length-1 To 0 Step -1
         If Binary[Index] = Asc("1") Then
            Value = Value+(1 Shl (Binary.Length-Index-1))
         EndIf
      Next
      
      Return Value
   End Function
End Function

Function HuffmanDecompress:Int(InBank:TBank, OutBank:TBank)
   Global Alphabet:THuffmanSymbol[2^16], Offset:Int, InBank2:TBank
   Local Size:Int, Count:Int, Index:Int, Char:Byte, Length:Int, Code:Short
   Local Index2:Short
   
   InBank2 = InBank
   
   Size  = InBank.PeekInt(0)
   Count = InBank.PeekByte(4)+1
   OutBank.Resize(Size)

   For Index = 1 To 255
      Alphabet[Index] = Null
   Next
   
   ' Alphabet anlegen
   Offset = 40
   For Index = 1 To Count
      Char   = ReadBits(8)
      Length = ReadBits(4)+1
      If Length > 8 Then
         ' ReadBits kann nur max. 8 Bit lesen
         Code = ReadBits(8) Shl (Length-8)
         Code :| ReadBits(Length-8)
      Else
         Code = ReadBits(Length)
      EndIf

      Index2 = (Length Shl 8) | Code
      Alphabet[Index2] = New THuffmanSymbol
      Alphabet[Index2].Char   = Char
      Alphabet[Index2].Length = Length
      Alphabet[Index2].Code   = Code
   Next
   
   ' Dekomprimieren
   For Index = 0 To Size-1
      Code = 0
      Length = 0
      Repeat
         Code = (Code Shl 1) | ReadBits(1)
         Length :+ 1
         Index2 = (Length Shl 8) | Code
      Until Alphabet[Index2] <> Null
      OutBank.PokeByte(Index, Alphabet[Index2].Char)
      FlushMem()
   Next
   
   ' Dekomprimierte Größe zurück geben
   Return Size
   

   Function ReadBits:Int(Length:Int)
      Local Offset2:Int, Offset3:Int, Value:Int
      Local Split1:Byte, Split2:Byte
      
      Offset2 = Offset/8
      Offset3 = Offset Mod 8
   
      If Offset3 + Length > 8 Then
         Split1 = ReadBits(8-Offset3) Shl (Length-(8-Offset3))
         Split2 = ReadBits(Length-(8-Offset3))
         Value = Split1 | Split2
         Return Value
      Else
         Value = InBank2.PeekByte(Offset2) Shr (8-Length-Offset3)
         Value :& ((1 Shl Length)-1)
         Offset :+ Length
         Return Value
      EndIf
   End Function
End Function

Local InBank:TBank
Local OutBank:TBank

Local InFile:TStream
Local OutFile:TStream

Local Size:Int

Size = FileSize("blub.bmp")

InFile = ReadFile("blub.bmp")
OutFile = WriteFile("blub.huf")

InBank = CreateBank(Size)
OutBank = CreateBank()
ReadBank(InBank, InFile, 0, Size)
CloseFile InFile

Print "Compressed Size: "+(HuffmanCompress(InBank, OutBank)/1024)+" KB"

WriteBank(OutBank, OutFile, 0, OutBank.Size())
CloseFile OutFile

Size = FileSize("blub.huf")
InFile = ReadFile("blub.huf")
OutFile = WriteFile("blub2.bmp")

InBank.Resize(Size)

ReadBank(InBank, InFile, 0, Size)
CloseFile InFile

Print "Decompressed Size: "+(HuffmanDecompress(InBank, OutBank)/1024)+" KB"
WriteBank(OutBank, OutFile, 0, OutBank.Size())
CloseFile OutFile