home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / COMPRESS / LZHTV11.ZIP / UNLZH.INC < prev   
Encoding:
Text File  |  1990-01-02  |  9.3 KB  |  380 lines
  1.  
  2. (* --------------------------------------------------------------
  3.  *   UNLZH.INC
  4.  *
  5.  *   Based on parts of lzhuf.c
  6.  *   Written by Haruyasu Yoshizaki 11/20/1988
  7.  *   Some minor changes 4/6/1989
  8.  *   Comments translated by Haruhiko Okumura 4/7/1989
  9.  *   Translated to turbo pascal by Samuel H. Smith 4/20/1989
  10.  *   Modified for use with LZHTV by Samuel H. Smith 4/21/1989
  11.  *
  12.  *)
  13.  
  14. const
  15.    N_CHAR = (256-THRESHOLD+lookahead);
  16.                            (* kinds of characters (code = 0..N_CHAR-1) *)
  17.  
  18.    T = (N_CHAR * 2 - 1);   (* size of table *)
  19.  
  20.    R = (T - 1);            (* position of root *)
  21.  
  22.    MAX_FREQ = $8000;       (* updates tree when the *)
  23.                            (* root frequency comes to this value. *)
  24.  
  25. var
  26.    freq:   array[0..T+1] of word;   (* frequency table *)
  27.  
  28.    parent:  array[0..T+N_CHAR] of word;
  29.                (* pointers to parent nodes, except for the *)
  30.                (* elements[T..T + N_CHAR - 1] which are used to get *)
  31.                (* the positions of leaves corresponding to the codes. *)
  32.  
  33.    son:  array[0..T] of integer;
  34.                (* pointers to child nodes (son[], son[] + 1) *)
  35.  
  36.  
  37. (* table for encoding and decoding the upper 6 bits of position *)
  38. const
  39.    d_code: array[0..255] of byte = (
  40.         $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
  41.         $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
  42.         $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01,
  43.         $01, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02,
  44.         $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $03,
  45.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  46.         $03, $03, $04, $04, $04, $04, $04, $04, $04, $04, $05, $05, $05,
  47.         $05, $05, $05, $05, $05, $06, $06, $06, $06, $06, $06, $06, $06,
  48.         $07, $07, $07, $07, $07, $07, $07, $07, $08, $08, $08, $08, $08,
  49.         $08, $08, $08, $09, $09, $09, $09, $09, $09, $09, $09, $0A, $0A,
  50.         $0A, $0A, $0A, $0A, $0A, $0A, $0B, $0B, $0B, $0B, $0B, $0B, $0B,
  51.         $0B, $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D, $0E, $0E, $0E, $0E,
  52.         $0F, $0F, $0F, $0F, $10, $10, $10, $10, $11, $11, $11, $11, $12,
  53.         $12, $12, $12, $13, $13, $13, $13, $14, $14, $14, $14, $15, $15,
  54.         $15, $15, $16, $16, $16, $16, $17, $17, $17, $17, $18, $18, $19,
  55.         $19, $1A, $1A, $1B, $1B, $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,
  56.         $20, $20, $21, $21, $22, $22, $23, $23, $24, $24, $25, $25, $26,
  57.         $26, $27, $27, $28, $28, $29, $29, $2A, $2A, $2B, $2B, $2C, $2C,
  58.         $2D, $2D, $2E, $2E, $2F, $2F, $30, $31, $32, $33, $34, $35, $36,
  59.         $37, $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);
  60.  
  61.    d_len: array[0..255] of byte = (
  62.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  63.         $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03, $03,
  64.         $03, $03, $03, $03, $03, $03, $04, $04, $04, $04, $04, $04, $04,
  65.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  66.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  67.         $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04, $04,
  68.         $04, $04, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  69.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  70.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  71.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  72.         $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05, $05,
  73.         $05, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  74.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  75.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $06,
  76.         $06, $06, $06, $06, $06, $06, $06, $06, $06, $06, $07, $07, $07,
  77.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  78.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  79.         $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07, $07,
  80.         $07, $07, $07, $07, $07, $07, $08, $08, $08, $08, $08, $08, $08,
  81.         $08, $08, $08, $08, $08, $08, $08, $08, $08);
  82.  
  83.  
  84. (* ------------------------------------------------------------- *)
  85. const
  86.    getbuf: word = 0;
  87.    getlen: byte = 0;
  88.  
  89. function GetBit: integer;  (* get one bit *)
  90. var
  91.    i:   byte;
  92.    
  93. begin
  94.    while (getlen <= 8) do
  95.    begin
  96.       ReadByte(i);
  97.       getbuf := getbuf or (word(i) shl (8 - getlen));
  98.       inc(getlen, 8);
  99.    end;
  100.    
  101.    if (getbuf and $8000) <> 0 then
  102.       GetBit := 1
  103.    else
  104.       GetBit := 0;
  105.  
  106.    getbuf := getbuf shl 1;
  107.    dec(getlen);
  108. end;
  109.  
  110.  
  111. function GetByte: integer; (* get one byte *)
  112. var
  113.    i:   byte;
  114.    
  115. begin
  116.    while (getlen <= 8) do
  117.    begin
  118.       ReadByte(i);
  119.       getbuf := getbuf or (word(i) shl (8 - getlen));
  120.       inc(getlen, 8);
  121.    end;
  122.    
  123.    GetByte := getbuf shr 8;
  124.    getbuf := getbuf shl 8;
  125.    dec(getlen, 8);
  126. end;
  127.  
  128.  
  129. (* ----------------------------------------------------------- *)
  130. (* initialization of tree *)
  131.  
  132. procedure StartHuff;
  133. var
  134.    i:   integer;
  135.    j:   integer;
  136.  
  137. begin
  138.  
  139.    for i := 0 to N_CHAR - 1 do
  140.    begin
  141.       freq[i] := 1;
  142.       son[i] := i + T;
  143.       parent[i + T] := i;
  144.    end;
  145.  
  146.    i := 0;
  147.    j := N_CHAR;
  148.    while (j <= R) do
  149.    begin
  150.       freq[j] := freq[i] + freq[i + 1];
  151.       son[j] := i;
  152.       parent[i] := j;
  153.       parent[i + 1] := j;
  154.       inc(i, 2);
  155.       inc(j);
  156.    end;
  157.  
  158.    freq[T] := $ffff;
  159.    parent[R] := 0;
  160. end;
  161.  
  162.  
  163. (* ----------------------------------------------------------- *)
  164. (* reconstruction of tree *)
  165.  
  166. procedure reconst;
  167. var
  168.    i,j,k:  integer;
  169.    f,l:    word;
  170.  
  171. begin
  172.  
  173. (* collect leaf nodes in the first half of the table *)
  174. (* and replace the freq by (freq + 1) / 2. *)
  175.    j := 0;
  176.    for i := 0 to T - 1 do
  177.    begin
  178.  
  179.       if (son[i] >= T) then
  180.       begin
  181.          freq[j] := (freq[i] + 1) div 2;
  182.          son[j] := son[i];
  183.          inc(j);
  184.       end;
  185.    end;
  186.  
  187.  
  188. (* begin constructing tree by connecting sons *)
  189.  
  190.    i := 0;
  191.    for j := N_CHAR to T - 1 do
  192.    begin
  193.       k := i + 1;
  194.       f := freq[i] + freq[k];
  195.       freq[j] := f;
  196.  
  197.       k := j - 1;
  198.       while (f < freq[k]) do
  199.          dec(k);
  200.  
  201.       inc(k);
  202.       l := (j - k) * 2;
  203.  
  204.       move(freq[k], freq[k+1], l);
  205.       freq[k] := f;
  206.  
  207.       move(son[k], son[k+1], l);
  208.       son[k] := i;
  209.  
  210.       inc(i, 2);
  211.    end;
  212.  
  213.  
  214. (* connect parent *)
  215.  
  216.    for i := 0 to T - 1 do
  217.    begin
  218.       k := son[i];
  219.       if k >= T then
  220.          parent[k] := i
  221.       else
  222.       begin
  223.          parent[k] := i;
  224.          parent[k + 1] := i;
  225.       end;
  226.    end;
  227. end;
  228.  
  229.  
  230. (* ----------------------------------------------------------- *)
  231. (* increment frequency of given code by one, and update tree *)
  232.  
  233. procedure update (c:   integer);
  234. var
  235.    i,j,k,l:   integer;
  236.  
  237. begin
  238.  
  239.    if (freq[R] = MAX_FREQ) then
  240.       reconst;
  241.  
  242.    c := parent[c + T];
  243.  
  244.    repeat
  245.       inc(freq[c]);
  246.       k := freq[c];
  247.  
  248. (* if the order is disturbed, exchange nodes *)
  249.  
  250.       l := c+1;
  251.       if (k > freq[l]) then
  252.       begin
  253.          repeat
  254.             inc(l);
  255.          until k <= freq[l];
  256.  
  257.          dec(l);
  258.          freq[c] := freq[l];
  259.          freq[l] := k;
  260.  
  261.          i := son[c];
  262.  
  263.          parent[i] := l;
  264.          if (i < T) then
  265.             parent[i + 1] := l;
  266.  
  267.          j := son[l];
  268.          son[l] := i;
  269.  
  270.          parent[j] := c;
  271.          if (j < T) then
  272.             parent[j + 1] := c;
  273.  
  274.          son[c] := j;
  275.          c := l;
  276.       end;
  277.  
  278.       c := parent[c];
  279.  
  280.    until c = 0;   (* repeat up to root *)
  281. end;
  282.  
  283.  
  284. (* ----------------------------------------------------------- *)
  285. function DecodeChar: integer;
  286. var
  287.    c:   word;
  288.    b:   integer;
  289.  
  290. begin
  291.    c := son[R];
  292.  
  293. (* travel from root to leaf, *)
  294. (* choosing the smaller child node (son[]) if the read bit is 0, *)
  295. (* the bigger (son[] +1end; if 1 *)
  296.  
  297.    while (c < T) do
  298.    begin
  299.       inc(c,GetBit);
  300.       c := son[c];
  301.    end;
  302.  
  303.    dec(c, T);
  304.    update(c);
  305.    DecodeChar := c;
  306. end;
  307.  
  308.  
  309. (* ----------------------------------------------------------- *)
  310. function DecodePosition: integer;
  311. var
  312.    i,j,c:   word;
  313.    b:       integer;
  314.  
  315. begin
  316.  
  317. (* recover upper 6 bits from table *)
  318.    i := GetByte;
  319.    c := d_code[i] shl 6;
  320.    j := d_len[i];
  321.  
  322. (* read lower 6 bits verbatim *)
  323.    dec(j, 2);
  324.    while j <> 0 do
  325.    begin
  326.       dec(j);
  327.       i := (i shl 1) + GetBit;
  328.    end;
  329.  
  330.    DecodePosition := c or (i and $3f);
  331. end;
  332.  
  333.  
  334. (* ----------------------------------------------------------- *)
  335. procedure unLZHuf;
  336.  
  337. var
  338.    i,j,k,c: integer;
  339.    count:   longint;
  340.  
  341. begin
  342.    if (header.compressed_size = 0) then
  343.       exit;
  344.  
  345.    StartHuff;
  346.  
  347.    fillchar(outbuf,sizeof(outbuf),' ');
  348.    outpos := obufsize - lookahead;
  349.  
  350.    count := 0;
  351.    while (count < header.original_size) do
  352.    begin
  353.  
  354.       c := DecodeChar;
  355.       if (c < 256) then
  356.       begin
  357.          OutByte(c);
  358.          inc(count);
  359.       end
  360.       else
  361.  
  362.       begin
  363.          i := (outpos - DecodePosition - 1) mod obufsize;
  364.          j := c - 255 + THRESHOLD;
  365.  
  366.          for k := 0 to j - 1 do
  367.          begin
  368.             c := outbuf[(i + k) mod obufsize];
  369.             OutByte(c);
  370.             inc(count);
  371.          end;
  372.       end;
  373.  
  374.       if fileeof or dump_user then
  375.          exit;
  376.    end;
  377.  
  378. end;
  379.  
  380.