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

:Program.    xpkRLen.mod
:Contents.   demo XpkSub library
:Author.     Hartmut Goebel [hG]
:Language.   Oberon
:Translator. Amiga Oberon V2.13
:History.    V0.9, 11 Jan 1992 Hartmut Goebel [hG]
:History.    V1.0, 27 Jul 1992 [hG] working but not really tested!
:Date.       27 Jul 1992 12:30:14

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

(*
 * IMPORTANT:
 * The packing algorithm of this Lib has not been tested to be proof!
 *
 * It is only a demo to show how to make XPK-Libs with AmigaOberon
 * Just compile this using SMALLCODE, SMALLDATA and link it by
 * 'LibLink with xpkRLen.wth'. Done.
 *)

MODULE xpkRLen;

IMPORT
  s  := SYSTEM,
  xpk:= XpkMaster,
  xs := XpkSubDefs;

CONST
  RLEN = s.VAL(LONGINT,"RLEN");

  RlenMode = xpk.XpkMode(
    NIL,       (* next                *)
    100,       (* upto                *)
    LONGSET{xpk.mfA3000Speed},(* flags    *)
    0,         (* packmem             *)
    0,         (* unpackmem           *)
    140,       (* packspeed,   K/sec  *)
    1043,      (* unpackspeed, K/sec  *)
    45,        (* ratio,      *0.1%   *)
    0,         (* reserved            *)
    "normal"); (* description         *)

  RlenInfo = xs.XpkInfo(
    1,               (* info version *)
    0,               (* lib  version *)
    0,               (* master vers  *)
    0,               (* pad          *)
    s.ADR("RLEN"),                  (* short name   *)
    s.ADR("Run Length 1.0"),        (* long name    *)
    s.ADR("Fast and simple compression usable for simple data"), (* description*)
    RLEN,                           (* 4 letter ID  *)
    LONGSET{xs.pkChunk,xs.upChunk}, (* flags        *)
    32000,           (* max in chunk *)
    0,               (* min in chunk *)
    32000,           (* def in chunk *)
    NIL,             (* pk message   *)
    NIL,             (* up message   *)
    NIL,             (* pk past msg  *)
    NIL,             (* up past msg  *)
    50,              (* def mode     *)
    0,               (* pad          *)
    s.ADR(RlenMode), (* modes        *)
    0,0,0,0,0,0);    (* reserved     *)

TYPE
  BufferPtr = POINTER TO ARRAY MAX(LONGINT)-1 OF BYTE;

(*
 * Returns an info structure about our packer
 *)
PROCEDURE XpksPackerInfo * (): xs.XpkInfoPtr;
(* No need for SaveRegs here, cause only d0 will be used! *)
BEGIN
  RETURN s.ADR(RlenInfo);
END XpksPackerInfo;


PROCEDURE XpksPackFree * (params{8}: xs.XpkSubParamsPtr);
BEGIN
END XpksPackFree;

(*
 * This forces the next chunk to be uncompressable independent from the
 * previous one. This is always the case in RLEN.
 *)
PROCEDURE XpksPackReset * (params{8}: xs.XpkSubParamsPtr): LONGINT;
(* No need for SaveRegs here, cause only d0 will be used! *)
BEGIN
  RETURN 0;
END XpksPackReset;


PROCEDURE XpksUnpackFree * (params{8}: xs.XpkSubParamsPtr);
BEGIN
END XpksUnpackFree;


(*
 * Pack a chunk
 *)
PROCEDURE XpksPackChunk * (xpar{8}: xs.XpkSubParamsPtr): LONGINT;
(* $SaveRegs+ *)
VAR
  get, put: BufferPtr;
  i: INTEGER;
  in, out, start, end: LONGINT;
  run: BOOLEAN; v: CHAR;
BEGIN
  get := xpar.inBuf;
  put := xpar.outBuf;
  end  := xpar.inLen;
  in := 0; out := 0; start := 0;
  LOOP
    run := (get[0]=get[1]) & (get[0]=get[2]);

    IF in+out+4 > xpar.outBufLen THEN
      RETURN xpk.errExpansion; END;

    IF run OR (in-start=127) OR (in=end) THEN (* write uncompressed *)
      IF in-start # 0 THEN
        put[out] := CHR(in-start); INC(out);
        i := SHORT(in-start);
        REPEAT
          put[out] := get[start]; INC(out); INC(start);
          DEC(i);
        UNTIL i = 0;
      END;
      IF in = end THEN
        put[out] := CHR(0); INC(out);
        EXIT;
      END;
      start := in;
    END;

    IF run THEN                                (* write compressed   *)
      v := get[i];
      i := 3;
      WHILE (in+i<end) & (get[in+i]=v) & (i<127) DO
        INC(i); END;
      put[out] := CHR(-i); INC(out);
      put[out] := v; INC(out);
      INC(in,i);
      start := in;
    ELSE
      INC(in);
    END;
  END;
  xpar.outLen := out;

  RETURN 0;
END XpksPackChunk;


PROCEDURE XpksUnpackChunk * (xpar{8}: xs.XpkSubParamsPtr): LONGINT;
(* $SaveRegs+ *)
VAR
  i: INTEGER;
  get, put: BufferPtr;
  in, out: LONGINT;
  v: CHAR;
BEGIN
  get := xpar.inBuf;
  put := xpar.outBuf;
  in := 0; out := 0;
  LOOP
    i := ORD(get[in]);
    IF i = 0 THEN EXIT; END;
    INC(in);
    IF i > 0 THEN
      REPEAT
        put[out]:=get[in]; INC(out); INC(in);
        DEC(i);
      UNTIL i = 0;
    ELSE
      v := get[in]; INC(in);
      REPEAT
        put[out]:=v; INC(out);
        INC(i);
      UNTIL i = 0;
    END;
  END;
  RETURN 0;
END XpksUnpackChunk;

END xpkRLen.