IMPLEMENTATION MODULE MemCompress;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/memcompr.mov   1.5   10 Mar 1991 15:29:32   coleb  $
 *
 *
 *  Written and contributed by Doug Whitfield of Hornby Island,
 *  British Columbia.
 *
 *)


  IMPORT SYSTEM;
  IMPORT LowLevel;
  IMPORT VStorage;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      LowLevel.Init();
      VStorage.Init();
    END Init;


(* These procedures perform run-length coding compression and
decompression of memory blocks.  InAddress and InSize are input
parameters specifing the starting address and length (in bytes)
of the memory block to be compressed or decompressed.  If
OutAlloc is TRUE, OutAddress and OutSize are taken as input
parameters by Compress and the compressed block is put at the
specified location.  If OutAlloc is FALSE, Compress attempts to
allocate memory for the compressed block. If the allocation
fails, the compression is abandoned and Compress returns the
value FALSE with ErrorFlag set to AllocationFailed.  If the
allocation is successful, Compress returns the allocated area's
address and size.  The maximum size of memory block it will
allocate is InSize bytes.  If, during compression, the compressed
block exceeds the specified  OutSize (when OutAlloc is TRUE) or
InSize (when OutAlloc is FALSE), the compression is abandoned and
Compress returns the value FALSE, with ErrorFlag set to
CompressedTooLarge.  (A compressed block can exceed the size of
the uncompressed block from which it is derived if the latter
contains characters with ordinal value 254, as this value is used
as a designator for the start of a run, and isolated occurences
of this character must be translated into two successive
characters to avoid ambiguity.)  If compression is successfully
completed, Compress returns the value TRUE with ErrorFlag set to
NoCompressError.

Decompress performs no error testing, and thus assumes that the
size of memory specified to receive the decompressed block is
sufficiently large.  If Decompress is called with OutSize equal
to the value of InSize used during compression, this will be
true.

Compress will yield a useful degree of compression if the input
memory block contains runs of successive bytes containing the
same value.  Such may be the case, for example, in CGA and EGA
graphics mode screen images. *)


  TYPE
    Address8086 =
      RECORD
        CASE : CARDINAL OF
          1 :
          a : SYSTEM.ADDRESS;
         |2 :
          b : POINTER TO CHAR;
        END;
      END;

  VAR
    NewCharOrd, OldCharOrd, TempOutSize: CARDINAL;
    InCount, OutCount, RunCount, MaxRunCount, CharOrd, Index:
        CARDINAL;
    InAddress, OutAddress: SYSTEM.ADDRESS;
    InCharPointer, OutCharPointer: Address8086;
    Char: CHAR;

  PROCEDURE GetChar():CARDINAL;
  BEGIN
    Char := InCharPointer.b^;
    LowLevel.IncAddr( InCharPointer.a, 1 );
    INC (InCount);
    RETURN ORD(Char);
  END GetChar;

  PROCEDURE PutChar (CharOrd:CARDINAL);
  BEGIN
    Char := CHR (CharOrd);
    OutCharPointer.b^ := Char;
    LowLevel.IncAddr( OutCharPointer.a, 1 );
    INC(OutCount);
  END PutChar;

  PROCEDURE CompOut (CharOrd:CARDINAL;RunCount:CARDINAL);
  BEGIN
    IF CharOrd = 254 THEN
      IF RunCount > 1 THEN
        PutChar(254); PutChar(RunCount); PutChar(254)
      ELSE
        PutChar(254); PutChar(254)
      END (*IF*);
    ELSE
      IF RunCount = 1 THEN
        PutChar(CharOrd)
      ELSIF RunCount = 2 THEN
        PutChar(CharOrd); PutChar(CharOrd)
      ELSE
        PutChar(254); PutChar(RunCount);PutChar(CharOrd)
      END (*IF*);
    END (*IF*);
  END CompOut;

  PROCEDURE Compress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL;
                 VAR OutAddress: SYSTEM.ADDRESS; VAR OutSize:CARDINAL;
                 OutAlloc:BOOLEAN):BOOLEAN;
  BEGIN
    ErrorFlag := Corruption;
    IF NOT OutAlloc THEN
      IF VStorage.DosAvail (InSize + 5) THEN
        VStorage.DosAlloc(OutAddress, InSize + 5);
        TempOutSize := InSize
      ELSE
        ErrorFlag := AllocationFailed;
        RETURN FALSE;
      END;
    ELSE
      TempOutSize := OutSize
    END;
    InCharPointer.a := InAddress; OutCharPointer.a := OutAddress;
    InCount := 0; OutCount :=0;
    OldCharOrd := GetChar();
    LOOP
      RunCount := 1;
      MaxRunCount := InSize - InCount + 1;
      IF MaxRunCount > 253 THEN MaxRunCount := 253 END;
      LOOP
        NewCharOrd :=GetChar();
        IF NewCharOrd = OldCharOrd THEN
          INC (RunCount);
          IF RunCount = MaxRunCount THEN EXIT END
        ELSE
          EXIT
        END (*IF*)
      END (*LOOP*);
      CompOut (OldCharOrd,RunCount);
      IF OutCount >= TempOutSize THEN;
        IF NOT OutAlloc THEN
          VStorage.DosDealloc(OutAddress,InSize + 5);
        END;
        ErrorFlag := CompressedTooLarge;
        RETURN FALSE
      END;
      OldCharOrd := NewCharOrd;
      IF InCount = InSize THEN
        IF RunCount # MaxRunCount THEN CompOut (OldCharOrd,1) END;
        EXIT
      END (*IF*)
    END (*LOOP*);
    IF NOT OutAlloc THEN
      OutSize := OutCount;
      VStorage.DosDealloc(OutCharPointer.a,InSize + 5 - OutSize);
    END;
    ErrorFlag := NoCompressError;
    RETURN TRUE;

  END Compress;

  PROCEDURE Decompress (InAddress: SYSTEM.ADDRESS; InSize:CARDINAL;
                 OutAddress: SYSTEM.ADDRESS; OutSize:CARDINAL);
  BEGIN
    InCharPointer.a := InAddress; OutCharPointer.a := OutAddress;
    InCount := 0; OutCount := 0;
    WHILE InCount < InSize DO
      CharOrd := GetChar();
      IF CharOrd = 254 THEN
        RunCount := GetChar();
        IF RunCount = 254 THEN
          PutChar (254)
        ELSE
          CharOrd := GetChar();
          FOR Index := 1 TO RunCount DO
            PutChar (CharOrd);
          END (*FOR*)
        END (*IF*);
      ELSE
        PutChar (CharOrd)
      END (*IF*)
    END (*WHILE*);
    OutSize := OutCount;
  END Decompress;

BEGIN
  Initialized := FALSE;
  Init();
END MemCompress.