packer.pas

(****************************************************************************
 *                    Modula-2 Software Construction Set                    *
 *                         (c) 1986 by Leon Frenkel                         *
 ****************************************************************************
 * Name: Packer.MOD                        Version: Amiga.00.00             *
 * Created: 04/20/87   Updated: 12/25/87   Author: Leon Frenkel             *
 * Description: This module implements the run compression algorithm        *
 *  "cmpByteRun1"; the same encoding generated by Mac's PackBits.           *
 *	control bytes:                                                      *
 *	 [0..127]   : followed by n+1 bytes of data.                        *
 *	 [-1..-127] : followed by byte to be repeated (-n)+1 times.         *
 *	 -128       : NOOP.                                                 *
 ****************************************************************************)

Unit Packer;

interface
type
 pointertoByte = ^Byte;

function PackRow( pSource, pDest: pointertobyte; rowSize: CARDINAL): LONGINT;

implementation
CONST
  DUMP = 0;
  RUN  = 1;

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

VAR
  putSize : CARDINAL;
  buf     : ARRAY [0..255] OF BYTE;
  source  : pointertobyte;
  dest    : pointertobyte;

(* ======== PRIVATE ======= *)

PROCEDURE OutDump(nn: INTEGER);
VAR
  i : INTEGER;
BEGIN
  dest^ := BYTE(nn - 1);  INC(dest);  INC(putSize);
  i := 0;
  WHILE i < nn DO
  begin
    dest^ := buf[i];  INC(dest);  INC(putSize);
    INC(i);
  END;
END;

PROCEDURE OutRun(nn: INTEGER; cc: BYTE);
BEGIN
  dest^ := BYTE(-(nn-1)); INC(dest); INC(putSize);
  dest^ := cc; INC(dest); INC(putSize);
END;


(* ======== PUBLIC ======= *)

Function MaxPackedSize(rowSize: CARDINAL): CARDINAL;
BEGIN
  MaxPackedSize:= (rowSize + (((rowSize) + 127) DIV 128));
END;

Function PackRow( pSource, pDest: pointertobyte; rowSize: CARDINAL): LONGINT;
VAR
  c, lastc     : BYTE;
  mode         : CARDINAL;
  nbuf         : CARDINAL; 	(* number of chars in buffer *)
  rstart       : CARDINAL;	(* buffer index current run starts *)
BEGIN
  mode := DUMP;
  rstart := 0;
  source := pSource;
  dest := pDest;
  putSize := 0;
  c := source^;  INC(source); (* so have valid lastc *)
  lastc := c;
  buf[0] := c;
  nbuf := 1;
  DEC(rowSize);		(* since on byte eaten *)

  WHILE rowSize <> 0 DO
  begin
    c := source^;  INC(source);
    buf[nbuf] := c;  INC(nbuf);
    IF mode = DUMP THEN
    begin
      (* If the buffer is full, write the length byte, then the data *)
      IF nbuf > MaxDat THEN
      begin
        OutDump(nbuf-1);
        buf[0] := c;
        nbuf := 1; rstart := 0;
      end
      ELSE IF CARDINAL(c) = CARDINAL(lastc) THEN
      begin
        IF nbuf-rstart >= MinRun THEN
        begin
          IF rstart > 0 THEN
          begin
            OutDump(rstart);
          END;
          mode := RUN;
        end
        ELSE IF rstart = 0 THEN
        begin
          (* no dump in progress, so can't lose by making these 2 a run. *)
          mode := RUN;
        END;
      end
      ELSE
      begin
        rstart := nbuf - 1; (* first of run *)
      END;
    end
    ELSE IF mode = RUN THEN
    begin
      IF (CARDINAL(c) <> CARDINAL(lastc)) OR (nbuf-rstart > MaxRun) THEN
      begin
        (* output run *)
        OutRun(nbuf-1-rstart, lastc);
        buf[0] := c;
        nbuf := 1; rstart := 0;
        mode := DUMP;
      END;
    END;
    lastc := c;

    DEC(rowSize);
  END;

  IF mode = DUMP THEN
  begin
    OutDump(nbuf);
  end
  ELSE IF mode = RUN THEN
  begin
    OutRun(nbuf-rstart, lastc);
  END;
  pSource := source;
  pDest := dest;
  PackRow:=putSize;
END;



begin
end.