Home > Delphi > RLE compression made simple

RLE compression made simple

October 14, 2013 Leave a comment Go to comments

This is my implementation of the good old RLE compression methods. I originally found some code for this in an old SWAG PDF and decided to extract and salvage what I could ā€“ so I cannot take full credit for these procedures, although almost every aspect of the code has been modernized. I also extended the prefetch to include byte, word, triplets and longwords (it was bytes only in the original code).

Notes

Added support for different data sizes. While the original code only supported bytes (ansi characters), this code can now compress datatypes ut to 4 bytes per sample. It works great on things such as Bitmap masks and 8bit bitmaps that include a lot of transparent or single color pixels.

uses math;

type
PJLTriple =^TJLTriple;
TJLTriple = Packed Record
  a,b,c:Byte;
End;

//#########################################################################
//  Method:     JL_RLEDeCompress()
//  Purpose:    De-Compress memory segment using the Run Length scheme
//  Returns:    Length of de-compressed data
//
//  Parameters:
//              Source:     PTR to input data
//              Target:     PTR to output data
//              TargetSize: Length of target buffer
//              Fetch:      Bytes per element
//
//  Comments:   See JL_RLECompress() for more info
//  Warning:    See JL_RLECompress() for more info
//#########################################################################
function  JL_RLEDecompress(const Source,Target;
          TargetSize:Longword;Fetch:Byte):Longword;
var
  I: Integer;
  SourcePtr,
  TargetPtr:  PByte;
  RunLength:  Longword;
  Counter:    Longword;

begin
  Result := 0;
  Counter := 0;
  TargetPtr := @Target;
  SourcePtr := @Source;

  While Counter<TargetSize do
  Begin
    RunLength := 1 + (SourcePtr^ and $7F);
    if SourcePtr^ > $7F then
    begin
      (* decode RLE packed byte *)
      Inc(SourcePtr);
      for I := 0 to RunLength - 1 do
      begin
        Case Fetch of
        1:  TargetPtr^:=SourcePtr^;
        2:  PWord(TargetPtr)^:=PWord(SourcePtr)^;
        3:  PJLTriple(TargetPtr)^:=PJLTriple(SourcePtr)^;
        4:  PLongword(TargetPtr)^:=PLongword(SourcePTR)^;
        end;
        Inc(TargetPtr,Fetch);
      end;
      Inc(SourcePtr, Fetch);
      Inc(Result, Fetch + 1);
    end else
    begin
      (* decode NON-RLE packet *)
      Inc(SourcePtr);
      Move(SourcePtr^,targetptr^,RunLength);
      inc(targetptr,RunLength);
      inc(sourceptr,RunLength);
      Inc(Result, RunLength + 1)
    end;
    Inc(Counter, RunLength);
  end;
end;

//#########################################################################
//  Method:     JLRLECompress()
//  Purpose:    Compress memory segment using the Run Length scheme
//  Returns:    Length of compressed data
//
//  Parameters:
//              Source: PTR to input data
//              Target: PTR to output data
//              Size:   Length of input data
//              Fetch:  Bytes per element (see comments below)
//
//  Comments:   RLE "compress" data by finding sequences of data
//              that contains the same value. The collection of sequences
//              is called a dictionary.
//              In order to build such a dictionary, the compressor needs
//              to know the size of each element being compressed.
//              With images, this is typically 1..4 bytes, depenting on
//              the pixel format (8bit=1, 15|16bit=2, 24Bit=3, 32Bit=4)
//              repeated sequences of information, such as bitmaps and
//  Warning:
//              RLE is not suitable for all types of data. In some cases
//              the output will be larger than input!
//              AS A RULE, Calculate the size of the output
//              buffer as: (input size*2 + 1)
//#########################################################################

function  JL_RLECompress(const Source,Target;
          SourceSize:Longword;Fetch:Byte):Longword;
var
  DiffCount:  Integer;
  SameCount:  Integer;
  SourcePtr:  PByte;
  TargetPtr:  PByte;

  Procedure GetElement(Const src;var outValue);
  begin
    Case Fetch of
    1:  PByte(@outValue)^:=PByte(@src)^;
    2:  PWord(@outValue)^:=PWord(@src)^;
    3:  PJLTriple(@outValue)^:=PJLTriple(@src)^;
    4:  PLongword(@outValue)^:=PLongword(@src)^;
    end;
  end;

  function CountUniqueElements(P:PByte;Count:Integer):Integer;
  var
    N:            Integer;
    Element:      Longword;
    NextElement:  Longword;
  begin
      N:=0;
      Element:=0;
      NextElement:=0;
    If Count=1 then
    result:=Count else
    Begin
      GetElement(P^,Element);
      while Count>1 do
      begin
        Inc(P,Fetch);
        GetElement(P^,NextElement);
        If NextElement=Element then
        Break;
        Element:=NextElement;
        inc(N);
        Dec(Count);
      end;
      if NextElement=Element then
      result:=N else
      result:=N + 1;
    end;
  end;

  function CountEqualElements(P:PByte;Count:Integer):Integer;
  var
    Element,
    NextElement: Cardinal;
  begin
    Result:=1;
    Element:=0;
    NextElement:=0;
    GetElement(P^,Element);
    Dec(Count);
    while Count>0 do
    begin
      Inc(P, Fetch);
      GetElement(P^,NextElement);
      if NextElement<>Element then
      Break;
      Inc(Result);
      Dec(Count);
    end;
  end;

begin
  Result:=0;
  SourcePtr := @Source;
  TargetPtr := @Target;
  while SourceSize > 0 do
  begin
    DiffCount := CountUniqueElements(SourcePtr,SourceSize);
    DiffCount:=math.EnsureRange(DiffCount,0,128);
    if DiffCount > 0 then
    begin
      (* create a raw, unaltered packet *)
      TargetPtr^:=DiffCount-1;
      Inc(TargetPtr);
      Dec(SourceSize, DiffCount);
      Move(targetPTR^,sourcePTR^,DiffCount);
      inc(SourcePtr,DiffCount);
      inc(TargetPTR,DiffCount);
      Inc(Result, (DiffCount * Fetch) + 1);
    end;

    SameCount := CountEqualElements(SourcePtr,SourceSize);
    SameCount:=math.EnsureRange(SameCount,0,128);
    if SameCount > 1 then
    begin
      (* create a RLE packet *)
      TargetPtr^ := (SameCount - 1) or $80; Inc(TargetPtr);
      Dec(SourceSize, SameCount);
      Inc(SourcePtr, (SameCount - 1) * Fetch);
      Inc(Result, Fetch + 1);

      TargetPtr^ := SourcePtr^;
      Inc(SourcePtr);
      Inc(TargetPtr);

      (* NOTE: We have already moved one byte, see above *)
      Case (Fetch-1) of
      1:  PByte(TargetPtr)^:=PByte(SourcePtr)^;
      2:  PWord(TargetPtr)^:=PWord(SourcePtr)^;
      3:  PJLTriple(TargetPtr)^:=PJLTriple(SourcePtr)^;
      end;

      inc(SourcePtr,Fetch-1);
      inc(TargetPTR,Fetch-1);
    end;
  end;
end;
Advertisements
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: