(*
**   TEST_LZW.PAS      Copyright (C) 1992 by MarshallSoft Computing, Inc.
**
**   This program is used to compress, expand, and verify each specified
**   file. It's purpose is for you to test the LZW4P library on your own
**   files. Your files are never modified. However, you should NOT have a
**   file named "XXX.XXX" or "YYY.YYY".  Compression ratios are printed
**   for each file compressed. For example, to compress all files ending
**   in *.PAS in your current directory, type:
**
**        TEST_LZW *.PAS
*)


program TEST_LZW;
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
  FileName     : String12;
  InpFileName  : String12;
  OutFileName  : String12;
  Inp1FileName : String12;
  Inp2FileName : String12;
  MemoryP      : Pointer;
  AllocMemoryP : Pointer;
  FreeMemoryP  : Pointer;
  ReaderP      : Pointer;
  WriterP      : Pointer;
  Size         : Integer;
  Code         : Integer;
  i, x         : Integer;
  DirInfo      : SearchRec;
  F1, F2       : file;
  Buffer1      : array [1..1024] of Byte;
  Buffer2      : array [1..1024] of Byte;
  NumRead1     : Integer;
  NumRead2     : Integer;
  Index        : LongInt;
  Ratio        : Real;
  ReaderCnt    : Real;
  WriterCnt    : Real;
  Count        : Integer;
  BitCode      : Integer;
begin
  (* get file specs *)
  if (ParamCount <> 1) and (ParamCount <> 2) then
    begin
      writeln('Usage: TEST_LZW <filespec>');
      halt;
    end;
  (* sign on *)
  writeln('TEST_LZW 1.1: Type any key to abort...');
  writeln;
  Count := 0;
  BitCode := 0;
  (* get pointers *)
  AllocMemoryP := @AllocMemory;
  FreeMemoryP  := @FreeMemory;
  ReaderP := @Reader;
  WriterP := @Writer;
  (* Initialize LZW *)
  if ParamCount = 2 then Val(ParamStr(2),BitCode,Code)
  else BitCode := 14;
writeln('BitCode=',BitCode);
  Code := InitLZW(AllocMemoryP,BitCode);
  if Code < 0 then
    begin
      SayError(Code);
      Halt;
    end;
  writeln;
  (* consider each file in FileSpec *)
  FindFirst(ParamStr(1),0,DirInfo);
  while DosError = 0 do
  begin (* while *)
    FileName := DirInfo.Name;
    (*writeln('<',FileName,'>');*)
    if (FileName<>'XXX.XXX') and (FileName<>'YYY.YYY') then
      begin (* process file *)
        if KeyPressed then
          begin
            writeln;
            writeln('Aborted by USER');
            Halt;
          end;
        Count := Count + 1;
        InpFileName := FileName;
        OutFileName := 'XXX.XXX';
        (***** COMPRESSION *****)
        (* open input file for compress *)
        Code := ReaderOpen(InpFileName);
        if Code <> 0 then
          begin
            writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
            halt;
          end;
        (* open output *)
        Code := WriterOpen(OutFileName);
        if Code <> 0 then
          begin
            writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
            halt;
          end;
        (* compress *)
        write('COMPRESSING ',FileName:12,' ');
        Code := Compress(ReaderP,WriterP);
        if Code < 0 then
          begin
            SayError(Code);
          end;
        (* report compression ratio *)
        if ReaderCount > 0 then
          begin
            ReaderCnt := ReaderCount;
            WriterCnt := WriterCount;
            Ratio := WriterCnt / ReaderCnt;
            writeln('OK',Ratio:6:2);
          end
        else writeln('???');
        (* close input & output *)
        Code := ReaderClose;
        Code := WriterClose;
        (***** EXPANSION *****)
        InpFileName := 'XXX.XXX';
        OutFileName := 'YYY.YYY';
        (* open input file for expansion *)
        Code := ReaderOpen(InpFileName);
        if Code <> 0 then
          begin
            writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
            halt;
          end;
        (* open output *)
        Code := WriterOpen(OutFileName);
        if Code <> 0 then
          begin
            writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
            halt;
          end;
        (* expand *)
        write('  EXPANDING ',FileName:12,' ');
        Code := Expand(ReaderP,WriterP);
        if Code < 0 then
          begin
            SayError(Code);
          end;
        (* close input & output *)
        Code := ReaderClose;
        Code := WriterClose;
        writeln('OK');
        (*** COMPARING ***)
        Inp1FileName := DirInfo.Name;
        Inp2FileName := 'YYY.YYY';
        (* open 1st input *)
        Assign(F1,Inp1FileName);
{$I-}
        Reset(F1,1);
{$I+}
        if IOResult <> 0 then
          begin
            writeln('Cannot open ',Inp1FileName,' for input. IOResult = ',IOResult);
            halt;
          end;
        (* open 2nd input *)
        Assign(F2,Inp2FileName);
{$I-}
        Reset(F2,1);
{$I+}
        if IOResult <> 0 then
          begin
            writeln('Cannot open ',Inp2FileName,' for input. IOResult = ',IOResult);
            halt;
          end;
        (* compare file byte for byte *)
        write('  COMPARING ',FileName:12,' ');
        Index := 0;
        repeat
          (* input 1st buffer *)
          BlockRead(F1,Buffer1,Sizeof(Buffer1),NumRead1);
          BlockRead(F2,Buffer2,Sizeof(Buffer2),NumRead2);
          if NumRead1 <> NumRead2 then
            begin
              writeln('Error comparing files');
              Halt;
            end;
          for i:= 1 to NumRead1 do
            begin
              Index := Index + 1;
              if Buffer1[i] <> Buffer2[i] then
                begin
                  writeln('Mismatch: Index=',Index,',Byte1=');
                  WriteHexByte(Buffer1[i]);
                  writeln(',Byte2=');
                  WriteHexByte(Buffer2[i]);
                  Halt;
                end;
            end;
        until (NumRead1=0) or (NumRead2=0);
        writeln('OK');
        writeln;
        close(F1);
        close(F2);
      end; (* process file *)
    (* get next filename *)
    FindNext(DirInfo);
  end; (* while *)
  (* Terminate LZW *)
  writeln(Count,' files processed.');
  Code := TermLZW(FreeMemoryP);
end.