(*************************************************************************

:Program.    Xpk.mod
:Contents.   General XPK file-to-file packer/unpacker
:Author.     Oliver Knorr
:Remark.     Derived from Hartmut Goebel's Oberon xpk
:Language.   Modula-2
:Translator. M2Amiga V4.0
:History.    V1.0, 20 Jul 1992 Oliver Knorr
:History.    V1.1, 30 Jul 1992 Oliver Knorr
:Date.       30 Jul 1992 02:09:34

*************************************************************************)

MODULE Xpk;

FROM Arts       IMPORT Exit ;
FROM DosD       IMPORT RDArgsPtr, ctrlC ;
FROM DosL       IMPORT PrintFault, IoErr, ReadArgs, FreeArgs ;
FROM ExecL      IMPORT SetSignal ;
FROM SYSTEM     IMPORT CAST, TAG, VAL, ADR, ADDRESS, LONGSET ;
FROM Terminal   IMPORT WriteString, WriteLn, FormatS, FormatNr ;
FROM UtilityD   IMPORT tagEnd, Hook, HookPtr ;
FROM XpkMasterD IMPORT StrPtr, errMsgSize, XpkTags, xpkFindMethod,
                       XpkProgressPtr, XpkProgressType ;
FROM XpkMasterL IMPORT XpkUnpack, XpkPack ;

IMPORT R ;

VAR
  tags: ARRAY [0..12] OF LONGINT;
  Res : LONGINT;
  argc: INTEGER;
  ErrBuf: ARRAY [0..errMsgSize] OF CHAR;
  ChunkHook: Hook;

CONST

  Template = "infile/A,outfile/A,Mode";

  mode = 2;
  infile = 0;
  outfile = 1;

VAR
  Argv: ARRAY [0..2] OF LONGINT;
  Arguments: RDArgsPtr;

PROCEDURE End(text: ARRAY OF CHAR);
BEGIN
  WriteString(text);
  WriteLn;
  Exit(10);
END End;

PROCEDURE ChunkFunc (myHook{R.A0}: HookPtr;
                     object{R.A2}: ADDRESS;
                     message{R.A1}: ADDRESS): ADDRESS;

VAR
  prog: XpkProgressPtr;
  st: StrPtr ;

BEGIN

  prog := message;
  st := prog^.packerName ;
  FormatS ("\r%4s: ", st^) ;
  st := prog^.activity ;
  FormatS ("%-9s ", st^) ;
  st := prog^.fileName ;
  FormatS ("%-12s ", st^) ;
  WITH prog^ DO
    FormatNr ("(%3ld%% done of ", done) ;
    FormatNr ("%6ld bytes, ", uLen) ;
    FormatNr ("%2ld%% CF, ", cf) ;
    FormatNr ("%6ld cps) ", speed) ;
    IF (type = ORD(progEnd)) THEN WriteLn; END;
  END ;

RETURN CAST(ADDRESS, SetSignal(LONGSET{}, LONGSET{ctrlC}) * LONGSET{ctrlC});

END ChunkFunc;

BEGIN

  ChunkHook.entry := ChunkFunc;

  Arguments := ReadArgs(ADR(Template),ADR(Argv),NIL);
  IF Arguments = NIL THEN
    IF PrintFault(IoErr(),ADR("***Error")) THEN END;
    Exit(20);
  END;

  IF Argv[mode] = NIL THEN                   (* First try to decompress... *)
    Res := XpkUnpack(TAG(tags,
                         xpkInName,    Argv[infile],
                         xpkOutName,   Argv[outfile],
                         xpkGetError,  ADR(ErrBuf),
                         xpkChunkHook, ADR(ChunkHook),
                         xpkNoClobber, TRUE,
                         tagEnd)) ;
  ELSE
    Res := XpkPack(TAG(tags,
                       xpkInName,     Argv[infile],
                       xpkOutName,    Argv[outfile],
                       xpkGetError,   ADR(ErrBuf),
                       xpkChunkHook,  ADR(ChunkHook),
                       xpkFindMethod, Argv[mode],
                       xpkNoClobber,  TRUE,
                       tagEnd)) ;
  END;
  IF Res # 0 THEN End(ErrBuf); END;

CLOSE
  IF Arguments # NIL THEN FreeArgs(Arguments); END;
END Xpk.