RLEencode.pas

unit RLEencode; // Version 1.00

(*
  Copyright 2025 by James Hughes

Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the “Software”), to deal in
the Software without restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the
Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*)

interface
uses Classes;
procedure EncodeRLEStream(ThisStream: TMemoryStream);

implementation

const
  BufferMax = 125;

type
  tRLEmode = (undetermined, duplicate, unique);
  tRLEbuffer = array[1..BufferMax+1] of byte;

procedure WriteRLEBuffer(TargetStream : TMemoryStream; RLEmode : tRLEmode; var RLEbuffer : tRLEbuffer; RLEcounter : integer); // uses mode, Buffer, BuffCount -or- DupCount
var BuffLoop : integer;
    j : integer;
begin
  if RLEmode = duplicate then
  begin
    j := 1 - RLEcounter;
    TargetStream.Write(j, 1);
    TargetStream.Write(RLEbuffer[1], 1);
  end;
  if RLEmode = unique then
  begin // mode = unique
    dec(RLEcounter);
    TargetStream.Write(RLEcounter, 1);
    for BuffLoop := 1 to RLEcounter+1 do TargetStream.Write(RLEbuffer[BuffLoop], 1);
  end;
  if RLEmode = undetermined then
  begin // treat as unique
    dec(RLEcounter);
    TargetStream.Write(RLEcounter, 1);
    for BuffLoop := 1 to RLEcounter+1 do TargetStream.Write(RLEbuffer[BuffLoop], 1);
  end;
end; // of procedure WriteRLEBuffer

procedure EncodeRLEStream(ThisStream: TMemoryStream);
var //EncodeByte : shortint;    // signed 8-bit number
    NextByte : byte = 0;
    BuffCount, DupCount : integer;
    Buffer: tRLEbuffer;
    mode : tRLEmode;
    TemporaryStream : TMemoryStream;

begin
  TemporaryStream := TMemoryStream.create;
  ThisStream.Position := 0; // move to beginning of buffer
  mode := undetermined;
  BuffCount := 0; DupCount := 0;
  while ThisStream.Position < (ThisStream.Size) do
  begin
    ThisStream.Read(NextByte, 1); // read one byte
    if mode = undetermined
    then begin
      if BuffCount = 0
      then begin // first byte to be looked at this time around
        BuffCount := 1;
        Buffer[1] := NextByte;
        DupCount := 1;
      end
      else begin // second byte to be looked at this time around
        if NextByte = Buffer[1]
        then begin // second byte is the same... let's use duplicate mode
          mode := duplicate;
          inc(DupCount);
        end
        else begin // second byte is different... let's use unique mode
          mode := unique;
          inc(BuffCount);
          Buffer[BuffCount] := NextByte; // put in buffer for now.. may have to remove if it turns out to be the first byte of a duplication run
        end;
      end;
    end
    else begin // mode has been determined
      if mode = duplicate
      then begin // in duplicate mode
        if NextByte = Buffer[1]
        then begin // continue adding duplicates
          inc(DupCount);
          if DupCount = BufferMax then
          begin
            WriteRLEBuffer(TemporaryStream, mode, Buffer, DupCount);
            Mode := undetermined; BuffCount := 0; DupCount := 0;
          end;
        end
        else begin// we have been in duplicate mode but this byte is different
          WriteRLEBuffer(TemporaryStream, mode, Buffer, DupCount);
          mode := undetermined; // we must start over with the new byte
          BuffCount := 1;
          Buffer[1] := NextByte;
          DupCount := 1;
        end;
      end
      else begin // in unique mode
        if NextByte = Buffer[BuffCount]
        then begin // we have been in unique mode but this byte is a duplicate
          dec(BuffCount);
          WriteRLEBuffer(TemporaryStream, mode, Buffer, BuffCount);
          mode := duplicate;
          BuffCount := 1;
          Buffer[1] := NextByte;
          DupCount := 2;
        end
        else begin // continue adding uniques
          inc(BuffCount);
          Buffer[BuffCount] := NextByte;
          if BuffCount = BufferMax then
          begin
            WriteRLEBuffer(TemporaryStream, mode, Buffer, BuffCount);
            Mode := undetermined; BuffCount := 0; DupCount := 0;
          end;
        end;
      end;
    end; // end of 'mode has been determined'
  end; // end of while loop
  if mode = duplicate
  then WriteRLEBuffer(TemporaryStream, mode, Buffer, DupCount)
  else WriteRLEBuffer(TemporaryStream, mode, Buffer, BuffCount);

// add checksum value

// replace original stream with decoded stream
  ThisStream.clear;
  TemporaryStream.SaveToStream(ThisStream);
  TemporaryStream.destroy;
end;

end.