{$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
  Version 1.3  - 12/30/84  changed file I/O to run on CP/M as well as
                           MS-DOS.  Changed filetypes to 'file' and
                           used blockread/write for file I/O.
                           Jeff Duncan
}


CONST 
    recognize  = $FF76;
    numvals    = 257;      { max tree size + 1 }
    speof      = 256;      { special end of file marker }
    dle: char  = #$90;
    buffersize = 128; (* 128 byte buffer *)

TYPE 
    tree       = ARRAY [0..255,0..1] OF integer;
    hexstr     = STRING[4];

VAR 
    debug : boolean;
    in_file, out_file: FILE;
    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];
    infilebuffer : ARRAY[1..2048] OF byte; (* allow for a 2k input buffer *)
    infilepointer : integer; (* pointer into buffer *)
    infilesize : integer;    (* input filesize for buffer loading *)
    inbuffersize : integer;  (* maximum count for buffer pointer *)
    outfilebuffer : ARRAY[1..128] OF byte; (* output buffer will be minimum *)
    outfilepointer : integer; (* pointer into output buffer *)
    outbuffer_num : integer;  (* how many buffer-fulls used *)

{ 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;

FUNCTION getc: integer;

  BEGIN
    IF (infilepointer > inbuffersize) AND (NOT eof(in_file))
      THEN
        BEGIN  (* is input buffer empty and more data to follow *)
          IF infilesize < 16
            THEN (* less than 2048 bytes left? *)
              BEGIN
                blockread(in_file, infilebuffer, infilesize); (* no get rest *)
                infilepointer := 1;
                inbuffersize := infilesize * 128;
              END
            ELSE
              BEGIN (* full 2048 left so get maximum *)
                blockread(in_file, infilebuffer, 16);
                inbuffersize := 2048;
                infilepointer := 1;
                infilesize := infilesize - 16;
              END;
        END;
    IF NOT ((infilepointer > inbuffersize) AND eof(in_file))
      THEN
        BEGIN  (* another character to read  available *)
          getc := infilebuffer[infilepointer];
          infilepointer := infilepointer + 1;
        END;
  END;

{ getw - get a word value from the input file }

FUNCTION getw: integer;

    VAR in1,in2: byte;
  BEGIN
    in1 := getc; (* use getc for these to simplify buffer manipulation *)
    in2 := getc;
    getw := ord(in1) + ord(in2) shl 8;
  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 (* file is found *)
        BEGIN
          inbuffersize := 0; (* dummy for first pass *)
          infilesize := filesize(in_file); (* filesize at initiate *)
          writeln('Input file ', in_fn,' is ',infilesize * 128.:6:0,' bytes.');
          infilepointer := 1; (* point beyond buffer, so we get data on entry *)
          i := getw;
        END
      ELSE
        i := 0;
    IF (recognize <> i)
      THEN BEGIN
             abort  := true;
             abortM := 'File is not a squeezed file'; (* could be not found also *)
             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);
             outfilepointer := 1; (* good idea to start at beginning of buffer *)
             outbuffer_num := 0; (* not neccessary *)
             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}
    outfilebuffer[outfilepointer] := ord(c); (* save data in output buffer *)
    outfilepointer := outfilepointer + 1; (* increment the pointer *)
    IF outfilepointer > buffersize
      THEN
        BEGIN (* we have a full buffer, lets write it out *)
          blockwrite(out_file,outfilebuffer,1);
          outfilepointer := 1; (* reset pinter *)
          outbuffer_num := outbuffer_num + 1;
        END;
  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 }
  LowVideo;
  debug := true;
  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;
           IF docfile
             THEN (* to close the file we have to write the last
                              buffer.  If it's a text file we need to append
                              a ^Z to the buffer before writing.
                           *)
               IF outfilepointer <= buffersize
                 THEN
                   outfilebuffer[outfilepointer] := ord(^Z);
           blockwrite(out_file,outfilebuffer, 1);
           close(out_file); (* write last buffer of data *)
         END
    ELSE writeln('Error -- ',AbortM);
  close(in_file);
END.