home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / arc / arctool / dearcusq.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-29  |  2.3 KB  |  148 lines
  1. {
  2.  
  3. * DESCRIPTION
  4. Turbo Pascal V4.0 DEARC unSqueezing routines.
  5.  
  6. * ASSOCIATED FILES
  7. DEARC.PAS
  8. DEARCABT.PAS
  9. DEARCGLB.PAS
  10. DEARCIO.PAS
  11. DEARCLZW.PAS
  12. DEARCUNP.PAS
  13. DEARCUSQ.PAS
  14. DEARC.TXT
  15.  
  16. }
  17. (**
  18.  *
  19.  *  Module:       dearcusq.pas
  20.  *  Description:  DEARC unSqueezing routines (huffman encoding)
  21.  *
  22.  *  Revision History:
  23.  *    7-26-88: unitized for Turbo v4.0
  24.  *
  25. **)
  26.  
  27.  
  28. unit dearcusq;
  29.  
  30. interface
  31.  
  32. uses
  33.   dearcglb,
  34.   dearcabt,
  35.   dearcio,
  36.   dearcunp;
  37.  
  38. procedure init_usq;
  39. function getc_usq : integer;
  40.  
  41.  
  42. (*
  43.  *  definitions for unsqueeze
  44.  *)
  45. Const
  46.   ERROR   = -1;
  47.   SPEOF   = 256;
  48.   NUMVALS = 256;               { 1 less than the number of values }
  49.  
  50. Type
  51.   nd = record
  52.           child : array [0..1] of integer
  53.         end;
  54.  
  55. Var
  56.   node     : array [0..NUMVALS] of nd;
  57.   bpos     : integer;
  58.   curin    : integer;
  59.   numnodes : integer;
  60.  
  61. implementation
  62.  
  63.  
  64. (**
  65.  *
  66.  *  Name:         procedure init_usq
  67.  *  Description:  initialize for unsqueeze
  68.  *  Parameters:   none
  69.  *
  70. **)
  71. procedure init_usq;
  72. var
  73.   i : integer;
  74. begin
  75.   bpos := 99;
  76.  
  77.   fread(numnodes, sizeof(numnodes));
  78.  
  79.   if (numnodes < 0) or (numnodes > NUMVALS) then
  80.     abort('File has an invalid decode tree');
  81.  
  82.   node[0].child[0] := -(SPEOF + 1);
  83.   node[0].child[1] := -(SPEOF + 1);
  84.  
  85.   for i := 0 to numnodes-1 do
  86.     begin
  87.       fread(node[i].child[0], sizeof(integer));
  88.       fread(node[i].child[1], sizeof(integer))
  89.     end
  90. end; (* proc init_usq; *)
  91.  
  92.  
  93. (**
  94.  *
  95.  *  Name:         function getc_usq : integer
  96.  *  Description:  unsqueeze
  97.  *  Parameters:   none
  98.  *  Returns:      unsqueezed char
  99.  *
  100. **)
  101. function getc_usq : integer;
  102. label
  103.   exit;
  104. var
  105.   i : integer;
  106. begin
  107.   i := 0;
  108.  
  109.   while i >= 0 do
  110.     begin
  111.       bpos := bpos + 1;
  112.  
  113.       if bpos > 7 then
  114.         begin
  115.           curin := getc_unp;
  116.  
  117.           if curin = ERROR then
  118.             begin
  119.               getc_usq := ERROR;
  120.               goto exit                   (******** was "exit" ************)
  121.             end;
  122.  
  123.           bpos := 0;
  124.  
  125.           i := node[i].child[1 and curin]
  126.         end
  127.       else
  128.         begin
  129.           curin := curin shr 1;
  130.           i := node[i].child[1 and curin]
  131.         end
  132.     end; (* while *)
  133.  
  134.   i := - (i + 1);
  135.  
  136.   if i = SPEOF then
  137.     getc_usq := -1
  138.   else
  139.     getc_usq := i;
  140.  
  141.   exit:
  142. end; (* func getc_usq *)
  143.  
  144.  
  145. end.
  146.  
  147. 
  148.