home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / PASCAL / USQ.PQS / USQ.PAS
Pascal/Delphi Source File  |  2000-06-30  |  9KB  |  281 lines
  1. {$C-}
  2. program Unsqueeze;      { unsqueeze file from in_file to out_file }
  3.  
  4. { This program unsqueezes a file which has been squeezed or compressed
  5.   to  reduce  the space required to store it on disk.  The program was
  6.   converted from the original  version  written  for  CP/M  in  the  C
  7.   language.   This  program  can be used to unsqueeze files which have
  8.   been downloaded from RCP/M systems where almost all files are  saved
  9.   in this squeezed format.
  10.  
  11.   The  technique used is the Huffman encoding technique which converts
  12.   the most common characters in the input file  to  a  compressed  bit
  13.   stream  of  data.   This  program  unsqueezes such a Huffman encoded
  14.   file.
  15.  
  16.   PUBLIC  DOMAIN  -  Feel  free  to  distribute  this program.  Do not
  17.   distribute it by commercial means or make any charge for this pgm.
  18.  
  19.   Version 1.0  - 09/05/82  Scott Loftesness
  20.   Version 1.1  - 01/06/83  Added capability to strip off parity bit if
  21.                            output file is text. Ernie LeMay 71435,730
  22.   Version 1.2  - 07/20/84  converted to Turbo Pascal. Steve Freeman
  23.   Version 1.3  - 12/30/84  changed file I/O to run on CP/M as well as
  24.                            MS-DOS.  Changed filetypes to 'file' and
  25.                            used blockread/write for file I/O.
  26.                            Jeff Duncan
  27. }
  28.  
  29.  
  30. const
  31.     recognize  = $FF76;
  32.     numvals    = 257;      { max tree size + 1 }
  33.     speof      = 256;      { special end of file marker }
  34.     dle: char  = #$90;
  35.     buffersize = 128; (* 128 byte buffer *)
  36.  
  37. type
  38.     tree       = array [0..255,0..1] of integer;
  39.     hexstr     = string[4];
  40.  
  41. var
  42.     debug : boolean;
  43.     in_file, out_file: file;
  44.     in_FN: string[30];
  45.     dnode: tree;
  46.     inchar, curin, filecksum, bpos, i, repct, numnodes: integer;
  47.     c, lastchar: char;
  48.     origfile: string[14];
  49.     docfile, eofin, abort: boolean;
  50.     abortM: string[50];
  51.     infilebuffer : array[1..2048] of byte; (* allow for a 2k input buffer *)
  52.     infilepointer : integer; (* pointer into buffer *)
  53.     infilesize : integer;    (* input filesize for buffer loading *)
  54.     inbuffersize : integer;  (* maximum count for buffer pointer *)
  55.     outfilebuffer : array[1..128] of byte; (* output buffer will be minimum *)
  56.     outfilepointer : integer; (* pointer into output buffer *)
  57.     outbuffer_num : integer;  (* how many buffer-fulls used *)
  58.  
  59. { iftext -- find out if output file is text and return true if so. EL }
  60. function iftext : boolean;
  61.   var answer: char;
  62.   begin
  63.     repeat
  64.       write('Is the output file a text file?  ');
  65.       read(kbd,answer);
  66.       answer := upcase(answer);
  67.     until (answer in ['Y','N']);
  68.     writeln(answer);
  69.     if answer='Y'
  70.       then iftext:=true
  71.       else iftext:=false;
  72.   end;
  73.  
  74.  
  75. function hex(num: integer): hexstr;
  76.   var i, j: integer;
  77.       h: string[16];
  78.       str: hexstr;
  79.   begin
  80.     str := '0000';   h := '0123456789ABCDEF';   j := num;
  81.     for i:=4 downto 1
  82.       do begin
  83.            str[i] := h[(j and 15)+1];
  84.            j := j shr 4;
  85.          end;
  86.     hex := str;
  87.   end;
  88.  
  89. function getc: integer;
  90.  
  91.   begin
  92.     if (infilepointer > inbuffersize) and (not eof(in_file)) then
  93.       begin  (* is input buffer empty and more data to follow *)
  94.         if infilesize < 16 then (* less than 2048 bytes left? *)
  95.           begin
  96.             blockread(in_file, infilebuffer, infilesize); (* no get rest *)
  97.             infilepointer := 1;
  98.             inbuffersize := infilesize * 128;
  99.           end
  100.         else
  101.           begin (* full 2048 left so get maximum *)
  102.             blockread(in_file, infilebuffer, 16);
  103.             inbuffersize := 2048;
  104.             infilepointer := 1;
  105.             infilesize := infilesize - 16;
  106.           end;
  107.       end;
  108.     if not ((infilepointer > inbuffersize) and eof(in_file)) then
  109.       begin  (* another character to read  available *)
  110.         getc := infilebuffer[infilepointer];
  111.         infilepointer := infilepointer + 1;
  112.       end;
  113.   end;
  114.  
  115. { getw - get a word value from the input file }
  116. function getw: integer;
  117.     var in1,in2: byte;
  118.   begin
  119.     in1 := getc; (* use getc for these to simplify buffer manipulation *)
  120.     in2 := getc;
  121.     getw := ord(in1) + ord(in2) shl 8;
  122.   end;
  123.  
  124.  
  125. procedure initialize;
  126.   var str: string[14];
  127.   begin
  128.     abort := false;     { no error conditions presently exist }
  129.     repct:=0;
  130.     bpos:=99;
  131.     origfile:='';
  132.     eofin:=false;
  133.     clrscr;   gotoxy(1,5);   write('Enter the file to unsqueeze:');
  134.     readln(in_FN);
  135.     assign(in_file,in_FN);
  136.     {$I-}
  137.     reset(in_file);
  138.     {$I+}
  139.     if (IOresult = 0) then (* file is found *)
  140.       begin
  141.         inbuffersize := 0; (* dummy for first pass *)
  142.         infilesize := filesize(in_file); (* filesize at initiate *)
  143.         writeln('Input file ', in_fn,' is ',infilesize * 128,' bytes.');
  144.         infilepointer := 1; (* point beyond buffer, so we get data on entry *)
  145.         i := getw;
  146.       end
  147.     else
  148.       i := 0;
  149.     if (recognize <> i)
  150.       then begin
  151.              abort  := true;
  152.              abortM := 'File is not a squeezed file'; (* could be not found also *)
  153.              numnodes := -1;
  154.            end
  155.       else begin
  156.              filecksum := getw;     { get checksum from chars 2 - 3 of file }
  157.              repeat    { build original file name }
  158.                  inchar:=getc;
  159.                  if inchar <> 0
  160.                    then origfile := origfile + chr(inchar);
  161.                until inchar = 0;
  162.              writeln('Original file name is ',origfile);
  163.              write('Output to (return to default) ? ');
  164.              readln(str);
  165.              if length(str)=0 then
  166.                str:=origfile;
  167.              assign(out_file,str);
  168.              rewrite(out_file);
  169.              outfilepointer := 1; (* good idea to start at beginning of buffer *)
  170.              outbuffer_num := 0; (* not neccessary *)
  171.              numnodes:=ord(getw); { get the number of nodes in this files tree }
  172.              if (numnodes<0) or (numnodes>=numvals)
  173.                then begin
  174.                       abort  := true;
  175.                       abortM := 'File has invalid decode tree size';
  176.                     end;
  177.            end;
  178.     if not(abort)
  179.       then begin
  180.              dnode[0,0]:= -(speof+1);
  181.              dnode[0,1]:= -(speof+1);
  182.              numnodes:=numnodes-1;
  183.              for i:=0 to numnodes
  184.                do begin
  185.                     dnode[i,0]:=getw;
  186.                     dnode[i,1]:=getw;
  187.                   end;
  188.              { following is for test }
  189.              {for i:=0 to numnodes
  190.                do writeln(lst,'#',i:3,' ',hex(dnode[i,0]),' ',hex(dnode[i,1]));}
  191.            end;
  192.   end;
  193.  
  194. procedure dochar(c: char;  text: boolean);
  195.   begin
  196.     if text then
  197.       c:=chr(ord(c) and $7F); {strip off parity bit}
  198.     outfilebuffer[outfilepointer] := ord(c); (* save data in output buffer *)
  199.     outfilepointer := outfilepointer + 1; (* increment the pointer *)
  200.     if outfilepointer > buffersize then
  201.       begin (* we have a full buffer, lets write it out *)
  202.         blockwrite(out_file,outfilebuffer,1);
  203.         outfilepointer := 1; (* reset pinter *)
  204.         outbuffer_num := outbuffer_num + 1;
  205.       end;
  206.   end;
  207.  
  208. function getuhuff: char;
  209. var i: integer;
  210.   begin
  211.     i:=0;
  212.     repeat
  213.         bpos:=bpos+1;
  214.         if bpos>7 then begin
  215.                          curin := getc;
  216.                          bpos:=0;
  217.                        end
  218.                   else curin := curin shr 1;
  219.         i := ord(dnode[i,ord(curin and $0001)]);
  220.       until (i<0);
  221.     i := -(i+1);
  222.     if i=speof
  223.       then begin
  224.              eofin:=true;
  225.              getuhuff:=chr(26)
  226.            end
  227.       else getuhuff:=chr(i);
  228.   end;
  229.  
  230. function getcr: char;
  231. var c: char;
  232.   begin
  233.     if (repct>0)
  234.       then begin
  235.              repct:=repct-1;
  236.              getcr:=lastchar;
  237.            end
  238.       else begin
  239.              c:=getuhuff;
  240.              if c<>dle
  241.                then begin
  242.                       getcr:=c;
  243.                       lastchar:=c;
  244.                     end
  245.                else begin
  246.                       repct:=ord(getuhuff);
  247.                       if repct=0 then getcr:=dle
  248.                                  else begin
  249.                                         repct:=repct-2;
  250.                                         getcr:=lastchar;
  251.                                       end;
  252.                     end;
  253.            end;
  254.   end; {getcr}
  255.  
  256. begin { main }
  257.   debug := true;
  258.   initialize;
  259.   if not(abort)
  260.     then begin
  261.            docfile := iftext;
  262.            writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
  263.            while not(eof(in_file)) or not(eofin)
  264.              do begin
  265.                   c:=getcr;
  266.                   dochar(c,docfile);
  267.                 end;
  268.            if docfile then (* to close the file we have to write the last
  269.                               buffer.  If it's a text file we need to append
  270.                               a ^Z to the buffer before writing.
  271.                            *)
  272.              if outfilepointer <= buffersize then
  273.                outfilebuffer[outfilepointer] := ord(^Z);
  274.            blockwrite(out_file,outfilebuffer, 1);
  275.            close(out_file); (* write last buffer of data *)
  276.          end
  277.     else writeln('Error -- ',AbortM);
  278.   close(in_file);
  279. end.
  280.  then
  281.