home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASCAL.ZIP / USQNEW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  6.6 KB  |  226 lines
  1. {$C-}
  2. program Unsqueeze;      { unsqueeze file from in_file to out_file }
  3.  
  4. {
  5.   This program unsqueezes a file which has been squeezed or compressed to
  6.   reduce the space required to store it on disk. The program was converted
  7.   from the original version written for CP/M in the C language.  This program
  8.   can be used to unsqueeze files which have been downloaded from RCP/M systems
  9.   where almost all files are saved in this squeezed format.
  10.  
  11.   The technique used is the Huffman encoding technique which converts the most
  12.   common characters in the input file to a compressed bit stream of data. This
  13.   program unsqueezes such a Huffman encoded file.
  14.  
  15.   PUBLIC DOMAIN - Feel free to distribute this program. Do not distribute it by
  16.   commercial means or make any charge for this pgm.
  17.  
  18.   Version 1.0  - 09/05/82  Scott Loftesness
  19.   Version 1.1  - 01/06/83  Added capability to strip off parity bit if
  20.                            output file is text. Ernie LeMay 71435,730
  21.   Version 1.2  - 07/20/84  converted to Turbo Pascal. Steve Freeman
  22.   Version 1.3  - 02/21/85  Fixed file read bug. Bob Maxwell 70206,174
  23. }
  24.  
  25.  
  26. const
  27.     recognize  = $FF76;
  28.     numvals    = 257;      { max tree size + 1 }
  29.     speof      = 256;      { special end of file marker }
  30.     dle: char  = #$90;
  31.  
  32. type
  33.     tree       = array [0..255,0..1] of integer;
  34.     hexstr     = string[4];
  35.  
  36. var
  37.     in_file: file;
  38.     in_ptr: byte;
  39.     in_buff: array[0..127] of byte;
  40.     out_file: text;
  41.     in_FN: string[30];
  42.     dnode: tree;
  43.     inchar, curin, filecksum, bpos, i, repct, numnodes: integer;
  44.     c, lastchar: char;
  45.     origfile: string[14];
  46.     docfile, eofin, abort: boolean;
  47.     abortM: string[50];
  48.  
  49.  
  50. { iftext -- find out if output file is text and return true if so. EL }
  51. function iftext : boolean;
  52.   var answer: char;
  53.   begin
  54.     repeat
  55.       write('Is the output file a text file?  ');
  56.       read(kbd,answer);
  57.       answer := upcase(answer);
  58.     until (answer in ['Y','N']);
  59.     writeln(answer);
  60.     if answer='Y'
  61.       then iftext:=true
  62.       else iftext:=false;
  63.   end;
  64.  
  65.  
  66. function hex(num: integer): hexstr;
  67.   var i, j: integer;
  68.       h: string[16];
  69.       str: hexstr;
  70.   begin
  71.     str := '0000';   h := '0123456789ABCDEF';   j := num;
  72.     for i:=4 downto 1
  73.       do begin
  74.            str[i] := h[(j and 15)+1];
  75.            j := j shr 4;
  76.          end;
  77.     hex := str;
  78.   end;
  79.  
  80.  
  81. function getc: integer;
  82.   var ch: char;
  83.   begin
  84.     in_ptr := in_ptr + 1;
  85.     if in_ptr > 127 then begin
  86.       blockread(in_file, in_buff, 1);
  87.       in_ptr := 0;
  88.     end;
  89.     getc := in_buff[in_ptr];
  90.   end;
  91.  
  92. { getw - get a word value from the input file }
  93. function getw: integer;
  94.     var in1,in2: integer;
  95.   begin
  96.     in1 := getc; in2 := getc;
  97.     getw := in1 + in2 shl 8;
  98.   end;
  99.  
  100.  
  101. procedure initialize;
  102.   var str: string[14];
  103.   begin
  104.     in_ptr := 127;
  105.     abort := false;     { no error conditions presently exist }
  106.     repct:=0;   bpos:=99;   origfile:='';   eofin:=false;
  107.     clrscr;   gotoxy(1,5);   write('Enter the file to unsqueeze: ');   readln(in_FN);
  108.     assign(in_file,in_FN);
  109.     {$I-}
  110.     reset(in_file);
  111.     {$I+}
  112.     if (IOresult<>0) then i := 0
  113.                      else if eof(in_file)
  114.                             then i := 0
  115.                             else i := getw;
  116.     if (recognize <> i)
  117.       then begin
  118.              abort  := true;
  119.              abortM := 'File is not a squeezed file';
  120.              numnodes := -1;
  121.            end
  122.       else begin
  123.              filecksum := getw;     { get checksum from chars 2 - 3 of file }
  124.              repeat    { build original file name }
  125.                  inchar:=getc;
  126.                  if inchar <> 0
  127.                    then origfile := origfile + chr(inchar);
  128.                until inchar = 0;
  129.              writeln('Original file name is ',origfile);
  130.              write('Output to (return to default) ? ');
  131.              readln(str);   if length(str)=0 then str:=origfile;
  132.              assign(out_file,str);   rewrite(out_file);
  133.              numnodes:=ord(getw); { get the number of nodes in this files tree }
  134.              if (numnodes<0) or (numnodes>=numvals)
  135.                then begin
  136.                       abort  := true;
  137.                       abortM := 'File has invalid decode tree size';
  138.                     end;
  139.            end;
  140.     if not(abort)
  141.       then begin
  142.              dnode[0,0]:= -(speof+1);
  143.              dnode[0,1]:= -(speof+1);
  144.              numnodes:=numnodes-1;
  145.              for i:=0 to numnodes
  146.                do begin
  147.                     dnode[i,0]:=getw;
  148.                     dnode[i,1]:=getw;
  149.                   end;
  150.              { following is for test }
  151.              {for i:=0 to numnodes
  152.                do writeln(lst,'#',i:3,' ',hex(dnode[i,0]),' ',hex(dnode[i,1]));}
  153.            end;
  154.   end;
  155.  
  156. procedure dochar(c: char;  text: boolean);
  157.   begin
  158.     if text then c:=chr(ord(c) and $7F); {strip off parity bit}
  159.     write(out_file,c);
  160.   end;
  161.  
  162. function getuhuff: char;
  163. var i: integer;
  164.   begin
  165.     i:=0;
  166.     repeat
  167.         bpos:=bpos+1;
  168.         if bpos>7 then begin
  169.                          curin := getc;
  170.                          bpos:=0;
  171.                        end
  172.                   else curin := curin shr 1;
  173.         i := ord(dnode[i,ord(curin and $0001)]);
  174.       until (i<0);
  175.     i := -(i+1);
  176.     if i=speof
  177.       then begin
  178.              eofin:=true;
  179.              getuhuff:=chr(26)
  180.            end
  181.       else getuhuff:=chr(i);
  182.   end;
  183.  
  184. function getcr: char;
  185. var c: char;
  186.   begin
  187.     if (repct>0)
  188.       then begin
  189.              repct:=repct-1;
  190.              getcr:=lastchar;
  191.            end
  192.       else begin
  193.              c:=getuhuff;
  194.              if c<>dle
  195.                then begin
  196.                       getcr:=c;
  197.                       lastchar:=c;
  198.                     end
  199.                else begin
  200.                       repct:=ord(getuhuff);
  201.                       if repct=0 then getcr:=dle
  202.                                  else begin
  203.                                         repct:=repct-2;
  204.                                         getcr:=lastchar;
  205.                                       end;
  206.                     end;
  207.            end;
  208.   end; {getcr}
  209.  
  210. begin { main }
  211.   initialize;
  212.   if not(abort)
  213.     then begin
  214.            docfile := iftext;
  215.            writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
  216.            while not(eof(in_file)) or not(eofin)
  217.              do begin
  218.                   c:=getcr;
  219.                   dochar(c,docfile);
  220.                 end;
  221.            close(out_file);
  222.          end
  223.     else writeln('Error -- ',AbortM);
  224.   close(in_file);
  225. end.
  226.