unit GraphicCompression;

// This file is part of the image library GraphicEx (www.lischke-online.de/Graphics.html).
//
// GraphicCompression contains various encoder/decoder classes used to handle compressed
// data in the various image classes.
//
// Currently supported methods are:
// - LZW (Lempel-Ziff-Welch)
//   + TIF
//   + GIF
// - RLE (run length encoding)
//   + TGA,
//   + PCX,
//   + TIFF packed bits
//   + SGI
//   + CUT
//   + RLA
//   + PSP
// - CCITT
//   + raw G3 (fax T.4)
//   + modified G3 (modified Huffman)
// - LZ77
//
// (c) Copyright 1999, 2000  Dipl. Ing. Mike Lischke (public@lischke-online.de). All rights reserved.
//
// This package is freeware for non-commercial use only.
// Contact author for licenses (shareware@lischke-online.de) and see License.txt which comes with the package.

interface

{$I GraphicConfiguration.inc}

uses
  Windows, Classes, SysUtils,
  ZLibC;  // general inflate/deflate and LZ77 compression support

type
  // abstract decoder class to define the base functionality of an encoder/decoder
  TDecoder = class
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); virtual; abstract;
    procedure DecodeEnd; virtual;
    procedure DecodeInit; virtual;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); virtual; abstract;
    procedure EncodeInit; virtual;
    procedure EncodeEnd; virtual;
  end;

  TTargaRLEDecoder = class(TDecoder)
  private
    FColorDepth: Cardinal;
  public
    constructor Create(ColorDepth: Cardinal); 
    
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  {$ifdef UseLZW}
  // Lempel-Ziff-Welch encoder/decoder class
  // TIFF LZW compression / decompression is a bit different to the common LZW code
  TTIFFLZWDecoder = class(TDecoder)
  private
    FCodeSize: Cardinal;
    FCodeMask: Cardinal;
    FFreeCode: Cardinal;
    FOldCode: Cardinal;
    FPrefix: array[0..4095] of Cardinal; // LZW prefix
    FSuffix,                             // LZW suffix
    FStack: array [0..4095] of Byte;     // stack
    FStackPointer: PByte;
    FTarget: PByte;
    FFirstChar: Byte;  // buffer for decoded byte
    FClearCode,
    FEOICode: Word;
    function DecodeLZW(Code: Cardinal): Boolean;
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;
  {$endif} // UseLZW

  TPackbitsRLEDecoder = class(TDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TPCXRLEDecoder = class(TDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TSGIRLEDecoder = class(TDecoder)
  private
    FSampleSize: Byte; // this value can be 1 (for 8 bits) or 2 (for 16 bits)
  public
    constructor Create(SampleSize: Byte);

    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TCUTRLEDecoder = class(TDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TPSPRLEDecoder = class(TDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  {$ifdef UseLZW}
  // Note: We need a different LZW decoder class for GIF because the bit order is reversed compared to that
  //       of TIFF and the code size increment is handled slightly different.
  TGIFLZWDecoder = class(TDecoder)
  private
    FCodeSize: Cardinal;
    FCodeMask: Cardinal;
    FFreeCode: Cardinal;
    FOldCode: Cardinal;
    FPrefix: array[0..4095] of Cardinal; // LZW prefix
    FSuffix,                             // LZW suffix
    FStack: array [0..4095] of Byte;     // stack
    FStackPointer: PByte;
    FTarget: PByte;
    FFirstChar: Byte;  // buffer for decoded byte
    FClearCode,
    FEOICode: Word;
    FInitialCodeSize: Byte;
    function DecodeLZW(Code: Cardinal): Boolean;
  public
    constructor Create(InitialCodeSize: Byte);

    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;
  {$endif} // UseLZW

  TRLADecoder = class(TDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TStateEntry = record
    NewState: array[Boolean] of Cardinal;
    RunLength: Integer;
  end;
  TStateArray = array of TStateEntry;

  TCCITTDecoder = class(TDecoder)
  private
    FOptions: Integer; // determines some options how to proceed
                       // Bit 0: if set then two-dimensional encoding was used, otherwise one-dimensional
                       // Bit 1: if set then data is uncompressed
                       // Bit 2: if set then fill bits are used before EOL codes so that EOL codes always end at
                       //        at a byte boundary (implicitly handled by state machine)
    FIsWhite,          // alternating flag used while coding
    FSwapBits: Boolean; // True if the order of all bits in a byte must be swapped
    FWhiteStates,
    FBlackStates: TStateArray;
    FWidth: Cardinal; // need to know how line length for modified huffman encoding

    // coding/encoding variables
    FBitsLeft,
    FMask,
    FBits: Byte;
    FPackedSize,
    FRestWidth: Cardinal;
    FSource,
    FTarget: PByte;
    FFreeTargetBits: Byte;
    procedure MakeStates;
  protected
    function FillRun(RunLength: Cardinal): Boolean;
    function FindBlackCode: Integer;
    function FindWhiteCode: Integer;
  public
    constructor Create(Options: Integer; SwapBits: Boolean; Width: Cardinal);
  end;

  TCCITTFax3Decoder = class(TCCITTDecoder)
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TCCITTMHDecoder = class(TCCITTDecoder) // modified Huffman
  private
  public
    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;
  end;

  TLZ77Decoder = class(TDecoder)
  private
    FStream: TZState;
    FZLibResult,         // returns the return code of the last ZLib operation
    FFlushMode: Integer; // one of flush constants declard in ZLib.pas
                         // this is usually Z_FINISH for PSP and Z_PARTIAL_FLUSH for PNG 
    function GetAvailableInput: Integer;
    function GetAvailableOutput: Integer;

  public
    constructor Create(FlushMode: Integer);

    procedure Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer); override;
    procedure DecodeEnd; override;
    procedure DecodeInit; override;
    procedure Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal); override;

    property AvailableInput: Integer read GetAvailableInput;
    property AvailableOutput: Integer read GetAvailableOutput;
    property ZLibResult: Integer read FZLibResult;
  end;

//----------------------------------------------------------------------------------------------------------------------

implementation

uses
  Math,
  GraphicStrings;

const // LZW encoding and decoding support
  NoLZWCode = 4096;

//----------------- TDecoder (generic decoder class) -------------------------------------------------------------------

procedure TDecoder.DecodeEnd;

begin
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDecoder.DecodeInit;

begin
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDecoder.EncodeEnd;

begin
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TDecoder.EncodeInit;

begin
end;

//----------------- TTargaRLEDecoder -----------------------------------------------------------------------------------

constructor TTargaRLEDecoder.Create(ColorDepth: Cardinal);

begin
  FColorDepth := ColorDepth;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TTargaRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

type
  PCardinalArray = ^TCardinalArray;
  TCardinalArray = array[0..MaxInt div 4 - 1] of Cardinal;

var
  I: Integer;
  SourcePtr,
  TargetPtr: PByte;
  RunLength: Cardinal;
  SourceCardinal: Cardinal;

begin
  TargetPtr := Dest;
  SourcePtr := Source;
  // unrolled decoder loop to speed up process
  case FColorDepth of
    8:
      while UnpackedSize > 0 do
      begin
        RunLength := 1 + (SourcePtr^ and $7F);
        if SourcePtr^ > $7F then
        begin
          Inc(SourcePtr);
          FillChar(TargetPtr^, RunLength, SourcePtr^);
          Inc(TargetPtr, RunLength);
          Inc(SourcePtr);
        end
        else
        begin
          Inc(SourcePtr);
          Move(SourcePtr^, TargetPtr^, RunLength);
          Inc(SourcePtr, RunLength);
          Inc(TargetPtr, RunLength);
        end;
        Dec(UnpackedSize, RunLength);
      end;
    15,
    16:
      while UnpackedSize > 0 do
      begin
        RunLength := 1 + (SourcePtr^ and $7F);
        if SourcePtr^ > $7F then
        begin
          Inc(SourcePtr);
          for I := 0 to RunLength - 1 do
          begin
            TargetPtr^ := SourcePtr^;
            Inc(SourcePtr);
            Inc(TargetPtr);
            TargetPtr^ := SourcePtr^;
            Dec(SourcePtr);
            Inc(TargetPtr);
          end;
          Inc(SourcePtr, 2);
        end
        else
        begin
          Inc(SourcePtr);
          Move(SourcePtr^, TargetPtr^, 2 * RunLength);
          Inc(SourcePtr, 2 * RunLength);
          Inc(TargetPtr, 2 * RunLength);
        end;
        Dec(UnpackedSize, RunLength);
      end;
    24:
      while UnpackedSize > 0 do
      begin
        RunLength := 1 + (SourcePtr^ and $7F);
        if SourcePtr^ > $7F then
        begin
          Inc(SourcePtr);
          for I := 0 to RunLength - 1 do
          begin
            TargetPtr^ := SourcePtr^;
            Inc(SourcePtr);
            Inc(TargetPtr);
            TargetPtr^ := SourcePtr^;
            Inc(SourcePtr);
            Inc(TargetPtr);
            TargetPtr^ := SourcePtr^;
            Dec(SourcePtr, 2);
            Inc(TargetPtr);
          end;
          Inc(SourcePtr, 3);
        end
        else
        begin
          Inc(SourcePtr);
          Move(SourcePtr^, TargetPtr^, 3 * RunLength);
          Inc(SourcePtr, 3 * RunLength);
          Inc(TargetPtr, 3 * RunLength);
        end;
        Dec(UnpackedSize, RunLength);
      end;
    32:
      while UnpackedSize > 0 do
      begin
        RunLength := 1 + (SourcePtr^ and $7F);
        if SourcePtr^ > $7F then
        begin
          Inc(SourcePtr);
          SourceCardinal := PCardinalArray(SourcePtr)[0];
          for I := 0 to RunLength - 1 do
            PCardinalArray(TargetPtr)[I] := SourceCardinal;

          Inc(TargetPtr, 4 * RunLength);
          Inc(SourcePtr, 4);
        end
        else
        begin
          Inc(SourcePtr);
          Move(SourcePtr^, TargetPtr^, 4 * RunLength);
          Inc(SourcePtr, 4 * RunLength);
          Inc(TargetPtr, 4 * RunLength);
        end;
        Dec(UnpackedSize, RunLength);
      end;
  end;
    
  Source := SourcePtr;
end;

//----------------------------------------------------------------------------------------------------------------------

function GetPixel(P: PByte; BPP: Byte): Cardinal;

// Retrieves a pixel value from a buffer. The actual size and order of the bytes is not important
// since we are only using the value for comparisons with other pixels.

begin
  Result := P^;
  Inc(P);
  Dec(BPP);
  while BPP > 0 do
  begin
    Result := Result shl 8;
    Result := Result or P^;
    Inc(P);
    Dec(BPP);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function CountDiffPixels(P: PByte; BPP: Byte; Count: Integer): Integer;

// counts pixels in buffer until two identical adjacent ones found

var
  N: Integer;
  Pixel,
  NextPixel: Cardinal;

begin
  N := 0;
  NextPixel := 0; // shut up compiler
  if Count = 1 then Result := Count
               else
  begin
    Pixel := GetPixel(P, BPP);
    while Count > 1 do
    begin
      Inc(P, BPP);
      NextPixel := GetPixel(P, BPP);
      if NextPixel = Pixel then Break;
      Pixel := NextPixel;
      Inc(N);
      Dec(Count);
    end;
    if NextPixel = Pixel then Result := N
                         else Result := N + 1;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function CountSamePixels(P: PByte; BPP: Byte; Count: Integer): Integer;

var
  Pixel,
  NextPixel: Cardinal;

begin
  Result := 1;
  Pixel := GetPixel(P, BPP);
  Dec(Count);
  while Count > 0 do
  begin
    Inc(P, BPP);
    NextPixel := GetPixel(P, BPP);
    if NextPixel <> Pixel then Break;
    Inc(Result);
    Dec(Count);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TTargaRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

// Encodes "Count" bytes pointed to by Source into the buffer supplied with Target and returns the
// number of bytes stored in Target. BPP denotes bytes per pixel color depth.
// Note: The target buffer must provide enough space to hold the compressed data. Using a size of
//       twice the size of the input buffer is sufficent.

var
  DiffCount, // pixel count until two identical
  SameCount: Integer; // number of identical adjacent pixels
  SourcePtr,
  TargetPtr: PByte;
  BPP: Integer;

begin
  BytesStored := 0;
  SourcePtr := Source;
  TargetPtr := Dest;
  BytesStored := 0;
  // +1 for 15 bits to get the correct 2 bytes per pixel
  BPP := (FColorDepth + 1) div 8;
  while Count > 0 do
  begin
    DiffCount := CountDiffPixels(SourcePtr, BPP, Count);
    SameCount := CountSamePixels(SourcePtr, BPP, Count);
    if DiffCount > 128 then DiffCount := 128;
    if SameCount > 128  then SameCount := 128;

    if DiffCount > 0 then
    begin
      // create a raw packet
      TargetPtr^ := DiffCount - 1; Inc(TargetPtr);
      Dec(Count, DiffCount);
      Inc(BytesStored, (DiffCount * BPP) + 1);
      while DiffCount > 0 do
      begin
        TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr);
        if BPP > 1 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
        if BPP > 2 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
        if BPP > 3 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
        Dec(DiffCount);
      end;
    end;

    if SameCount > 1 then
    begin
      // create a RLE packet
      TargetPtr^ := (SameCount - 1) or $80; Inc(TargetPtr);
      Dec(Count, SameCount);
      Inc(BytesStored, BPP + 1);
      Inc(SourcePtr, (SameCount - 1) * BPP);
      TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr);
      if BPP > 1 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
      if BPP > 2 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
      if BPP > 3 then begin TargetPtr^ := SourcePtr^; Inc(SourcePtr); Inc(TargetPtr); end;
    end;
  end;
end;

//----------------- TTIFFLZWDecoder ------------------------------------------------------------------------------------

{$ifdef UseLZW}

function TTIFFLZWDecoder.DecodeLZW(Code: Cardinal): Boolean;

var
  InCode: Cardinal; // buffer for passed code

begin
  // handling of clear codes
  if Code = FClearCode then
  begin
    // reset of all variables
    FCodeSize := 9;
    FCodeMask := (1 shl FCodeSize) - 1;
    FFreeCode := FClearCode + 2;
    FOldCode := NoLZWCode;
    Result := True;
    Exit;
  end;

  // check whether it is a valid, already registered code
  if Code > FFreeCode then
    raise Exception.Create('TIF LZW: invalid opcode.');

  // handling for the first LZW code: print and keep it
  if FOldCode = NoLZWCode then
  begin
    FFirstChar := FSuffix[Code];
    FTarget^ := FFirstChar;
    Inc(FTarget);
    FOldCode := Code;
    Result := True;
    Exit;
  end;

  // keep the passed LZW code
  InCode := Code;  

  // the first LZW code is always smaller than FFirstCode
  if Code = FFreeCode then
  begin
    FStackPointer^ := FFirstChar;
    Inc(FStackPointer);
    Code := FOldCode;
  end;

  // loop to put decoded bytes onto the stack
  while Code > FClearCode do
  begin
    FStackPointer^ := FSuffix[Code];
    Inc(FStackPointer);
    Code := FPrefix[Code];
  end;

  // place new code into code table
  FFirstChar := FSuffix[Code];
  FStackPointer^ := FFirstChar;
  Inc(FStackPointer);
  FPrefix[FFreeCode] := FOldCode;
  FSuffix[FFreeCode] := FFirstChar;
  if FFreeCode < 4096 then Inc(FFreeCode);

  // increase code size if necessary
  if (FFreeCode = FCodeMask) and
     (FCodeSize < 12) then
  begin
    Inc(FCodeSize);
    FCodeMask := (1 shl FCodeSize) - 1;
  end;

  // put decoded bytes (from the stack) into the target buffer
  FOldCode := InCode;
  repeat
    Dec(FStackPointer);
    FTarget^ := FStackPointer^;
    Inc(FTarget);
  until Cardinal(FStackPointer) <= Cardinal(@FStack);

  Result := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TTIFFLZWDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  I: Integer;
  Data,           // current data
  Bits,           // counter for bit management
  Code: Cardinal; // current code value
  SourcePtr: PByte;

begin
  FTarget := Dest;
  SourcePtr := Source;

  // initialize parameter
  FClearCode := 1 shl 8;
  FEOICode := FClearCode + 1;
  FFreeCode := FClearCode + 2;
  FOldCode := NoLZWCode;
  FCodeSize := 9;
  FCodeMask := (1 shl FCodeSize) - 1; 

  // init code table
  for I := 0 to FClearCode - 1 do
  begin
    FPrefix[I] := NoLZWCode;
    FSuffix[I] := I;
  end;

  // initialize stack
  FStackPointer := @FStack;

  Data := 0;
  Bits := 0;  
  for I := 0 to PackedSize - 1 do
  begin
    // read code from bit stream
    Inc(Data, Cardinal(SourcePtr^) shl (24 - Bits));
    Inc(Bits, 8);
    while Bits >= FCodeSize do
    begin
      // current code
      Code := (Data and ($FFFFFFFF - FCodeMask)) shr (32 - FCodeSize);
      // mask it
      Data := Data shl FCodeSize;
      Dec(Bits, FCodeSize);

      // EOICode -> decoding finished, check also for badly written codes and
      // terminate the loop as soon as the target is filled up
      if (Code = FEOICode) or
         ((PChar(FTarget) - PChar(Dest)) >= UnpackedSize) then Exit;

      if not DecodeLZW(Code) then Break;
    end;
    Inc(SourcePtr);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TTIFFLZWDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

{$endif} // UseLZW

//----------------- TPackbitsRLEDecoder --------------------------------------------------------------------------------

procedure TPackbitsRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

// decodes a simple run-length encoded strip of size PackedSize

var
  SourcePtr,
  TargetPtr: PByte;
  N: SmallInt;

begin
  TargetPtr := Dest;
  SourcePtr := Source;
  while PackedSize > 0 do
  begin
    N := ShortInt(SourcePtr^);
    Inc(SourcePtr);
    Dec(PackedSize);
    if N < 0 then // replicate next Byte -N + 1 times
    begin
      if N = -128 then Continue; // nop
      N := -N + 1;
      FillChar(TargetPtr^, N, SourcePtr^);
      Inc(SourcePtr);
      Inc(TargetPtr, N);
      Dec(PackedSize);
    end
    else
    begin // copy next N + 1 bytes literally
      Move(SourcePtr^, TargetPtr^, N + 1);
      Inc(TargetPtr, N + 1);
      Inc(SourcePtr, N + 1);
      Dec(PackedSize, N + 1);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TPackbitsRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TPCXRLEDecoder -------------------------------------------------------------------------------------

procedure TPCXRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  Count: Integer;
  SourcePtr,
  TargetPtr: PByte;

begin
  SourcePtr := Source;
  TargetPtr := Dest;
  while UnpackedSize > 0 do
  begin
    if (SourcePtr^ and $C0) = $C0 then
    begin
      // RLE-Code
      Count := SourcePtr^ and $3F;
      Inc(SourcePtr);
      if UnpackedSize < Count then Count := UnpackedSize;
      FillChar(TargetPtr^, Count, SourcePtr^);
      Inc(SourcePtr);
      Inc(TargetPtr, Count);
      Dec(UnpackedSize, Count);
    end
    else
    begin
      // not compressed
      TargetPtr^ := SourcePtr^;
      Inc(SourcePtr);
      Inc(TargetPtr);
      Dec(UnpackedSize);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TPCXRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TSGIRLEDecoder -------------------------------------------------------------------------------------

constructor TSGIRLEDecoder.Create(SampleSize: Byte);

begin
  FSampleSize := SampleSize;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TSGIRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  Source8,
  Target8: PByte;
  Source16,
  Target16: PWord;
  Pixel: Byte;
  Pixel16: Word;
  RunLength: Cardinal;

begin
  if FSampleSize = 1 then
  begin
    Source8 := Source;
    Target8 := Dest;
    while True do
    begin
      Pixel := Source8^;
      Inc(Source8);
      RunLength := Pixel and $7F;
      if RunLength = 0 then Break;

      if (Pixel and $80) <> 0 then
      begin
        Move(Source8^, Target8^, RunLength);
        Inc(Target8, RunLength);
        Inc(Source8, RunLength);
      end
      else
      begin
        Pixel := Source8^;
        Inc(Source8);
        FillChar(Target8^, RunLength, Pixel);
        Inc(Target8, RunLength);
      end;
    end;
  end
  else
  begin
    // 16 bits per sample
    Source16 := Source;
    Target16 := Dest;
    while True do
    begin
      // SGI images are stored in big endian style, swap this one repeater value for it
      Pixel16 := Swap(Source16^);
      Inc(Source16);
      RunLength := Pixel16 and $7F;
      if RunLength = 0 then Break;

      if (Pixel16 and $80) <> 0 then
      begin
        Move(Source16^, Target16^, 2 * RunLength);
        Inc(Source16^, RunLength);
        Inc(Target16^, RunLength);
      end
      else
      begin
        Pixel16 := Source16^;
        Inc(Source16);
        while RunLength > 0 do
        begin
          Target16^ := Pixel16;
          Inc(Target16);
          Dec(RunLength);
        end;
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TSGIRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TCUTRLE --------------------------------------------------------------------------------------------

procedure TCUTRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  TargetPtr: PByte;
  Pixel: Byte;
  RunLength: Cardinal;

begin
  TargetPtr := Dest;
  // skip first two bytes per row (I don't know their meaning)
  Inc(PByte(Source), 2);
  while True do
  begin
    Pixel := PByte(Source)^;
    Inc(PByte(Source));
    if Pixel = 0 then Break;

    RunLength := Pixel and $7F;
    if (Pixel and $80) = 0 then
    begin
      Move(Source^, TargetPtr^, RunLength);
      Inc(TargetPtr, RunLength);
      Inc(PByte(Source), RunLength);
    end
    else
    begin
      Pixel := PByte(Source)^;
      Inc(PByte(Source));
      FillChar(TargetPtr^, RunLength, Pixel);
      Inc(TargetPtr, RunLength);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TCUTRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TPSPRLEDecoder -------------------------------------------------------------------------------------

procedure TPSPRLEDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  SourcePtr,
  TargetPtr: PByte;
  RunLength: Cardinal;

begin
  SourcePtr := Source;
  TargetPtr := Dest;
  while PackedSize > 0 do
  begin
    RunLength := SourcePtr^;
    Inc(SourcePtr);
    Dec(PackedSize);
    if RunLength < 128 then
    begin
      Move(SourcePtr^, TargetPtr^, RunLength);
      Inc(TargetPtr, RunLength);
      Inc(SourcePtr, RunLength);
      Dec(PackedSize, RunLength);
    end
    else
    begin
      Dec(RunLength, 128);
      FillChar(TargetPtr^, RunLength, SourcePtr^);
      Inc(SourcePtr);
      Inc(TargetPtr, RunLength);
      Dec(PackedSize);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TPSPRLEDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TGIFLZWDecoder -------------------------------------------------------------------------------------

{$ifdef UseLZW}

constructor TGIFLZWDecoder.Create(InitialCodeSize: Byte);

begin
  FInitialCodeSize := InitialCodeSize;
end;

//----------------------------------------------------------------------------------------------------------------------

function TGIFLZWDecoder.DecodeLZW(Code: Cardinal): Boolean;

var
  InCode: Cardinal; // buffer for passed code

begin
  // handling of clear codes
  if Code = FClearCode then
  begin
    // reset of all variables
    FCodeSize := FInitialCodeSize + 1;
    FCodeMask := (1 shl FCodeSize) - 1;
    FFreeCode := FClearCode + 2;
    FOldCode := NoLZWCode;
    Result := True;
    Exit;
  end;

  // check whether it is a valid, already registered code
  if Code > FFreeCode then
    raise Exception.Create('GIF LZW: invalid opcode.');
  
  // handling for the first LZW code: print and keep it
  if FOldCode = NoLZWCode then
  begin
    FFirstChar := FSuffix[Code];
    FTarget^ := FFirstChar;
    Inc(FTarget);
    FOldCode := Code;
    Result := True;
    Exit;
  end;

  // keep the passed LZW code
  InCode := Code;  

  // the first LZW code is always smaller than FFirstCode
  if Code = FFreeCode then
  begin
    FStackPointer^ := FFirstChar;
    Inc(FStackPointer);
    Code := FOldCode;
  end;

  // loop to put decoded bytes onto the stack
  while Code > FClearCode do
  begin
    FStackPointer^ := FSuffix[Code];
    Inc(FStackPointer);
    Code := FPrefix[Code];
  end;

  // place new code into code table
  FFirstChar := FSuffix[Code];
  FStackPointer^ := FFirstChar;
  Inc(FStackPointer);
  FPrefix[FFreeCode] := FOldCode;
  FSuffix[FFreeCode] := FFirstChar;

  // increase code size if necessary
  if (FFreeCode = FCodeMask) and
     (FCodeSize < 12) then
  begin
    Inc(FCodeSize);
    FCodeMask := (1 shl FCodeSize) - 1;
  end;
  if FFreeCode < 4095 then Inc(FFreeCode);

  // put decoded bytes (from the stack) into the target buffer
  FOldCode := InCode;
  repeat
    Dec(FStackPointer);
    FTarget^ := FStackPointer^;
    Inc(FTarget);
  until FStackPointer = @FStack;

  Result := True;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGIFLZWDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  I: Integer;
  Data,           // current data
  Bits,           // counter for bit management
  Code: Cardinal; // current code value
  SourcePtr: PByte;

begin
  FTarget := Dest;
  SourcePtr := Source;

  // initialize parameter
  FCodeSize := FInitialCodeSize + 1;
  FClearCode := 1 shl FInitialCodeSize;
  FEOICode := FClearCode + 1;
  FFreeCode := FClearCode + 2;
  FOldCode := NoLZWCode;
  FCodeMask := (1 shl FCodeSize) - 1;

  // init code table
  for I := 0 to FClearCode - 1 do
  begin
    FPrefix[I] := NoLZWCode;
    FSuffix[I] := I;
  end;

  // initialize stack
  FStackPointer := @FStack;

  Data := 0;
  Bits := 0;
  while PackedSize > 0 do
  begin
    // read code from bit stream
    Inc(Data, SourcePtr^ shl Bits);
    Inc(Bits, 8);
    while Bits >= FCodeSize do
    begin
      // current code
      Code := Data and FCodeMask;
      // prepare next run
      Data := Data shr FCodeSize;
      Dec(Bits, FCodeSize);

      // EOICode -> decoding finished, check also for badly written codes and
      // terminate the loop as soon as the target is filled up
      if (Code = FEOICode) or
         ((PChar(FTarget) - PChar(Dest)) >= UnpackedSize) then Exit;

      if not DecodeLZW(Code) then Break;
    end;
    Inc(SourcePtr);
    Dec(PackedSize);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGIFLZWDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

{$endif}

//----------------- TRLADecoder ----------------------------------------------------------------------------------------

procedure TRLADecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

// decodes a simple run-length encoded strip of size PackedSize
// this is very similar to TPackbitsRLEDecoder

var
  SourcePtr,
  TargetPtr: PByte;
  N: SmallInt;

begin
  TargetPtr := Dest;
  SourcePtr := Source;
  while PackedSize > 0 do
  begin
    N := ShortInt(SourcePtr^);
    Inc(SourcePtr);
    Dec(PackedSize);
    if N >= 0 then // replicate next Byte N + 1 times
    begin
      FillChar(TargetPtr^, N + 1, SourcePtr^);
      Inc(TargetPtr, N + 1);
      Inc(SourcePtr);
      Dec(PackedSize);
    end
    else
    begin // copy next -N bytes literally
      Move(SourcePtr^, TargetPtr^, -N);
      Inc(TargetPtr, -N);
      Inc(SourcePtr, -N);
      Inc(PackedSize, N);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TRLADecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TCCITTDecoder --------------------------------------------------------------------------------------

constructor TCCITTDecoder.Create(Options: Integer; SwapBits: Boolean; Width: Cardinal);

begin
  FOptions := Options;
  FSwapBits := SwapBits;
  FWidth := Width;
  MakeStates;
end;

//----------------------------------------------------------------------------------------------------------------------
 
const
  // 256 bytes to make bit reversing easy,
  // this is actually not much more than writing bit manipulation code, but much faster
  ReverseTable: array[0..255] of Byte = (
    $00, $80, $40, $C0, $20, $A0, $60, $E0,
    $10, $90, $50, $D0, $30, $B0, $70, $F0,
    $08, $88, $48, $C8, $28, $A8, $68, $E8,
    $18, $98, $58, $D8, $38, $B8, $78, $F8,
    $04, $84, $44, $C4, $24, $A4, $64, $E4,
    $14, $94, $54, $D4, $34, $B4, $74, $F4,
    $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC,
    $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC,
    $02, $82, $42, $C2, $22, $A2, $62, $E2,
    $12, $92, $52, $D2, $32, $B2, $72, $F2,
    $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA,
    $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,
    $06, $86, $46, $C6, $26, $A6, $66, $E6,
    $16, $96, $56, $D6, $36, $B6, $76, $F6,
    $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE,
    $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE,
    $01, $81, $41, $C1, $21, $A1, $61, $E1,
    $11, $91, $51, $D1, $31, $B1, $71, $F1,
    $09, $89, $49, $C9, $29, $A9, $69, $E9,
    $19, $99, $59, $D9, $39, $B9, $79, $F9,
    $05, $85, $45, $C5, $25, $A5, $65, $E5,
    $15, $95, $55, $D5, $35, $B5, $75, $F5,
    $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED,
    $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,
    $03, $83, $43, $C3, $23, $A3, $63, $E3,
    $13, $93, $53, $D3, $33, $B3, $73, $F3,
    $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB,
    $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB,
    $07, $87, $47, $C7, $27, $A7, $67, $E7,
    $17, $97, $57, $D7, $37, $B7, $77, $F7,
    $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF,
    $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF
  );

  G3_EOL = -1;

//----------------------------------------------------------------------------------------------------------------------

function TCCITTDecoder.FillRun(RunLength: Cardinal): Boolean;

// fills a number of bits with 1s (for black, white only increments pointers),
// returns True if the line has been filled entirely, otherwise False

var
  Run: Cardinal;

begin
  Run := Min(FFreeTargetBits, RunLength);
  // fill remaining bits in the current byte
  if Run in [1..7] then
  begin
    Dec(FFreeTargetBits, Run);
    if not FIsWhite then FTarget^ := FTarget^ or (((1 shl Run) - 1) shl FFreeTargetBits);
    if FFreeTargetBits = 0 then
    begin
      Inc(FTarget);
      FFreeTargetBits := 8;
    end;
    Run := RunLength - Run;
  end
  else Run := RunLength;

  // fill entire bytes whenever possible
  if Run > 0 then
  begin
    if not FIsWhite then FillChar(FTarget^, Run div 8, $FF);
    Inc(FTarget, Run div 8);
    Run := Run mod 8;
  end;

  // finally fill remaining bits
  if Run > 0 then
  begin
    FFreeTargetBits := 8 - Run;
    if not FIsWhite then FTarget^ := ((1 shl Run) - 1) shl FFreeTargetBits;
  end;

  // this will throw an exception if the sum of the run lengths for a row is not
  // exactly the row size (the documentation speaks of an unrecoverable error)
  if Cardinal(RunLength) > FRestWidth then RunLength := FRestWidth;
  Dec(FRestWidth, RunLength);
  Result := FRestWidth = 0;
end;

//----------------------------------------------------------------------------------------------------------------------

function TCCITTDecoder.FindBlackCode: Integer;

// Executes the state machine to find the run length for the next bit combination.
// Returns the run length of the found code.

var
  State,
  NewState: Cardinal;
  Bit: Boolean;
  
begin
  State := 0;
  Result := 0;
  repeat
    // advance to next byte in the input buffer if necessary
    if FBitsLeft = 0 then
    begin
      if FPackedSize = 0 then Break;
      FBits := FSource^;
      Inc(FSource);
      Dec(FPackedSize);
      FMask := $80;
      FBitsLeft := 8;
    end;
    Bit := (FBits and FMask) <> 0;

    // advance the state machine
    NewState := FBlackStates[State].NewState[Bit];
    if NewState = 0 then
    begin
      Inc(Result, FBlackStates[State].RunLength);
      if FBlackStates[State].RunLength < 64 then Break
                                            else
      begin
        NewState := FBlackStates[0].NewState[Bit];
      end;
    end;
    State := NewState;

    // address next bit
    FMask := FMask shr 1;
    if FBitsLeft > 0 then Dec(FBitsLeft);
  until False;
end;

//----------------------------------------------------------------------------------------------------------------------

function TCCITTDecoder.FindWhiteCode: Integer;

// Executes the state machine to find the run length for the next bit combination.
// Returns the run length of the found code.

var
  State,
  NewState: Cardinal;
  Bit: Boolean;

begin
  State := 0;
  Result := 0;
  repeat
    // advance to next byte in the input buffer if necessary
    if FBitsLeft = 0 then
    begin
      if FPackedSize = 0 then Break;
      FBits := FSource^;
      Inc(FSource);
      Dec(FPackedSize);
      FMask := $80;
      FBitsLeft := 8;
    end;
    Bit := (FBits and FMask) <> 0;

    // advance the state machine
    NewState := FWhiteStates[State].NewState[Bit];
    if NewState = 0 then
    begin
      // a code has been found
      Inc(Result, FWhiteStates[State].RunLength);
      // if we found a terminating code then exit loop, otherwise continue
      if FWhiteStates[State].RunLength < 64 then Break
                                            else
      begin
        // found a make up code, continue state machine with current bit (rather than reading the next one)
        NewState := FWhiteStates[0].NewState[Bit];
      end;
    end;
    State := NewState;

    // address next bit
    FMask := FMask shr 1;
    if FBitsLeft > 0 then Dec(FBitsLeft);
  until False;
end;

//----------------------------------------------------------------------------------------------------------------------

type
  TCodeEntry = record
    Code, Len: Cardinal;
  end;

const // CCITT code tables
  WhiteCodes: array[0..116] of TCodeEntry = (
    (Code : $0035; Len : 8),
    (Code : $0007; Len : 6),
    (Code : $0007; Len : 4),
    (Code : $0008; Len : 4),
    (Code : $000B; Len : 4),
    (Code : $000C; Len : 4),
    (Code : $000E; Len : 4),
    (Code : $000F; Len : 4),
    (Code : $0013; Len : 5),
    (Code : $0014; Len : 5),
    (Code : $0007; Len : 5),
    (Code : $0008; Len : 5),
    (Code : $0008; Len : 6),
    (Code : $0003; Len : 6),
    (Code : $0034; Len : 6),
    (Code : $0035; Len : 6),
    (Code : $002A; Len : 6),
    (Code : $002B; Len : 6),
    (Code : $0027; Len : 7),
    (Code : $000C; Len : 7),
    (Code : $0008; Len : 7),
    (Code : $0017; Len : 7),
    (Code : $0003; Len : 7),
    (Code : $0004; Len : 7),
    (Code : $0028; Len : 7),
    (Code : $002B; Len : 7),
    (Code : $0013; Len : 7),
    (Code : $0024; Len : 7),
    (Code : $0018; Len : 7),
    (Code : $0002; Len : 8),
    (Code : $0003; Len : 8),
    (Code : $001A; Len : 8),
    (Code : $001B; Len : 8),
    (Code : $0012; Len : 8),
    (Code : $0013; Len : 8),
    (Code : $0014; Len : 8),
    (Code : $0015; Len : 8),
    (Code : $0016; Len : 8),
    (Code : $0017; Len : 8),
    (Code : $0028; Len : 8),
    (Code : $0029; Len : 8),
    (Code : $002A; Len : 8),
    (Code : $002B; Len : 8),
    (Code : $002C; Len : 8),
    (Code : $002D; Len : 8),
    (Code : $0004; Len : 8),
    (Code : $0005; Len : 8),
    (Code : $000A; Len : 8),
    (Code : $000B; Len : 8),
    (Code : $0052; Len : 8),
    (Code : $0053; Len : 8),
    (Code : $0054; Len : 8),
    (Code : $0055; Len : 8),
    (Code : $0024; Len : 8),
    (Code : $0025; Len : 8),
    (Code : $0058; Len : 8),
    (Code : $0059; Len : 8),
    (Code : $005A; Len : 8),
    (Code : $005B; Len : 8),
    (Code : $004A; Len : 8),
    (Code : $004B; Len : 8),
    (Code : $0032; Len : 8),
    (Code : $0033; Len : 8),
    (Code : $0034; Len : 8),
    (Code : $001B; Len : 5),
    (Code : $0012; Len : 5),
    (Code : $0017; Len : 6),
    (Code : $0037; Len : 7),
    (Code : $0036; Len : 8),
    (Code : $0037; Len : 8),
    (Code : $0064; Len : 8),
    (Code : $0065; Len : 8),
    (Code : $0068; Len : 8),
    (Code : $0067; Len : 8),
    (Code : $00CC; Len : 9),
    (Code : $00CD; Len : 9),
    (Code : $00D2; Len : 9),
    (Code : $00D3; Len : 9),
    (Code : $00D4; Len : 9),
    (Code : $00D5; Len : 9),
    (Code : $00D6; Len : 9),
    (Code : $00D7; Len : 9),
    (Code : $00D8; Len : 9),
    (Code : $00D9; Len : 9),
    (Code : $00DA; Len : 9),
    (Code : $00DB; Len : 9),
    (Code : $0098; Len : 9),
    (Code : $0099; Len : 9),
    (Code : $009A; Len : 9),
    (Code : $0018; Len : 6),
    (Code : $009B; Len : 9),
    (Code : $0008; Len : 11),
    (Code : $000C; Len : 11),
    (Code : $000D; Len : 11),
    (Code : $0012; Len : 12),
    (Code : $0013; Len : 12),
    (Code : $0014; Len : 12),
    (Code : $0015; Len : 12),
    (Code : $0016; Len : 12),
    (Code : $0017; Len : 12),
    (Code : $001C; Len : 12),
    (Code : $001D; Len : 12),
    (Code : $001E; Len : 12),
    (Code : $001F; Len : 12),
    // EOL codes
    (Code : $0001; Len : 12),
    (Code : $0001; Len : 13),
    (Code : $0001; Len : 14),
    (Code : $0001; Len : 15),
    (Code : $0001; Len : 16),
    (Code : $0001; Len : 17),
    (Code : $0001; Len : 18),
    (Code : $0001; Len : 19),
    (Code : $0001; Len : 20),
    (Code : $0001; Len : 21),
    (Code : $0001; Len : 22),
    (Code : $0001; Len : 23),
    (Code : $0001; Len : 24)
  );

  BlackCodes: array[0..116] of TCodeEntry = (
    (Code : $0037; Len : 10),
    (Code : $0002; Len : 3),
    (Code : $0003; Len : 2),
    (Code : $0002; Len : 2),
    (Code : $0003; Len : 3),
    (Code : $0003; Len : 4),
    (Code : $0002; Len : 4),
    (Code : $0003; Len : 5),
    (Code : $0005; Len : 6),
    (Code : $0004; Len : 6),
    (Code : $0004; Len : 7),
    (Code : $0005; Len : 7),
    (Code : $0007; Len : 7),
    (Code : $0004; Len : 8),
    (Code : $0007; Len : 8),
    (Code : $0018; Len : 9),
    (Code : $0017; Len : 10),
    (Code : $0018; Len : 10),
    (Code : $0008; Len : 10),
    (Code : $0067; Len : 11),
    (Code : $0068; Len : 11),
    (Code : $006C; Len : 11),
    (Code : $0037; Len : 11),
    (Code : $0028; Len : 11),
    (Code : $0017; Len : 11),
    (Code : $0018; Len : 11),
    (Code : $00CA; Len : 12),
    (Code : $00CB; Len : 12),
    (Code : $00CC; Len : 12),
    (Code : $00CD; Len : 12),
    (Code : $0068; Len : 12),
    (Code : $0069; Len : 12),
    (Code : $006A; Len : 12),
    (Code : $006B; Len : 12),
    (Code : $00D2; Len : 12),
    (Code : $00D3; Len : 12),
    (Code : $00D4; Len : 12),
    (Code : $00D5; Len : 12),
    (Code : $00D6; Len : 12),
    (Code : $00D7; Len : 12),
    (Code : $006C; Len : 12),
    (Code : $006D; Len : 12),
    (Code : $00DA; Len : 12),
    (Code : $00DB; Len : 12),
    (Code : $0054; Len : 12),
    (Code : $0055; Len : 12),
    (Code : $0056; Len : 12),
    (Code : $0057; Len : 12),
    (Code : $0064; Len : 12),
    (Code : $0065; Len : 12),
    (Code : $0052; Len : 12),
    (Code : $0053; Len : 12),
    (Code : $0024; Len : 12),
    (Code : $0037; Len : 12),
    (Code : $0038; Len : 12),
    (Code : $0027; Len : 12),
    (Code : $0028; Len : 12),
    (Code : $0058; Len : 12),
    (Code : $0059; Len : 12),
    (Code : $002B; Len : 12),
    (Code : $002C; Len : 12),
    (Code : $005A; Len : 12),
    (Code : $0066; Len : 12),
    (Code : $0067; Len : 12),
    (Code : $000F; Len : 10),
    (Code : $00C8; Len : 12),
    (Code : $00C9; Len : 12),
    (Code : $005B; Len : 12),
    (Code : $0033; Len : 12),
    (Code : $0034; Len : 12),
    (Code : $0035; Len : 12),
    (Code : $006C; Len : 13),
    (Code : $006D; Len : 13),
    (Code : $004A; Len : 13),
    (Code : $004B; Len : 13),
    (Code : $004C; Len : 13),
    (Code : $004D; Len : 13),
    (Code : $0072; Len : 13),
    (Code : $0073; Len : 13),
    (Code : $0074; Len : 13),
    (Code : $0075; Len : 13),
    (Code : $0076; Len : 13),
    (Code : $0077; Len : 13),
    (Code : $0052; Len : 13),
    (Code : $0053; Len : 13),
    (Code : $0054; Len : 13),
    (Code : $0055; Len : 13),
    (Code : $005A; Len : 13),
    (Code : $005B; Len : 13),
    (Code : $0064; Len : 13),
    (Code : $0065; Len : 13),
    (Code : $0008; Len : 11),
    (Code : $000C; Len : 11),
    (Code : $000D; Len : 11),
    (Code : $0012; Len : 12),
    (Code : $0013; Len : 12),
    (Code : $0014; Len : 12),
    (Code : $0015; Len : 12),
    (Code : $0016; Len : 12),
    (Code : $0017; Len : 12),
    (Code : $001C; Len : 12),
    (Code : $001D; Len : 12),
    (Code : $001E; Len : 12),
    (Code : $001F; Len : 12),
    // EOL codes
    (Code : $0001; Len : 12),
    (Code : $0001; Len : 13),
    (Code : $0001; Len : 14),
    (Code : $0001; Len : 15),
    (Code : $0001; Len : 16),
    (Code : $0001; Len : 17),
    (Code : $0001; Len : 18),
    (Code : $0001; Len : 19),
    (Code : $0001; Len : 20),
    (Code : $0001; Len : 21),
    (Code : $0001; Len : 22),
    (Code : $0001; Len : 23),
    (Code : $0001; Len : 24)
  );

procedure TCCITTDecoder.MakeStates;

// creates state arrays for white and black codes
// These state arrays are so designed that they have at each state (starting with state 0) a new state index
// into the same array according to the bit for which the state is current.

  //--------------- local functions -------------------------------------------

  procedure AddCode(var Target: TStateArray; Bits: Cardinal; BitLen, RL: Integer);

  // interprets the given string as a sequence of bits and makes a state chain from it

  var
    State,
    NewState: Integer;
    Bit: Boolean;

  begin
    // start state
    State := 0;
    // prepare bit combination (bits are given right align, but must be scanned from left)
    Bits := Bits shl (32 - BitLen);
    while BitLen > 0 do
    begin
      // determine next state according to the bit string
      asm
        SHL [Bits], 1
        SETC [Bit]
      end;
      NewState := Target[State].NewState[Bit];
      // Is it a not yet assigned state?
      if NewState = 0 then
      begin
        // if yes then create a new state at the end of the array
        NewState := Length(Target);
        Target[State].NewState[Bit] := NewState;
        SetLength(Target, Length(Target) + 1);
      end;
      State := NewState;

      Dec(BitLen);
    end;
    // at this point State indicates the final state where we must store the run length for the
    // particular bit combination
    Target[State].RunLength := RL;
  end;

  //--------------- end local functions ---------------------------------------

var
  I: Integer;

begin
  // set an initial entry in each state array
  SetLength(FWhiteStates, 1);
  SetLength(FBlackStates, 1);

  // with codes
  for I := 0 to 63 do
    with WhiteCodes[I] do AddCode(FWhiteStates, Code, Len, I);
  for I := 64 to 102 do
    with WhiteCodes[I] do AddCode(FWhiteStates, Code, Len, (I - 63) * 64);
  for I := 103 to 116 do
    with WhiteCodes[I] do AddCode(FWhiteStates, Code, Len, G3_EOL);

  // black codes
  for I := 0 to 63 do
    with BlackCodes[I] do AddCode(FBlackStates, Code, Len, I);
  for I := 64 to 102 do
    with BlackCodes[I] do AddCode(FBlackStates, Code, Len, (I - 63) * 64);
  for I := 103 to 116 do
    with BlackCodes[I] do AddCode(FBlackStates, Code, Len, G3_EOL);
end;

//----------------- TCCITTFax3Decoder ----------------------------------------------------------------------------------

procedure TCCITTFax3Decoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  RunLength: Integer;

  //--------------- local functions -------------------------------------------

  procedure AdjustEOL;

  begin
    FIsWhite := False;
    if FFreeTargetBits in [1..7] then Inc(FTarget);
    FFreeTargetBits := 8;
    FRestWidth := FWidth;
  end;

  //--------------- end local functions ---------------------------------------

begin  
  // make all bits white
  FillChar(Dest^, UnpackedSize, 0);

  // swap all bits here, in order to avoid frequent tests in the main loop
  if FSwapBits then
  asm
         PUSH EBX
         LEA EBX, ReverseTable
         MOV ECX, [PackedSize]
         MOV EDX, [Source]
         MOV EDX, [EDX]
  @@1:
         MOV AL, [EDX]
         XLAT
         MOV [EDX], AL
         INC EDX
         DEC ECX
         JNZ @@1
         POP EBX
  end;

  // setup initial states
  // a row always starts with a (possibly zero-length) white run
  FIsWhite := True;
  FSource := Source;
  FBitsLeft := 0;
  FPackedSize := PackedSize;

  // target preparation
  FTarget := Dest;
  FRestWidth := FWidth;
  FFreeTargetBits := 8;

  // main loop
  repeat
    if FIsWhite then RunLength := FindWhiteCode
                else RunLength := FindBlackCode;
    if RunLength > 0 then
    begin
      if FillRun(RunLength) then AdjustEOL;
    end
    else
      if RunLength = G3_EOL then AdjustEOL;
      
    FIsWhite := not FIsWhite;
  until FPackedSize = 0;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TCCITTFax3Decoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TCCITTMHDecoder ------------------------------------------------------------------------------------

procedure TCCITTMHDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  RunLength: Integer;

  //--------------- local functions -------------------------------------------

  procedure AdjustEOL;

  begin
    FIsWhite := False;
    if FFreeTargetBits in [1..7] then Inc(FTarget);
    FFreeTargetBits := 8;
    FRestWidth := FWidth;
    if FBitsLeft < 8 then FBitsLeft := 0; // discard remaining bits
  end;

  //--------------- end local functions ---------------------------------------

begin
  // make all bits white
  FillChar(Dest^, UnpackedSize, 0);

  // swap all bits here, in order to avoid frequent tests in the main loop
  if FSwapBits then 
  asm
         PUSH EBX
         LEA EBX, ReverseTable
         MOV ECX, [PackedSize]
         MOV EDX, [Source]
         MOV EDX, [EDX]
  @@1:
         MOV AL, [EDX]
         XLAT
         MOV [EDX], AL
         INC EDX
         DEC ECX
         JNZ @@1
         POP EBX
  end;

  // setup initial states
  // a row always starts with a (possibly zero-length) white run
  FIsWhite := True;
  FSource := Source;
  FBitsLeft := 0;
  FPackedSize := PackedSize;

  // target preparation
  FTarget := Dest;
  FRestWidth := FWidth;
  FFreeTargetBits := 8;

  // main loop
  repeat
    if FIsWhite then RunLength := FindWhiteCode
                else RunLength := FindBlackCode;
    if RunLength > 0 then
      if FillRun(RunLength) then AdjustEOL;
    FIsWhite := not FIsWhite;
  until FPackedSize = 0;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TCCITTMHDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TLZ77Decoder ---------------------------------------------------------------------------------------

constructor TLZ77Decoder.Create(FlushMode: Integer);

begin
  FillChar(FStream, SizeOf(FStream), 0);
  FFlushMode := FlushMode;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

begin
  FStream.NextInput := Source;
  FStream.AvailableInput := PackedSize;
  FStream.NextOutput := Dest;
  FStream.AvailableOutput := UnpackedSize;
  FZLibResult := Inflate(FStream, FFlushMode);
  // advance pointers so used input can be calculated
  Source := FStream.NextInput;
  Dest := FStream.NextOutput;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.DecodeEnd;

begin
  if InflateEnd(FStream) < 0 then raise Exception.Create('LZ77 decompression error.');
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.DecodeInit;

begin
  if InflateInit(FStream) < 0 then raise Exception.Create('LZ77 decompression error.');
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------------------------------------------------------------------------------------------------------------

function TLZ77Decoder.GetAvailableInput: Integer;

begin
  Result := FStream.AvailableInput;
end;

//----------------------------------------------------------------------------------------------------------------------

function TLZ77Decoder.GetAvailableOutput: Integer;

begin
  Result := FStream.AvailableOutput;
end;

//----------------------------------------------------------------------------------------------------------------------

end.