|
@@ -1,117 +1,148 @@
|
|
MODULE AdaptiveHuffman; (** AUTHOR GF; PUROSE "adaptive Huffman coding" *)
|
|
MODULE AdaptiveHuffman; (** AUTHOR GF; PUROSE "adaptive Huffman coding" *)
|
|
|
|
|
|
-(* adaptive Huffman compression, Vitter's algorithm *)
|
|
|
|
|
|
+(* adaptive Huffman compression, Vitter's FGK algorithm *)
|
|
|
|
|
|
IMPORT Streams;
|
|
IMPORT Streams;
|
|
|
|
|
|
CONST
|
|
CONST
|
|
- AlphabetSize* = 256; (* byte *)
|
|
|
|
|
|
+ AlphabetSize = 256; (* byte *)
|
|
BlockSize* = 8*1024;
|
|
BlockSize* = 8*1024;
|
|
- ScaleSize = 2*1024;
|
|
|
|
|
|
+ ScaleLimit = 4*1024;
|
|
|
|
|
|
Encode = 0; Decode = 1;
|
|
Encode = 0; Decode = 1;
|
|
|
|
|
|
|
|
+TYPE
|
|
|
|
+ BitReader = OBJECT
|
|
|
|
+ VAR
|
|
|
|
+ in: Streams.Reader;
|
|
|
|
+ curByte, curBit: LONGINT;
|
|
|
|
+
|
|
|
|
+ PROCEDURE &New( r: Streams.Reader );
|
|
|
|
+ BEGIN
|
|
|
|
+ in := r; curBit := -1; curByte := 0
|
|
|
|
+ END New;
|
|
|
|
+
|
|
|
|
+ PROCEDURE Initialize;
|
|
|
|
+ BEGIN
|
|
|
|
+ curBit := -1; curByte := 0
|
|
|
|
+ END Initialize;
|
|
|
|
+
|
|
|
|
+ PROCEDURE Bit( ): LONGINT;
|
|
|
|
+ VAR
|
|
|
|
+ bit: LONGINT; ch: CHAR;
|
|
|
|
+ BEGIN
|
|
|
|
+ IF curBit < 0 THEN
|
|
|
|
+ in.Char( ch ); curByte := ORD( ch ); curBit := 7
|
|
|
|
+ END;
|
|
|
|
+ bit := ASH( curByte, -curBit ) MOD 2;
|
|
|
|
+ DEC( curBit );
|
|
|
|
+ RETURN bit
|
|
|
|
+ END Bit;
|
|
|
|
+
|
|
|
|
+ END BitReader;
|
|
|
|
+
|
|
|
|
+
|
|
TYPE
|
|
TYPE
|
|
- Index = INTEGER; (* 16-bit integer to keep the table small *)
|
|
|
|
- Symbol = LONGINT;
|
|
|
|
|
|
+ BitWriter = OBJECT
|
|
|
|
+ VAR
|
|
|
|
+ out: Streams.Writer;
|
|
|
|
+ curByte, curBit: LONGINT;
|
|
|
|
+
|
|
|
|
+ PROCEDURE &New( w: Streams.Writer );
|
|
|
|
+ BEGIN
|
|
|
|
+ out := w; curBit := 0; curByte := 0
|
|
|
|
+ END New;
|
|
|
|
+
|
|
|
|
+ PROCEDURE Bit( bit: LONGINT );
|
|
|
|
+ BEGIN
|
|
|
|
+ curByte := 2*curByte + bit;
|
|
|
|
+ INC( curBit );
|
|
|
|
+ IF curBit > 7 THEN
|
|
|
|
+ out.Char( CHR( curByte ) ); curByte := 0; curBit := 0
|
|
|
|
+ END
|
|
|
|
+ END Bit;
|
|
|
|
+
|
|
|
|
+ PROCEDURE Finish; (* flush last few bits *)
|
|
|
|
+ BEGIN
|
|
|
|
+ WHILE curBit # 0 DO Bit( 0 ) END;
|
|
|
|
+ out.Update
|
|
|
|
+ END Finish;
|
|
|
|
+
|
|
|
|
+ END BitWriter;
|
|
|
|
+
|
|
|
|
|
|
- Node = RECORD
|
|
|
|
- weight: LONGINT; (* node weight *)
|
|
|
|
- up: Index; (* next node up the tree *)
|
|
|
|
- down: Index; (* pair of down nodes *)
|
|
|
|
- pattern: Symbol (* node pattern *)
|
|
|
|
- END;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+TYPE
|
|
HuffmanCoder = OBJECT
|
|
HuffmanCoder = OBJECT
|
|
- VAR
|
|
|
|
- mode: SHORTINT; (* encode, decode *)
|
|
|
|
- in: Streams.Reader; (* input from archive *)
|
|
|
|
- out: Streams.Writer; (* output to archive *)
|
|
|
|
- curByte, curBit: LONGINT;
|
|
|
|
-
|
|
|
|
- esc: Index; (* the current tree height *)
|
|
|
|
- root: Index; (* the root of the tree *)
|
|
|
|
- map: ARRAY AlphabetSize OF Index; (* mapping for symbols to nodes *)
|
|
|
|
- table: ARRAY 2*AlphabetSize + 4 OF Node; (* the coding table *)
|
|
|
|
|
|
+ TYPE
|
|
|
|
+ Index = INTEGER; (* 16-bit integer to keep the table small *)
|
|
|
|
+ Pattern = INTEGER;
|
|
|
|
+ Node = RECORD
|
|
|
|
+ weight: INTEGER; (* node weight *)
|
|
|
|
+ pattern: Pattern; (* node pattern (if weight is even, leaf node) *)
|
|
|
|
+ up: Index; (* next node up the tree *)
|
|
|
|
+ down: Index (* pair of down nodes (if weight is odd, internal node) *)
|
|
|
|
+ END;
|
|
|
|
+ VAR
|
|
|
|
+ mode: SHORTINT; (* Encode, Decode *)
|
|
|
|
+ in: BitReader; (* input from archive *)
|
|
|
|
+ out: BitWriter; (* output to archive *)
|
|
|
|
+
|
|
|
|
+ esc: Index; (* the current escape node *)
|
|
|
|
+ root: Index; (* the root of the tree *)
|
|
|
|
+ map: ARRAY AlphabetSize OF Index; (* mapping of patterns to nodes *)
|
|
|
|
+ table: ARRAY 2*AlphabetSize + 2 OF Node; (* the Huffman tree *)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
- PROCEDURE &New( m: SHORTINT; input: Streams.Reader; output: Streams.Writer );
|
|
|
|
|
|
+ PROCEDURE &New( m: SHORTINT; input: Streams.Reader; output: Streams.Writer );
|
|
BEGIN
|
|
BEGIN
|
|
ASSERT( m IN {Encode, Decode} );
|
|
ASSERT( m IN {Encode, Decode} );
|
|
mode := m;
|
|
mode := m;
|
|
- IF mode = Encode THEN out := output ELSE in := input END;
|
|
|
|
|
|
+ IF mode = Encode THEN NEW( out, output ) ELSE NEW( in, input ) END;
|
|
END New;
|
|
END New;
|
|
|
|
|
|
PROCEDURE Initialize;
|
|
PROCEDURE Initialize;
|
|
VAR i: Index;
|
|
VAR i: Index;
|
|
BEGIN
|
|
BEGIN
|
|
- root := 2*AlphabetSize + 4 - 1; curByte := 0;
|
|
|
|
- IF mode = Encode THEN curByte := 0; curBit := 0 ELSE curBit := -1 END;
|
|
|
|
|
|
+ root := 2*AlphabetSize + 2 - 1;
|
|
FOR i := 0 TO root DO
|
|
FOR i := 0 TO root DO
|
|
table[i].up := 0; table[i].down := 0; table[i].pattern := 0; table[i].weight := 0
|
|
table[i].up := 0; table[i].down := 0; table[i].pattern := 0; table[i].weight := 0
|
|
END;
|
|
END;
|
|
FOR i := 0 TO AlphabetSize - 1 DO map[i] := 0 END;
|
|
FOR i := 0 TO AlphabetSize - 1 DO map[i] := 0 END;
|
|
esc := root;
|
|
esc := root;
|
|
|
|
+ IF mode = Decode THEN in.Initialize END
|
|
END Initialize;
|
|
END Initialize;
|
|
|
|
|
|
-
|
|
|
|
- PROCEDURE Finish; (* flush last few bits *)
|
|
|
|
|
|
+ PROCEDURE Finish;
|
|
BEGIN
|
|
BEGIN
|
|
ASSERT( mode = Encode );
|
|
ASSERT( mode = Encode );
|
|
- WHILE curBit # 0 DO PutBit( 0 ) END;
|
|
|
|
- out.Update
|
|
|
|
- END Finish;
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-
|
|
|
|
- PROCEDURE GetBit( ): LONGINT;
|
|
|
|
- VAR
|
|
|
|
- bit: LONGINT; ch: CHAR;
|
|
|
|
- BEGIN
|
|
|
|
- IF curBit < 0 THEN
|
|
|
|
- in.Char( ch ); curByte := ORD( ch ); curBit := 7
|
|
|
|
- END;
|
|
|
|
- bit := ASH( curByte, -curBit ) MOD 2;
|
|
|
|
- DEC( curBit );
|
|
|
|
- RETURN bit
|
|
|
|
- END GetBit;
|
|
|
|
-
|
|
|
|
- PROCEDURE PutBit( bit: LONGINT );
|
|
|
|
- BEGIN
|
|
|
|
- curByte := 2*curByte + bit;
|
|
|
|
- INC( curBit );
|
|
|
|
- IF curBit > 7 THEN
|
|
|
|
- out.Char( CHR( curByte ) ); curByte := 0; curBit := 0
|
|
|
|
- END
|
|
|
|
- END PutBit;
|
|
|
|
-
|
|
|
|
|
|
+ out.Finish (* flush last few bits *)
|
|
|
|
+ END Finish;
|
|
|
|
+
|
|
|
|
|
|
- PROCEDURE GetPattern( ): Symbol;
|
|
|
|
- VAR sym, i, bit: LONGINT;
|
|
|
|
|
|
+ PROCEDURE GetPattern( ): Pattern;
|
|
|
|
+ VAR i: INTEGER; patt: Pattern;
|
|
BEGIN
|
|
BEGIN
|
|
- sym := 0; bit := 1;
|
|
|
|
- FOR i := 1 TO 8 DO
|
|
|
|
- IF GetBit() = 1 THEN sym := sym + bit END;
|
|
|
|
- bit := bit * 2;
|
|
|
|
|
|
+ patt := 0;
|
|
|
|
+ FOR i := 0 TO 7 DO
|
|
|
|
+ IF in.Bit() = 1 THEN patt := patt + INTEGER(ASH( 1, i )) END;
|
|
END;
|
|
END;
|
|
- RETURN sym
|
|
|
|
|
|
+ RETURN patt
|
|
END GetPattern;
|
|
END GetPattern;
|
|
|
|
|
|
-
|
|
|
|
- (* send the bits for an escaped symbol *)
|
|
|
|
- PROCEDURE PutPattern( sym: Symbol );
|
|
|
|
|
|
+ PROCEDURE PutPattern( patt: Pattern );
|
|
VAR i: LONGINT;
|
|
VAR i: LONGINT;
|
|
BEGIN
|
|
BEGIN
|
|
- FOR i := 1 TO 8 DO
|
|
|
|
- PutBit( sym MOD 2 ); sym := sym DIV 2;
|
|
|
|
|
|
+ FOR i := 0 TO 7 DO
|
|
|
|
+ out.Bit( patt MOD 2 ); patt := patt DIV 2;
|
|
END
|
|
END
|
|
END PutPattern;
|
|
END PutPattern;
|
|
|
|
|
|
|
|
|
|
- (* split escape node to incorporate new symbol *)
|
|
|
|
- PROCEDURE AddSymbol( sym: Symbol ): Index;
|
|
|
|
|
|
+ (* split escape node to incorporate a new pattern *)
|
|
|
|
+ PROCEDURE AddPattern( patt: Pattern ): Index;
|
|
VAR pair, node: Index;
|
|
VAR pair, node: Index;
|
|
BEGIN
|
|
BEGIN
|
|
ASSERT( esc > 1 );
|
|
ASSERT( esc > 1 );
|
|
@@ -120,55 +151,54 @@ TYPE
|
|
table[pair].down := node; table[pair].weight := 1;
|
|
table[pair].down := node; table[pair].weight := 1;
|
|
|
|
|
|
table[node].up := pair;
|
|
table[node].up := pair;
|
|
- table[node].down := 0; table[node].weight := 0; table[node].pattern := sym;
|
|
|
|
|
|
+ table[node].down := 0; table[node].weight := 0; table[node].pattern := patt;
|
|
|
|
|
|
table[esc].up := pair;
|
|
table[esc].up := pair;
|
|
table[esc].down := 0; table[esc].weight := 0;
|
|
table[esc].down := 0; table[esc].weight := 0;
|
|
|
|
|
|
- map[sym] := node;
|
|
|
|
|
|
+ map[patt] := node;
|
|
|
|
|
|
RETURN node;
|
|
RETURN node;
|
|
- END AddSymbol;
|
|
|
|
|
|
+ END AddPattern;
|
|
|
|
|
|
|
|
|
|
- (* swap leaf to group leader position return symbol's new node *)
|
|
|
|
|
|
+ (* swap leaf to group leader position, return pattern's new node *)
|
|
PROCEDURE GroupLeader( node: Index ): Index;
|
|
PROCEDURE GroupLeader( node: Index ): Index;
|
|
VAR
|
|
VAR
|
|
leader: Index;
|
|
leader: Index;
|
|
weight: LONGINT;
|
|
weight: LONGINT;
|
|
- sym, prev: Symbol;
|
|
|
|
|
|
+ patt, prev: Pattern;
|
|
BEGIN
|
|
BEGIN
|
|
weight := table[node].weight; leader := node;
|
|
weight := table[node].weight; leader := node;
|
|
WHILE (leader < root) & (weight = table[leader + 1].weight) DO INC( leader ) END;
|
|
WHILE (leader < root) & (weight = table[leader + 1].weight) DO INC( leader ) END;
|
|
IF leader # node THEN
|
|
IF leader # node THEN
|
|
- (* swap the leaf nodes *)
|
|
|
|
- sym := table[node].pattern;
|
|
|
|
|
|
+ (* swap the leaf nodes *)
|
|
|
|
+ patt := table[node].pattern;
|
|
prev := table[leader].pattern;
|
|
prev := table[leader].pattern;
|
|
- table[leader].pattern := sym;
|
|
|
|
|
|
+ table[leader].pattern := patt;
|
|
table[node].pattern := prev;
|
|
table[node].pattern := prev;
|
|
- map[sym] := leader;
|
|
|
|
|
|
+ map[patt] := leader;
|
|
map[prev] := node;
|
|
map[prev] := node;
|
|
END;
|
|
END;
|
|
RETURN leader
|
|
RETURN leader
|
|
END GroupLeader;
|
|
END GroupLeader;
|
|
|
|
|
|
|
|
|
|
- (* slide internal node up over all leaves of equal weight;
|
|
|
|
|
|
+ (* slide internal node up over all leaves of equal weight
|
|
or exchange leaf with next smaller weight internal node.
|
|
or exchange leaf with next smaller weight internal node.
|
|
return node's new position *)
|
|
return node's new position *)
|
|
PROCEDURE SlideNode( node: Index ): Index;
|
|
PROCEDURE SlideNode( node: Index ): Index;
|
|
VAR next: Index; swap: Node;
|
|
VAR next: Index; swap: Node;
|
|
BEGIN
|
|
BEGIN
|
|
swap := table[node]; next := node + 1;
|
|
swap := table[node]; next := node + 1;
|
|
- (* if we're sliding an internal node, find the highest possible leaf to exchange with *)
|
|
|
|
|
|
+ (* if we're sliding an internal node, find the highest possible leaf to exchange with *)
|
|
IF ODD( swap.weight ) THEN
|
|
IF ODD( swap.weight ) THEN
|
|
WHILE swap.weight > table[next+1].weight DO INC( next ) END
|
|
WHILE swap.weight > table[next+1].weight DO INC( next ) END
|
|
END;
|
|
END;
|
|
- (* swap the two nodes *)
|
|
|
|
|
|
+ (* swap the two nodes *)
|
|
table[node] := table[next]; table[next] := swap;
|
|
table[node] := table[next]; table[next] := swap;
|
|
table[next].up := table[node].up; table[node].up := swap.up;
|
|
table[next].up := table[node].up; table[node].up := swap.up;
|
|
-
|
|
|
|
- (* repair the symbol map and tree structure *)
|
|
|
|
|
|
+ (* repair the pattern map and tree structure *)
|
|
IF ODD( swap.weight ) THEN
|
|
IF ODD( swap.weight ) THEN
|
|
table[swap.down].up := next;
|
|
table[swap.down].up := next;
|
|
table[swap.down - 1].up := next;
|
|
table[swap.down - 1].up := next;
|
|
@@ -182,8 +212,8 @@ TYPE
|
|
END SlideNode;
|
|
END SlideNode;
|
|
|
|
|
|
|
|
|
|
- (* increment symbol weight and re balance the tree. *)
|
|
|
|
- PROCEDURE IncWeight( node: Index );
|
|
|
|
|
|
+ (* increment pattern weight and re balance the tree. *)
|
|
|
|
+ PROCEDURE IncrementWeight( node: Index );
|
|
VAR up: Index;
|
|
VAR up: Index;
|
|
BEGIN
|
|
BEGIN
|
|
(* obviate swapping a parent with its child: increment the leaf and proceed directly to its parent.
|
|
(* obviate swapping a parent with its child: increment the leaf and proceed directly to its parent.
|
|
@@ -194,7 +224,7 @@ TYPE
|
|
node := GroupLeader( node )
|
|
node := GroupLeader( node )
|
|
END;
|
|
END;
|
|
(* increase the weight of each node and slide over any smaller weights ahead of it until reaching the root.
|
|
(* increase the weight of each node and slide over any smaller weights ahead of it until reaching the root.
|
|
- internal nodes work upwards from their initial positions; while symbol nodes slide over first,
|
|
|
|
|
|
+ internal nodes work upwards from their initial positions; while pattern nodes slide over first,
|
|
then work up from their final positions. *)
|
|
then work up from their final positions. *)
|
|
INC( table[node].weight, 2 ); up := table[node].up;
|
|
INC( table[node].weight, 2 ); up := table[node].up;
|
|
WHILE up # 0 DO
|
|
WHILE up # 0 DO
|
|
@@ -206,16 +236,16 @@ TYPE
|
|
END;
|
|
END;
|
|
INC( table[node].weight, 2 ); up := table[node].up
|
|
INC( table[node].weight, 2 ); up := table[node].up
|
|
END;
|
|
END;
|
|
- END IncWeight;
|
|
|
|
|
|
+ END IncrementWeight;
|
|
|
|
|
|
|
|
|
|
(* scale all weights and rebalance the tree,
|
|
(* scale all weights and rebalance the tree,
|
|
- zero weight nodes are removed from the tree by sliding them out the rank list *)
|
|
|
|
|
|
+ zero weight nodes are removed from the tree *)
|
|
PROCEDURE Scale;
|
|
PROCEDURE Scale;
|
|
- VAR node, prev: Index; weight: LONGINT;
|
|
|
|
|
|
+ VAR node, prev: Index; weight: INTEGER;
|
|
|
|
|
|
- PROCEDURE Weight( idx: Index ): LONGINT;
|
|
|
|
- VAR w: LONGINT;
|
|
|
|
|
|
+ PROCEDURE Weight( idx: Index ): INTEGER;
|
|
|
|
+ VAR w: INTEGER;
|
|
BEGIN
|
|
BEGIN
|
|
w := table[idx].weight;
|
|
w := table[idx].weight;
|
|
IF ODD( w ) THEN RETURN w - 1 ELSE RETURN w END
|
|
IF ODD( w ) THEN RETURN w - 1 ELSE RETURN w END
|
|
@@ -223,94 +253,80 @@ TYPE
|
|
|
|
|
|
BEGIN
|
|
BEGIN
|
|
node := esc + 1;
|
|
node := esc + 1;
|
|
- (* work up the tree from the escape node scaling weights by the value of bits *)
|
|
|
|
|
|
+ (* work up the tree from the escape node scaling weights *)
|
|
WHILE node <= root DO
|
|
WHILE node <= root DO
|
|
- (* recompute the weight of internal nodes; slide down and out any unused ones *)
|
|
|
|
weight := table[node].weight;
|
|
weight := table[node].weight;
|
|
IF ODD( weight ) THEN
|
|
IF ODD( weight ) THEN
|
|
|
|
+ (* recompute the weight of internal nodes *)
|
|
weight := Weight( table[node].down ) + Weight( table[node].down-1 ) + 1
|
|
weight := Weight( table[node].down ) + Weight( table[node].down-1 ) + 1
|
|
ELSE
|
|
ELSE
|
|
- (* remove zero weight leaves by incrementing esc and removing them from the symbol map *)
|
|
|
|
|
|
+ (* remove zero weight leaves and remove them from the pattern map *)
|
|
weight := weight DIV 2;
|
|
weight := weight DIV 2;
|
|
IF ODD( weight ) THEN DEC( weight ) END;
|
|
IF ODD( weight ) THEN DEC( weight ) END;
|
|
IF weight = 0 THEN
|
|
IF weight = 0 THEN
|
|
map[table[node].pattern] := 0; INC( esc, 2 );
|
|
map[table[node].pattern] := 0; INC( esc, 2 );
|
|
END
|
|
END
|
|
END;
|
|
END;
|
|
- (* slide the scaled node back down over any previous nodes with larger weights *)
|
|
|
|
|
|
+ (* slide the scaled node back down over any previous nodes with larger weights *)
|
|
table[node].weight := weight;
|
|
table[node].weight := weight;
|
|
prev := node - 1;
|
|
prev := node - 1;
|
|
WHILE weight < table[prev].weight DO IGNORE SlideNode( prev ); DEC( prev ) END;
|
|
WHILE weight < table[prev].weight DO IGNORE SlideNode( prev ); DEC( prev ) END;
|
|
INC( node )
|
|
INC( node )
|
|
END;
|
|
END;
|
|
- (* prepare a new escape node *)
|
|
|
|
|
|
+ (* prepare a new escape node *)
|
|
table[esc].down := 0; table[esc].weight := 0;
|
|
table[esc].down := 0; table[esc].weight := 0;
|
|
END Scale;
|
|
END Scale;
|
|
|
|
|
|
|
|
+
|
|
|
|
+
|
|
|
|
|
|
- (* encode the next symbol *)
|
|
|
|
PROCEDURE EncodeByte( ch: CHAR );
|
|
PROCEDURE EncodeByte( ch: CHAR );
|
|
VAR
|
|
VAR
|
|
- code, n: LONGINT;
|
|
|
|
- up, idx, node: Index; sym: Symbol;
|
|
|
|
|
|
+ code, bits: LONGINT;
|
|
|
|
+ cur, node: Index; patt: Pattern;
|
|
BEGIN
|
|
BEGIN
|
|
- ASSERT( mode = Encode );
|
|
|
|
- (* for a new symbol, direct the receiver to the escape node *)
|
|
|
|
- sym := ORD( ch );
|
|
|
|
- node := map[sym]; idx := node;
|
|
|
|
- IF idx = 0 THEN idx := esc END;
|
|
|
|
- ASSERT( idx # 0 );
|
|
|
|
- (* accumulate the code bits by working up the tree from the node to the root *)
|
|
|
|
- code := 1; n := 0; up := table[idx].up;
|
|
|
|
- WHILE up # 0 DO
|
|
|
|
- code := code * 2; INC( n );
|
|
|
|
- IF ODD( idx ) THEN INC( code ) END;
|
|
|
|
- idx := up; up := table[idx].up
|
|
|
|
|
|
+ patt := ORD( ch ); node := map[patt];
|
|
|
|
+
|
|
|
|
+ (* accumulate the code bits by working up from the node to the root *)
|
|
|
|
+ cur := node; code := 0; bits := 0;
|
|
|
|
+ IF cur = 0 THEN cur := esc END;
|
|
|
|
+ WHILE table[cur].up # 0 DO
|
|
|
|
+ IF ODD( cur ) THEN code := code*2 + 1 ELSE code := code*2 END;
|
|
|
|
+ INC( bits ); cur := table[cur].up
|
|
END;
|
|
END;
|
|
- (* send the code, root selector bit first *)
|
|
|
|
- WHILE n > 0 DO
|
|
|
|
- PutBit( code MOD 2 ); code := code DIV 2;
|
|
|
|
- DEC( n )
|
|
|
|
|
|
+ (* send the code *)
|
|
|
|
+ WHILE bits > 0 DO
|
|
|
|
+ out.Bit( code MOD 2 ); code := code DIV 2;
|
|
|
|
+ DEC( bits )
|
|
END;
|
|
END;
|
|
- (* send pattern and incorporate it into the tree *)
|
|
|
|
IF node = 0 THEN
|
|
IF node = 0 THEN
|
|
- PutPattern( sym );
|
|
|
|
- node := AddSymbol( sym );
|
|
|
|
|
|
+ (* send the new pattern and incorporate it into the tree *)
|
|
|
|
+ PutPattern( patt ); node := AddPattern( patt );
|
|
END;
|
|
END;
|
|
- (* adjust and re-balance the tree *)
|
|
|
|
- IncWeight( node );
|
|
|
|
|
|
+ IncrementWeight( node );
|
|
END EncodeByte;
|
|
END EncodeByte;
|
|
|
|
|
|
|
|
|
|
- (* decode the next symbol *)
|
|
|
|
- PROCEDURE DecodeByte( ): CHAR;
|
|
|
|
|
|
+ PROCEDURE ExtractByte( ): CHAR;
|
|
VAR
|
|
VAR
|
|
node, down: Index;
|
|
node, down: Index;
|
|
- sym: Symbol;
|
|
|
|
|
|
+ patt: Pattern;
|
|
BEGIN
|
|
BEGIN
|
|
- ASSERT( mode = Decode );
|
|
|
|
- (* work down the tree from the root until reaching either a leaf or the escape node.
|
|
|
|
- A one bit means go left, a zero means go right. *)
|
|
|
|
|
|
+ (* work down the tree from the root until reaching either a leaf or the escape node *)
|
|
node := root; down := table[node].down;
|
|
node := root; down := table[node].down;
|
|
WHILE down # 0 DO
|
|
WHILE down # 0 DO
|
|
- IF GetBit( ) = 1 THEN
|
|
|
|
- node := down-1
|
|
|
|
- ELSE
|
|
|
|
- node := down;
|
|
|
|
- END;
|
|
|
|
|
|
+ IF in.Bit( ) = 1 THEN node := down - 1 ELSE node := down END;
|
|
down := table[node].down;
|
|
down := table[node].down;
|
|
END;
|
|
END;
|
|
- (* sent to the escape node *)
|
|
|
|
IF node = esc THEN
|
|
IF node = esc THEN
|
|
- sym := GetPattern( );
|
|
|
|
- node := AddSymbol( sym );
|
|
|
|
|
|
+ (* add the new pattern to the tree *)
|
|
|
|
+ patt := GetPattern( ); node := AddPattern( patt )
|
|
ELSE
|
|
ELSE
|
|
- sym := table[node].pattern
|
|
|
|
|
|
+ patt := table[node].pattern
|
|
END;
|
|
END;
|
|
- (* adjust and re-balance the tree *)
|
|
|
|
- IncWeight( node );
|
|
|
|
- RETURN CHR( sym );
|
|
|
|
- END DecodeByte;
|
|
|
|
|
|
+ IncrementWeight( node );
|
|
|
|
+ RETURN CHR( patt );
|
|
|
|
+ END ExtractByte;
|
|
|
|
|
|
END HuffmanCoder;
|
|
END HuffmanCoder;
|
|
|
|
|
|
@@ -320,23 +336,20 @@ TYPE
|
|
Encoder* =OBJECT
|
|
Encoder* =OBJECT
|
|
VAR
|
|
VAR
|
|
huff: HuffmanCoder;
|
|
huff: HuffmanCoder;
|
|
- out: Streams.Writer;
|
|
|
|
|
|
|
|
PROCEDURE & New*( archive: Streams.Writer );
|
|
PROCEDURE & New*( archive: Streams.Writer );
|
|
BEGIN
|
|
BEGIN
|
|
NEW( huff, Encode, NIL, archive );
|
|
NEW( huff, Encode, NIL, archive );
|
|
- out := archive
|
|
|
|
END New;
|
|
END New;
|
|
|
|
|
|
PROCEDURE CompressBlock*( CONST source: ARRAY OF CHAR; len: LONGINT );
|
|
PROCEDURE CompressBlock*( CONST source: ARRAY OF CHAR; len: LONGINT );
|
|
VAR i: LONGINT;
|
|
VAR i: LONGINT;
|
|
BEGIN
|
|
BEGIN
|
|
- out.RawNum( len );
|
|
|
|
huff.Initialize;
|
|
huff.Initialize;
|
|
i := 0;
|
|
i := 0;
|
|
WHILE i < len DO
|
|
WHILE i < len DO
|
|
huff.EncodeByte( source[i] ); INC( i );
|
|
huff.EncodeByte( source[i] ); INC( i );
|
|
- IF (i MOD ScaleSize = 0) & ((len-i) >= ScaleSize) THEN huff.Scale END
|
|
|
|
|
|
+ IF (i MOD ScaleLimit = 0) & ((len-i) >= ScaleLimit) THEN huff.Scale END
|
|
END;
|
|
END;
|
|
huff.Finish
|
|
huff.Finish
|
|
END CompressBlock;
|
|
END CompressBlock;
|
|
@@ -349,26 +362,21 @@ TYPE
|
|
Decoder* =OBJECT
|
|
Decoder* =OBJECT
|
|
VAR
|
|
VAR
|
|
huff: HuffmanCoder;
|
|
huff: HuffmanCoder;
|
|
- input: Streams.Reader;
|
|
|
|
|
|
|
|
PROCEDURE & New*( archive: Streams.Reader );
|
|
PROCEDURE & New*( archive: Streams.Reader );
|
|
BEGIN
|
|
BEGIN
|
|
NEW( huff, Decode, archive, NIL );
|
|
NEW( huff, Decode, archive, NIL );
|
|
- input := archive
|
|
|
|
END New;
|
|
END New;
|
|
|
|
|
|
- PROCEDURE ExtractBlock*( VAR buf: ARRAY OF CHAR ): LONGINT;
|
|
|
|
- VAR i, blockSize: LONGINT;
|
|
|
|
|
|
+ PROCEDURE ExtractBlock*( VAR buf: ARRAY OF CHAR; len: LONGINT );
|
|
|
|
+ VAR i: LONGINT;
|
|
BEGIN
|
|
BEGIN
|
|
- input.RawNum( blockSize );
|
|
|
|
- IF blockSize = 0 THEN (* end of stream *) RETURN 0 END;
|
|
|
|
huff.Initialize;
|
|
huff.Initialize;
|
|
i := 0;
|
|
i := 0;
|
|
- WHILE i < blockSize DO
|
|
|
|
- buf[i] := huff.DecodeByte( ); INC( i );
|
|
|
|
- IF (i MOD ScaleSize = 0) & ((blockSize-i) >= ScaleSize) THEN huff.Scale END
|
|
|
|
|
|
+ WHILE i < len DO
|
|
|
|
+ buf[i] := huff.ExtractByte( ); INC( i );
|
|
|
|
+ IF (i MOD ScaleLimit = 0) & ((len - i) >= ScaleLimit) THEN huff.Scale END
|
|
END;
|
|
END;
|
|
- RETURN blockSize
|
|
|
|
END ExtractBlock;
|
|
END ExtractBlock;
|
|
|
|
|
|
END Decoder;
|
|
END Decoder;
|