home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / dearcusq.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-08  |  4.0 KB  |  186 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. Turbo Pascal V4.0 DEARC unSqueezing routines.
  37.  
  38. * ASSOCIATED FILES
  39. DEARC.PAS
  40. DEARCABT.PAS
  41. DEARCGLB.PAS
  42. DEARCIO.PAS
  43. DEARCLZW.PAS
  44. DEARCUNP.PAS
  45. DEARCUSQ.PAS
  46. DEARC.TXT
  47.  
  48. * CHECKED BY
  49. DRM 08/08/88
  50.  
  51. * KEYWORDS
  52. TURBO PASCAL V4.0
  53.  
  54. ==========================================================================
  55. }
  56. (**
  57.  *
  58.  *  Module:       dearcusq.pas
  59.  *  Description:  DEARC unSqueezing routines (huffman encoding)
  60.  *
  61.  *  Revision History:
  62.  *    7-26-88: unitized for Turbo v4.0
  63.  *
  64. **)
  65.  
  66.  
  67. unit dearcusq;
  68.  
  69. interface
  70.  
  71. uses
  72.   dearcglb,
  73.   dearcabt,
  74.   dearcio,
  75.   dearcunp;
  76.  
  77. procedure init_usq;
  78. function getc_usq : integer;
  79.  
  80.  
  81. (*
  82.  *  definitions for unsqueeze
  83.  *)
  84. Const
  85.   ERROR   = -1;
  86.   SPEOF   = 256;
  87.   NUMVALS = 256;               { 1 less than the number of values }
  88.  
  89. Type
  90.   nd = record
  91.           child : array [0..1] of integer
  92.         end;
  93.  
  94. Var
  95.   node     : array [0..NUMVALS] of nd;
  96.   bpos     : integer;
  97.   curin    : integer;
  98.   numnodes : integer;
  99.  
  100. implementation
  101.  
  102.  
  103. (**
  104.  *
  105.  *  Name:         procedure init_usq
  106.  *  Description:  initialize for unsqueeze
  107.  *  Parameters:   none
  108.  *
  109. **)
  110. procedure init_usq;
  111. var
  112.   i : integer;
  113. begin
  114.   bpos := 99;
  115.  
  116.   fread(numnodes, sizeof(numnodes));
  117.  
  118.   if (numnodes < 0) or (numnodes > NUMVALS) then
  119.     abort('File has an invalid decode tree');
  120.  
  121.   node[0].child[0] := -(SPEOF + 1);
  122.   node[0].child[1] := -(SPEOF + 1);
  123.  
  124.   for i := 0 to numnodes-1 do
  125.     begin
  126.       fread(node[i].child[0], sizeof(integer));
  127.       fread(node[i].child[1], sizeof(integer))
  128.     end
  129. end; (* proc init_usq; *)
  130.  
  131.  
  132. (**
  133.  *
  134.  *  Name:         function getc_usq : integer
  135.  *  Description:  unsqueeze
  136.  *  Parameters:   none
  137.  *  Returns:      unsqueezed char
  138.  *
  139. **)
  140. function getc_usq : integer;
  141. label
  142.   exit;
  143. var
  144.   i : integer;
  145. begin
  146.   i := 0;
  147.  
  148.   while i >= 0 do
  149.     begin
  150.       bpos := bpos + 1;
  151.  
  152.       if bpos > 7 then
  153.         begin
  154.           curin := getc_unp;
  155.  
  156.           if curin = ERROR then
  157.             begin
  158.               getc_usq := ERROR;
  159.               goto exit                   (******** was "exit" ************)
  160.             end;
  161.  
  162.           bpos := 0;
  163.  
  164.           i := node[i].child[1 and curin]
  165.         end
  166.       else
  167.         begin
  168.           curin := curin shr 1;
  169.           i := node[i].child[1 and curin]
  170.         end
  171.     end; (* while *)
  172.  
  173.   i := - (i + 1);
  174.  
  175.   if i = SPEOF then
  176.     getc_usq := -1
  177.   else
  178.     getc_usq := i;
  179.  
  180.   exit:
  181. end; (* func getc_usq *)
  182.  
  183.  
  184. end.
  185.  
  186.