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
  Version 1.3  - 10/15/85  converted to Turbo Pascal 2.0  Bob Moss
                           added getbuf, putbuf, putc - changed getc
                           to provide buffered I/O.(128 char buffer)
  Version 1.4  - 09/15/87  added a CP/M dir program that will first
                           display a directory to allow the user to
                           decide on which file to use. Also changed
                           the ClrScr statement since some computer
                           operators don't know the ASCII call to do
                           this or sometimes ClrScr doesn't work.
                           Added number counter so that the user knows
                           it's doing something. Also added High/Low.
                           David Robert Shelvey.  (206)-939-3838

  Version 1.4.1 - 09/17/87 Opps, the uppercase doesn't seem to want
                           to work all the time so I took out calls
                           made durring the UNSQUEEZ-IT WORKING
                           screen. Well, looks like you will have to
                           wait till 1.5 comes out when I will then also
                           have it add file input at the CP/M prompt. I
                           also have the ASM code source for USQ and so
                           version 1.6 will have inline source for anyone
                           using the Ziolog 80 chip. Ta ta for now.
                           David Robert Shelvey. (206)-939-3838
                           P.O. Box 814 Kent, Wash. 98035
}

{$C-}
{$R-}
{$U-}

Label Start;

const
    recognize  = $FF76;
    numvals    = 257;      { max tree size + 1 }
    speof      = 256;      { special end of file marker }
    dle: char  = #$90;
    Proname    = 'UNSQUEEZE-IT';
    Version    = 'v1.4.1';
    Update     = '09/17/87';

type
    tree       = array [0..255,0..1] of integer;
    hexstr     = string[4];

var
    abort, docfile, eofin: boolean;
    c, lastchar: char;
    bpos, curin, filecksum, i, inchar, numnodes, repct: integer;
    in_file: file;
    out_file: file;
    InBuffer: array[0..127] of char;
    InBuffPos: integer;
    OutBuffer: array[0..127] of char;
    OutBuffPos: integer;
    abortM: string[50];
    in_FN: string[30];
    origfile: string[14];
    outfile: string[14];
    dnode: tree;
    NumCnt, To_Quit : Integer;

{ iftext -- find out if output file is text and return true if so. EL }
function iftext : boolean;
  var answer: char;
  begin
    repeat
      LowVideo;
      write('Is the output file a text file?  Y/N => ');
      HighVideo;
      read(kbd,answer);
      Writeln;
      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;

{ getbuf - get next buffer of data from the input file }
procedure getbuf;
  begin
    blockread(in_file,InBuffer,1);
    InBuffPos:=0;
  end;

{ getc - get next character from input file }
function getc: integer;
  var ch: char;
  begin
    if InBuffPos = 128 then getbuf;
    ch:=InBuffer[InBuffPos];
    InBuffPos := InBuffPos + 1;
    getc := ord(ch);
  end;

{ getw - get a word value from the input file }
function getw: integer;
    var in1,in2: integer;
  begin
    in1 := getc;
    in2 := getc;
    getw := in1 + in2 shl 8;
  end;

{ putbuf - write full buffer to out_file }
procedure putbuf;
  begin
    blockwrite(out_file,OutBuffer,1);
    OutBuffPos := 0;
  end;

{ putc - write char to output file (thru buffer) }
procedure putc(OutChr: char);
  begin
    OutBuffer[OutBuffPos] := OutChr;
    OutBuffPos := OutBuffPos + 1;
    if OutBuffPos = 128 then putbuf;
  end;

Procedure clearall;
var
BDX : Integer;
 begin
 for BDX := 1 to 25 do
  begin
   writeln;
  end;
end;

Procedure Bell;
 Begin
  Write(^G);
 End;

procedure CPM80Dir;
  { This program will give a directory of the logged drive. }
const
  Search_First         : Integer = $11;
  Search_Next          : Integer = $12;
  Set_DMA              : Integer = $1A;
var
  Error, Loop, Start   : Integer;
  FCB                  : array[0..25] of Byte absolute $005C;
  DMA                  : array[0..255] of Byte;
  BDX                  : Integer;

begin
 HighVideo;
 BDX := 0;
 begin
  Error := BDos(Set_DMA,Addr(DMA));
  FCB[0] := 0;
  for Loop := 1 to 11 do
    FCB[Loop] := ord('?');
  Error := BDos(Search_First,Addr(FCB));
  if Error <> 255 then begin
    Start := Error * 32;
    for Loop:= Start to start+8 do
      Write(Char(Mem[Addr(DMA)+Loop]));
    Write('.');
    for Loop:= Start+9 to Start+11 do
      Write(Char(Mem[Addr(DMA)+Loop]));
     BDX := BDX + 1;
   write(' | ');
   if BDX = 5 then writeln;
   if BDX = 5 then BDX := 0;
   write;
  end;
  repeat
    Error := BDos(search_Next);
    Start := Error * 32;
    if Error <> 255 then begin
      for Loop:= Start to start+8 do
        Write(Char(Mem[Addr(DMA)+Loop]));
      Write('.');
     for Loop:= Start+9 to Start+11 do
       Write(Char(Mem[Addr(DMA)+Loop]));
     BDX := BDX + 1;
    write(' | ');
    if BDX = 5 then writeln;
    if BDX = 5 then BDX := 0;
    write
   end
  until Error=255
 end;
end; { of procedure CPM80Dir }

procedure initialize;
  var str: string[14];
  begin
    abort := false;     { no error conditions presently exist }
    repct:=0;   bpos:=99;   origfile:='';   eofin:=false;
    InBuffPos:=128; {force read of buffer on first call of getc}
    OutBuffPos:=0;
    Clearall;
    GotoXY(1,1);
    Cpm80dir;
    LowVideo;
    Writeln; HighVideo;
    Writeln;
    If to_quit = 1 then Writeln('Empty Line to Quit'); LowVideo;
    write('Enter the file to unsqueeze => ');
    HighVideo;
    Bell;
    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;
              LowVideo;
             write('Original file name is => ');
             HighVideo;
             Writeln(origfile);
             LowVideo;
             write('Output to (return for original name) => ');
             HighVideo;
             readln(str);   if length(str)=0 then str:=origfile;
             outfile := str;
             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}
    putc(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 }
To_Quit := 0;
Start:
 LowVideo;
  NumCnt := 0;
   initialize;
    if not(abort)
      then begin
           docfile := iftext;
           ClearAll;
           LowVideo;
           GotoXY(1,2);
           Write(Proname);
           GotoXY(37,2);
           Write(Version);
           GotoXY(65,2);
           Write('as of ',Update);
           GotoXY(32,9);
           Write('===>'); HighVideo;
           Write(' WORKING '); LowVideo;
           Write('<===');
           GotoXY(15,17);
           Write('Original filename is => '); HighVideo;
           Write(Origfile); LowVideo;
           GotoXY(15,19);
           Write('Output filename is   => '); HighVideo;
           Write(Outfile);
           GotoXY(11,14);
           writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
           LowVideo;
           while not(eof(in_file)) or not(eofin)
             do begin
                  c:=getcr;
                  GotoXY(58,14);
                  Write('[ '); HighVideo;
                  Write(NumCnt); LowVideo;
                  Write(' ]');
                  dochar(c,docfile);
                NumCnt := NumCnt + 1;
            end;
           close(out_file);
           Bell;
          GotoXY(32,9); LowVideo;
          Write('===> '); HighVideo;
         Write('FINISHED'); LowVideo;
         Write(' <===');
         GotoXY(30,22); Write(' DAVID SHELVEY was here [ ]',chr(8),chr(8));
        Delay(2000);
       To_Quit := 1;
       Goto Start;
      end
    else writeln('Error -- ',AbortM);
  close(in_file);
end.