unit LZRW1_EIS;
(*=====================================================================
  Classes:   LZRW1KHCompressor

  File:      LZRW1_EIS.pas

  Summary:
    LZRW1_EIS.pas contains a class, which is use the  LZRW1/KH algoritm for
    compressing and decompressing.

    LZRW1 algoritm was interpreted as an extremely fast data compression one
    by Ross N. Williams. The LZRW1KH variant is fast and easy working
    compressing algoritm, which was published by Kurt HAENEN.
    I have the oldest C source from 1991 of it, too.

    Later Kurt HAENEN also published an updated version for Turbo Pascal,
    too. This Pascal version was modified for working securely and with Delphi
    by Danny Heijl. His code was applied for Herbert J.Beemster's UBitmap, which
    was the base of my TUniBitmap component. The LZRW1KH.pas was slightly
    modified for using in Kylix environment by me.

    The present Delphi.NET implementation is based on experiences with codes,
    while the core of the algoritm remained. That's why the decompressing
    resulted the same uncompressed file even the binary result of compressing
    a file might be different with this class and with the latest VCL-based
    Object Pascal implementation of Delphi version. So, the compression and
    decompression with this Class are crossuseable with its PAS
    (as many as I could implement under .NET). Even with
    LZRSave... and LZRLoad... methods of the mentioned TUniBitmap.

    This implementation also use BitWise (bitwiseclass.pas).

---------------------------------------------------------------------
  This file is submitted by:

  endresy@axelero.hu
  Endre I. Simay,
  Hungary

THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
PARTICULAR PURPOSE.
=====================================================================*)

interface
uses
  System.IO,
  bitwiseclass;

type

  LZRW1KHCompressor = class
  private
    BufferMaxSize: integer;
    BufferIO: integer;
    FLAG_Copied: byte;
    FLAG_Compress: byte;
    BufferArray: TBytes;
    MaxHashElements: integer;

    Hash: array of Int16;
    Fbitwise: BitWise;

    function GetMatch(X: integer): boolean;

  public
 // "WRZL" but will give a LZRW signature in file;
    LZRWIdentifier: UInt32;
 // "LZRW" but will give a WRZL signature in file.
 // So, it used in compatibility reason only;
    OldIdentifier: UInt32;

    Source,
      Destination: TBytes;

    SourceSize,
      ChunkSize: word;

    constructor Create;
    function Compression: integer;
    function Decompression: integer;

  end;

implementation
 /// <summary>
 /// Summary description for Class.
 /// </summary>

 // giving as global variables to prevent class from /unsafe
 // compiling for using pointers (var in PAS)

var
  Size,
    Pos: integer;

constructor LZRW1KHCompressor.Create;
var
  i: integer;
begin
  inherited;
  Size := 0;
  Pos := 0;

  BufferMaxSize := 32768;
  BufferIO := BufferMaxSize + 16;
  FLAG_Copied := $80;
  FLAG_Compress := $40;

 // "WRZL" but will give a LZRW signature in file;
  LZRWIdentifier := $57525A4C;
 // "LZRW" but will give a WRZL signature in file.
 // So, it used in compatibility reason only;
  OldIdentifier := $4C5A5257;

 //Buffer;
 //    extra bytes needed here if compression fails      *dh *
  SetLength(BufferArray, BufferIO);

  MaxHashElements := 4096;

  SetLength(Hash, MaxHashElements);

  Fbitwise := BitWise.Create;

  SetLength(Source, 32768 + 16);
  SetLength(Destination, 32768 + 16);

  SourceSize := BufferMaxSize;
  ChunkSize := BufferMaxSize;

  //
  // TODO: Add constructor logic here
  //
  for i := 0 to MaxHashElements - 1 do
  begin
    Hash[i] := Int16(-$7FFF);
  end;
end;

function LZRW1KHCompressor.GetMatch(X: integer): boolean;
var
  HashValue: word;
  TmpHash: integer;
begin
  Result := false;
  HashValue :=
    word((40543 * word(Fbitwise.bitwiseshr(UInt32(((Fbitwise.bitwiseshl(
    UInt32(((Fbitwise.bitwiseshl(UInt32(Source[X]), 4)) xor Source[X + 1])), 4))
    xor Source[X + 2])), 4))) and $0FFF);

  TmpHash := Hash[HashValue];
  if ((TmpHash <> -1) and ((X - TmpHash) < 4096)) then
  begin
    Pos := TmpHash;
    Size := 0;
    while ((Size < 18) and (Source[X + Size] = Source[Pos + Size])
      and ((X + Size) < SourceSize)) do
    begin
      Inc(Size);
    end;
    Result := (Size >= 3);
  end;
  Hash[HashValue] := Int16(X);
end;

function LZRW1KHCompressor.Compression: integer;
var
  Bit,
    Command: word;
  i,
    Key,
    X,
    Y,
    Z: integer;
begin
  Key := 0;
  Pos := 0;
  Size := 0;

  for i := 0 to MaxHashElements - 1 do
  begin
    Hash[i] := (-$7FFF);
  end;

  Destination[0] := FLAG_Compress;
  X := 0;
  Y := 3;
  Z := 1;
  Bit := 0;
  Command := 0;

  while ((X < SourceSize) and (Y <= SourceSize)) do
  begin
    if (Bit > 15) then
    begin
      Destination[Z] := Fbitwise.bitwiseHI(word(Command));
      Destination[Z + 1] := Fbitwise.bitwiseLO(word(Command));
      Z := Y;
      Bit := 0;
      Inc(Y, 2);
    end;
    Size := 1;

    while ((Source[X] = Source[X + Size]) and (((Size < $FFF) and ((X + Size) < SourceSize)))) do
    begin
      Inc(Size);
    end;

    if (Size >= 16) then
    begin
      Destination[Y] := 0;
      Destination[Y + 1] := Fbitwise.bitwiseHI(word(Size - 16));
      Destination[Y + 2] := Fbitwise.bitwiseLO(word(Size - 16));
      Destination[Y + 3] := Source[X];
      Inc(Y, 4);
      Inc(X, Size);
      Command := word((Fbitwise.bitwiseshl(word(Command), 1) + 1));
    end
    else // not size >= 16
    begin
      if (GetMatch(X)) then
      begin
        Key := ((Fbitwise.bitwiseshl(word((X - Pos)), 4)) + (Size - 3));
        Destination[Y] := Fbitwise.bitwiseHI(word(Key));
        Destination[Y + 1] := Fbitwise.bitwiseLO(word(Key));
        Inc(Y, 2);
        Inc(X, Size);
        Command := word((Fbitwise.bitwiseshl(word(Command), 1) + 1));
      end
      else
      begin
        Destination[Y] := Source[X];
        Inc(Y);
        Inc(X);
        Command := Fbitwise.bitwiseshl(word(Command), 1);
      end;
    end; // size <= 16
    Inc(Bit);
  end; //  while x < sourcesize ...
  Command := Fbitwise.bitwiseshl(word(Command), word(16 - Bit));
  Destination[Z] := Fbitwise.bitwiseHI(word(Command));
  Destination[Z + 1] := Fbitwise.bitwiseLO(word(Command));
  if (Y > SourceSize) then
  begin
   // equivalent with MOVE(Source[0], Dest[1], SourceSize);
    for i := 0 to SourceSize - 1 do
    begin
      Destination[i + 1] := Source[i];
    end;
    Destination[0] := FLAG_Copied;
    Y := (SourceSize + 1);
  end;
  Result := Y;
end;
 //end of compression

function LZRW1KHCompressor.Decompression: integer;
var
  Command,
    K: word;
  X, Y,
    SaveY: integer; // * dh * unsafe for-loop variable Y
  Bit: byte;
  L: Uint32;
begin
  Command := 0;
  X := 0;
  Bit := 0;
  Size := 0;
  Pos := 0;
  SaveY := 0; // * dh * unsafe for-loop variable Y

  if (Source[0] = FLAG_Copied) then
  begin
    for Y := 1 to SourceSize - 1 do
    begin
      Destination[Y - 1] := Source[Y];
      SaveY := Y;
    end;
    Y := SaveY;
  end
  else
  begin
    Y := 0;
    X := 3;
    Command := word(Fbitwise.bitwiseshl(UInt32(Source[1]), 8) + Source[2]);
    Bit := 16;
    while (X < SourceSize) do
    begin
      if (Bit = 0) then
      begin
        Command := word(Fbitwise.bitwiseshl(UInt32(Source[X]), 8) + Source[X + 1]);
        Bit := 16;
        Inc(X, 2);
      end;
      if (word(Command and $8000) = 0) then
      begin
        Destination[Y] := Source[X];
        Inc(X);
        Inc(Y);
      end
      else //command and $8000
      begin
        Pos := integer(Fbitwise.bitwiseshl(UInt32(Source[X]), 4)
          + Fbitwise.bitwiseshr(UInt32(Source[X + 1]), 4));

        if (Pos = 0) then
        begin
          Size := integer(Fbitwise.bitwiseshl(UInt32(Source[X + 1]), 8) + Source[X + 2] + 15);
          for K := 0 to Size do
          begin
            Destination[Y + K] := Source[X + 3];
          end;
          Inc(X, 4);
          Inc(Y, (Size + 1));
        end
        else //pos = 0
        begin
          L := UInt32(Source[X + 1]); // because of operand-problem
          Size := integer(L and $0F) + 2;
          for K := 0 to Size do
          begin
            Destination[Y + K] := Destination[Y - Pos + K];
          end;
          Inc(X, 2);
          Inc(Y, (Size + 1));

        end; //pos = 0
      end; // command and $8000
      Command := Fbitwise.bitwiseshl(Command, 1);
      Bit := Bit - 1;
    end; // while x < sourcesize
  end;
  Result := Y;
end;
 // end of decompression

end.
