{$C-}
program Unsqueeze;      { unsqueeze file from in_file to out_file }

{
  This program unsqueezes a file which has been squeezed or compressed to
  reduce the space required to store it on disk. The program was converted
  from the original version written for CP/M in the C language.  This program
  can be used to unsqueeze files which have been downloaded from RCP/M systems
  where almost all files are saved in this squeezed format.

  The technique used is the Huffman encoding technique which converts the most
  common characters in the input file to a compressed bit stream of data. This
  program unsqueezes such a Huffman encoded file.

  PUBLIC DOMAIN - Feel free to distribute this program. Do not distribute it by
  commercial means or make any charge for this pgm.

  Version 1.0  - 09/05/82  Scott Loftesness
  Version 1.1  - 01/06/83  Added capability to strip off parity bit if
                           output file is text. Ernie LeMay 71435,730
  Version 1.2  - 07/20/84  converted to Turbo Pascal. Steve Freeman
}


const
    recognize  = $FF76;
    numvals    = 257;      { max tree size + 1 }
    speof      = 256;      { special end of file marker }
    dle: char  = #$90;

type
    tree       = array [0..255,0..1] of integer;
    hexstr     = string[4];

var
    in_file, out_file: file of char;
    in_FN: string[30];
    dnode: tree;
    inchar, curin, filecksum, bpos, i, repct, numnodes: integer;
    c, lastchar: char;
    origfile: string[14];
    docfile, eofin, abort: boolean;
    abortM: string[50];


{ iftext -- find out if output file is text and return true if so. EL }
function iftext : boolean;
  var answer: char;
  begin
    repeat
      write('Is the output file a text file?  ');
      read(kbd,answer);
      answer := upcase(answer);
    until (answer in ['Y','N']);
    writeln(answer);
    if answer='Y'
      then iftext:=true
      else iftext:=false;
  end;


function hex(num: integer): hexstr;
  var i, j: integer;
      h: string[16];
      str: hexstr;
  begin
    str := '0000';   h := '0123456789ABCDEF';   j := num;
    for i:=4 downto 1
      do begin
           str[i] := h[(j and 15)+1];
           j := j shr 4;
         end;
    hex := str;
  end;


{ getw - get a word value from the input file }
function getw: integer;
    var in1,in2: char;
  begin
    read(in_file,in1,in2);
    getw := ord(in1) + ord(in2) shl 8;
  end;


function getc: integer;
  var ch: char;
  begin
    read(in_file,ch);
    getc := ord(ch);
  end;

procedure initialize;
  var str: string[14];
  begin
    abort := false;     { no error conditions presently exist }
    repct:=0;   bpos:=99;   origfile:='';   eofin:=false;
    clrscr;   gotoxy(1,5);   write('Enter the file to unsqueeze:');   readln(in_FN);
    assign(in_file,in_FN);
    {$I-}
    reset(in_file);
    {$I+}
    if (IOresult<>0) then i := 0
                     else if eof(in_file)
                            then i := 0
                            else i := getw;
    if (recognize <> i)
      then begin
             abort  := true;
             abortM := 'File is not a squeezed file';
             numnodes := -1;
           end
      else begin
             filecksum := getw;     { get checksum from chars 2 - 3 of file }
             repeat    { build original file name }
                 inchar:=getc;
                 if inchar <> 0
                   then origfile := origfile + chr(inchar);
               until inchar = 0;
             writeln('Original file name is ',origfile);
             write('Output to (return to default) ? ');
             readln(str);   if length(str)=0 then str:=origfile;
             assign(out_file,str);   rewrite(out_file);
             numnodes:=ord(getw); { get the number of nodes in this files tree }
             if (numnodes<0) or (numnodes>=numvals)
               then begin
                      abort  := true;
                      abortM := 'File has invalid decode tree size';
                    end;
           end;
    if not(abort)
      then begin
             dnode[0,0]:= -(speof+1);
             dnode[0,1]:= -(speof+1);
             numnodes:=numnodes-1;
             for i:=0 to numnodes
               do begin
                    dnode[i,0]:=getw;
                    dnode[i,1]:=getw;
                  end;
             { following is for test }
             {for i:=0 to numnodes
               do writeln(lst,'#',i:3,' ',hex(dnode[i,0]),' ',hex(dnode[i,1]));}
           end;
  end;

procedure dochar(c: char;  text: boolean);
  begin
    if text then c:=chr(ord(c) and $7F); {strip off parity bit}
    write(out_file,c);
  end;

function getuhuff: char;
var i: integer;
  begin
    i:=0;
    repeat
        bpos:=bpos+1;
        if bpos>7 then begin
                         curin := getc;
                         bpos:=0;
                       end
                  else curin := curin shr 1;
        i := ord(dnode[i,ord(curin and $0001)]);
      until (i<0);
    i := -(i+1);
    if i=speof
      then begin
             eofin:=true;
             getuhuff:=chr(26)
           end
      else getuhuff:=chr(i);
  end;

function getcr: char;
var c: char;
  begin
    if (repct>0)
      then begin
             repct:=repct-1;
             getcr:=lastchar;
           end
      else begin
             c:=getuhuff;
             if c<>dle
               then begin
                      getcr:=c;
                      lastchar:=c;
                    end
               else begin
                      repct:=ord(getuhuff);
                      if repct=0 then getcr:=dle
                                 else begin
                                        repct:=repct-2;
                                        getcr:=lastchar;
                                      end;
                    end;
           end;
  end; {getcr}

begin { main }
  initialize;
  if not(abort)
    then begin
           docfile := iftext;
           writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
           while not(eof(in_file)) or not(eofin)
             do begin
                  c:=getcr;
                  dochar(c,docfile);
                end;
           close(out_file);
         end
    else writeln('Error -- ',AbortM);
  close(in_file);
end.
                                                         