(*
**   MK_ARC.PAS.C    Copyright (C) 1993 by MarshallSoft Computing, Inc.
**
**   This program is used to compress one or more files into a single
**   archive file. For example, to compress all files ending with the
**   extension '.PAS' into an archive named 'PAS.ARF', type:
**
**      MK_ARC *.PAS PAS.ARF
*)


program MK_ARC;
uses dos, crt, memory, rw_io, hex_io, lzw_errs, LZW4P;

type
  String12 = String[12];
  AllocMemoryType = function(Size : Word) : Pointer;
  FreeMemoryType  = function(P : Pointer; Size : Word) : Integer;

Var
  InpFileName  : String12;
  OutFileName  : String12;
  MemoryP      : Pointer;
  AllocMemoryP : Pointer;
  FreeMemoryP  : Pointer;
  ReaderP      : Pointer;
  WriterP      : Pointer;
  Size         : Integer;
  Code         : Integer;
  i, x         : Integer;
  DirInfo      : SearchRec;
  Ratio        : Real;
  ReaderCnt    : Real;
  WriterCnt    : Real;
  Count        : Integer;
  AccumCnt     : LongInt;
begin
  (* get file specs *)
  if ParamCount <> 2 then
    begin
      writeln('Usage: MK_ARC <file_specs> <arc_file>');
      halt;
    end;
  (* sign on *)
  writeln('MK_ARC 1.0: Type any key to abort...');
  writeln;
  Count := 0;
  (* open output *)
  OutFileName := ParamStr(2);
  (* force to upper case *)
  for i := 1 to Length(OutFileName) do OutFileName[i] := UpCase(OutFileName[i]);
  Code := WriterOpen(OutFileName);
  if Code <> 0 then
    begin
      writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
      halt;
    end;
  (* get pointers *)
  AllocMemoryP := @AllocMemory;
  FreeMemoryP  := @FreeMemory;
  ReaderP := @Reader;
  WriterP := @Writer;
  (* Initialize LZW *)
  Code :=  InitLZW(AllocMemoryP,14);
  (* consider each input file *)
  FindFirst(ParamStr(1),0,DirInfo);
  while DosError = 0 do
  begin (* while *)
    InpFileName := DirInfo.Name;
    (*writeln('<',InpFileName,'>');*)
    if KeyPressed then
      begin
        writeln;
        writeln('Aborted by USER');
        Halt;
      end;
    (* don't compress output file ! *)
    if InpFileName = OutFileName then
      begin
         writeln('WARNING: Input file ',InpFileName,' same as output (skipping)');
      end
    else
      begin
        (* write file name to disk *)
        for i := 1 to Length(InpFileName) do Code := Writer(ord(InpFileName[i]));
        Code := Writer(0);
        (* compress this file *)
        Count := Count + 1;
        (* open input file for compress *)
        Code := ReaderOpen(InpFileName);
        if Code <> 0 then
          begin
            writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
            halt;
          end;
        (* compress *)
        write('COMPRESSING ',InpFileName:12,' ');
        AccumCnt := WriterCount;
        Code := Compress(ReaderP,WriterP);
        if Code < 0 then
          begin
            SayError(Code);
            Halt;
          end;
        (* report compression ratio *)
        if ReaderCount > 0 then
          begin
            ReaderCnt := ReaderCount;
            WriterCnt := WriterCount - AccumCnt;
            Ratio := WriterCnt / ReaderCnt;
            writeln('OK ',Ratio:6:2);
          end
        else writeln('???');
        (* close input file *)
        Code := ReaderClose;
     end;
    (* get next filename *)
    FindNext(DirInfo);
  end; (* while *)
  (* close output *)
  Code := WriterClose;
  (* Terminate LZW *)
  writeln(Count,' files archived.');
  Code := TermLZW(FreeMemoryP);
end.