IMPLEMENTATION MODULE Packer;

(** ------------------------------------------------------------------

                 Commodore Amiga Data Compresser module

      (c) Copyright 1986 Modula-2 Software Ltd.  All Rights Reserved
      (c) Copyright 1986 TDI Software, Inc.      All Rights Reserved

    ------------------------------------------------------------------ **)


(* VERSION FOR COMMODORE AMIGA

     Original Author : Jerry Morrison, Steve Shaw, Electronic Arts  11-Nov-85

     Modifications   : Paul Curtis, Modula-2 Software Ltd.  02-Jun-86
                         Converted C source into implementation module.

     Version         : 1.00a  18-Nov-86 Martin Fisher Modula-2 Software Ltd.
                         Tested and debugged.
                       0.00a  02-Jun-86  Paul Curtis, Modula-2 Software Ltd.
                         Original, untested.

  *)


  (*$S-,$T-*)


  FROM SYSTEM IMPORT ADDRESS;

  TYPE
    Mode = (DUMP, RUN);

  CONST
    MinRun = 3;
    MaxRun = 128;
    MaxDat = 128;

  VAR
    putSize: LONGCARD;
    buf: ARRAY [0..255] OF CHAR;   (* [TBD] should be 128?  on stack? *)

  TYPE
    CharPtr = POINTER TO CHAR;


  PROCEDURE MaxPackedSize(rowSize: LONGCARD): LONGCARD;
  BEGIN
    RETURN rowSize + (rowSize+127) DIV 128
  END MaxPackedSize;


  PROCEDURE PutByte(VAR dest: CharPtr; c: CHAR);
  BEGIN
    dest^ := c;
    INC(dest);
    INC(putSize)
  END PutByte;

  PROCEDURE PutDump(VAR dest: CharPtr; nn: INTEGER);
  VAR i: INTEGER;
  BEGIN
    PutByte(dest,CHAR(nn-1));
    FOR i := 0 TO nn-1 DO
      PutByte(dest,buf[i])
    END
  END PutDump;

  PROCEDURE PutRun(VAR dest: ADDRESS; nn: INTEGER; cc: CHAR);
  BEGIN
    PutByte(dest,CHAR(-(nn-1)));
    PutByte(dest,cc)
  END PutRun;

  PROCEDURE PackRow(VAR pSource, pDest : ADDRESS ; rowSize: LONGCARD): LONGCARD;
  VAR
    source, dest: CharPtr;
    c, lastc: CHAR;
    mode: Mode;
    nbuf: INTEGER;  (* number of chars in buffer *)
    rstart: INTEGER;  (* buffer index current run starts *)

  BEGIN
    mode := DUMP;
    nbuf := 0;
    rstart := 0;
    source := CharPtr(pSource);
    dest := CharPtr(pDest) ;
    putSize := 0;
    c := source^; INC(source);
    lastc := c;  (* so we have valid lastc *)
    buf[0] := c;
    nbuf := 1;  DEC(rowSize);  (* since one byte eaten. *)
    WHILE rowSize > 0 DO
      c := source^; INC(source);
      buf[nbuf] := c; INC(nbuf);
      CASE mode OF
        DUMP: 
          (* If the buffer is full, write the length byte,
             then the data *)
          IF nbuf > MaxDat THEN
            PutDump(dest,nbuf-1);
            buf[0] := c; 
            nbuf := 1;  rstart := 0; 
          ELSIF c = lastc THEN
            IF nbuf-rstart >= MinRun THEN
              IF rstart > 0 THEN PutDump(dest,rstart) END;
              mode := RUN;
            ELSIF rstart = 0 THEN
              mode := RUN;   (* no dump in progress,
                               so can't lose by making these 2 a run. *)
            END;
          ELSE  rstart := nbuf-1;  (* first of run *)
          END;
      | RUN:
          IF (c # lastc) OR (nbuf-rstart > MaxRun) THEN
            (* output run *)
            PutRun(dest,nbuf-1-rstart,lastc);
            buf[0] := c;
            nbuf := 1; rstart := 0;
            mode := DUMP;
          END;
      END;
      lastc := c;
      DEC(rowSize);
    END;
    CASE mode OF
      DUMP: PutDump(dest,nbuf)
    | RUN:  PutRun(dest,nbuf-rstart,lastc)
    END;

    pSource := source;
    pDest := dest;

    RETURN putSize
  END PackRow;


  PROCEDURE UnPackRow(VAR pSource, pDest: ADDRESS;
                         srcBytes0, dstBytes0: LONGCARD): BOOLEAN;
  VAR srcBytes, dstBytes: LONGINT;
    source, dest: POINTER TO CHAR;
    c: CHAR;
    n: INTEGER;
    error: BOOLEAN;
  BEGIN
    source := pSource;
    dest := pDest;
    error := TRUE;
    srcBytes := srcBytes0;
    dstBytes := dstBytes0;
    LOOP
      IF dstBytes <= 0 THEN error := FALSE; EXIT END; (* success! *)
      DEC(srcBytes);
      IF srcBytes < 0 THEN EXIT (* error *) END;
      n := INTEGER(source^); IF n >= 128 THEN DEC(n,256) END;
      INC(source);
      IF n >= 0 THEN
        INC(n);
        DEC(srcBytes,n); IF (srcBytes < 0) THEN EXIT (* error *) END;
        DEC(dstBytes,n); IF (dstBytes < 0) THEN EXIT (* error *) END;
        REPEAT
          dest^ := source^; INC(source); INC(dest);
          DEC(n);
        UNTIL n <= 0;
      ELSIF n # -128 THEN
        n := (-n) + 1;
        DEC(srcBytes); IF (srcBytes < 0) THEN EXIT (* error *) END;
        DEC(dstBytes,n); IF (dstBytes < 0) THEN EXIT (* error *) END;
        c := source^; INC(source);
        REPEAT
          dest^ := c; INC(dest);
          DEC(n)
        UNTIL n <= 0
      END
    END;
    pSource := source;  pDest := dest;
    RETURN error
  END UnPackRow;


END Packer.