How to : Adaptive huffman coding

Опубликовано: 05 Май 2026
на канале: How to : Tips and Trick
57
0

Adaptive huffman coding

LZH implementation in Pascal

Contributor: DOUGLAS WEBB

Unit LZH;

{$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}

(*

LZHUF.C English version 1.0

Based on Japanese version 29-NOV-1988

LZSS coded by Haruhiko OKUMURA

Adaptive Huffman Coding coded by Haruyasu YOSHIZAKI

Edited and translated to English by Kenji RIKITAKE

Translated from C to Turbo Pascal by Douglas Webb 2/18/91

Update and bug correction of TP version 4/29/91 (Sorry!!)

*)

{

This Unit allows the user to commpress data using a combination of

LZSS Compression and adaptive Huffman coding, or conversely to deCompress

data that was previously Compressed by this Unit.

There are a number of options as to where the data being Compressed/

deCompressed is coming from/going to.

In fact it requires that you pass the "LZHPack" Procedure 2 procedural

parameter of Type 'GetProcType' and 'PutProcType' (declared below) which

will accept 3 parameters and act in every way like a 'BlockRead'/'BlockWrite'

Procedure call. Your 'GetProcType' Procedure should return the data

to be Compressed, and Your 'PutProcType' Procedure should do something with

the Compressed data (ie., put it in a File). In Case you need to know (and

you do if you want to deCompress this data again) the number of Bytes in the

Compressed data (original, not Compressed size) is returned in 'Bytes_Written'.

GetBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);

DTA is the start of a memory location where the inFormation returned should

be. NBytes is the number of Bytes requested. The actual number of Bytes

returned must be passed in Bytes_Got (if there is no more data then 0

should be returned).

PutBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);

As above except instead of asking For data the Procedure is dumping out

Compressed data, do somthing With it.

"LZHUnPack" is basically the same thing in reverse. It requires

procedural parameters of Type 'PutProcType'/'GetProcType' which

will act as above. 'GetProcType' must retrieve data Compressed using

"LZHPack" (above) and feed it to the unpacking routine as requested.

'PutProcType' must accept the deCompressed data and do something

withit. You must also pass in the original size of the deCompressed data,

failure to do so will have adverse results.

Don't Forget that as procedural parameters the 'GetProcType'/'PutProcType'

Procedures must be Compiled in the 'F+' state to avoid a catastrophe.

}

{ note: All the large data structures For these routines are allocated when

needed from the heap, and deallocated when finished. So when not in use

memory requirements are minimal. However, this Unit Uses about 34K of

heap space, and 400 Bytes of stack when in use. }

Interface

Type

PutBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Put : Word);

GetBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Got : Word);

Procedure LZHPack(Var Bytes_Written : LongInt;

GetBytes : GetBytesProc;

PutBytes : PutBytesProc);

Procedure LZHUnpack(TextSize : LongInt;

GetBytes : GetBytesProc;

PutBytes : PutBytesProc);

Implementation

Const

Exit_OK = 0;

Exit_FAILED = 1;

{ LZSS Parameters }

N = 4096; { Size of String buffer }

F = 60; { Size of look-ahead buffer }

THRESHOLD = 2;

NUL = N; { end of tree's node }

{ Huffman coding parameters }

N_Char = (256 - THRESHOLD + F);

{ Character code (:= 0..N_Char-1) }

T = (N_Char * 2 - 1); { Size of table }

R = (T - 1); { root position }

{ update when cumulative frequency }

{ reaches to this value }

MAX_FREQ = $8000;

{

Tables For encoding/decoding upper 6 bits of

sliding dictionary Pointer

}

{ encoder table }

p_len : Array[0..63] of Byte =

($03, $04, $04, $04, $05, $05, $05, $05,

$05, $05, $05, $05, $06, $06, $06, $06,

$06, $06, $06, $06, $06, $06, $06, $06,

$07, $07, $07, $07, $07, $07, $07, $07,

$07, $07, $07, $07, $07, $07, $07, $07,

$07, $07, $07, $07, $07, $07, $07, $07,

$08, $08, $08, $08, $08, $08, $08, $08,

$08, $08, $08, $08, $08, $08, $08, $08);

p_code : Array[0..63] of Byte =

($00, $20, $30, $40, $50, $58, $60, $68,

$70, $78, $80, $88, $90, $94, $98, $9C,

$A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,

$C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,

$D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,

$E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,

$F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,

$F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);

{ decoder table }

d_code : Array[0..255] of Byte =

($00, $00, $00, $00, $00, $00, $00, $00,

$00, $00, $00, $00, $00, $00, $00, $00,

$00, $00, $00, $00, $00, $00, $00, $00,

$00, $00, $00, $00, $00, $00, $00, $00,

$01, $01, $01,..