unit FileStrucAriEncoderUnit;
{-------------------------------------------------------------------------------
File Structured Arithmetic Encoder Unit
---------------------------------------

reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg


  Desc:
  Derives from Structured arithmetic encoder to allow it to write to files.
  Handles the output to the archive file by implementing OutputBit/OutputBits.

  procedure EncodeBlock(block: PBlock; block_length: integer);
  Encodes the block with block length block_length.
  Will encode the block with an EOF symbol trailing.


  To Use:
  Create it.
  Call EncodeBlock
  Free.
-------------------------------------------------------------------------------}

(**) interface (**)
uses Classes, dialogs,
     // general
     StructsUnit,
     // base class
     StrucAriEncoderUnit, GroupAriModelUnit, ArchiveFileUnit, BitStreamUnit;


type
  TFileStrucAriEncoder = class(TStrucAriEncoder)
  protected
    ArchiveFile: TArchiveFile;  // required by OutputBit
    procedure OutputBit(bit: byte); override;
    procedure OutputBits(code: longint; count: byte); override;

  public
    constructor Create;
    destructor Destroy; override;

    procedure EncodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; block_length: integer);
  end;


(**) implementation (**)

constructor TFileStrucAriEncoder.Create;
begin
  inherited Create;
  //ArchiveFile := _ArchiveFile;
end;

destructor TFileStrucAriEncoder.Destroy;
begin
  //ArchiveFile.ResetBuffer;
  inherited Destroy;
end;

procedure TFileStrucAriEncoder.OutputBit(bit: byte);
begin
  ArchiveFile.OutputBit(bit);
end;

procedure TFileStrucAriEncoder.OutputBits(code: longint; count: byte);
begin
  ArchiveFile.OutputBits(code, count);
end;

procedure TFileStrucAriEncoder.EncodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; block_length: integer);
var
  i, j: longint;
  run_length: integer;
  mask, num_bits: integer;
begin
  ArchiveFile := _ArchiveFile;
  ArchiveFile.BeginBitWriteAccess;
  StartEncoding;
  i := 0;
  while (i < block_length) do
  begin
    {DEBUG panick case: plain encode}
    //EncodeSymbol(block^[i]);

    {Convert the ascii to symbols.
     symbols 0 and 1 represent runs of 0s.
     symbols 2 - 256 represent ascii 1-255 repectively.
     symbol 257 is the EOB}


    if (block^[i] = 0) then
    begin
      {Wheeler's run length coding.
       convert to runs of 0s
       Algo: Count run_length, or number of 0s (run length includes init byte
             Increment run_length by one
             Ignore most significant one bit and encode run_length
             as ordinary binary number}


      {count run length and inc i. min run_length will be 1}
      run_length := 0;
      repeat
        inc(i);
        inc(run_length);
      until (i >= block_length) or (block^[i] <> 0);
      //if (i > block_length) then ShowMessage('Hello');

      {increment by 1}
      inc(run_length);

      {find the most significant 1 bit and count the number of bits
      to output in num_bits}
      num_bits := 32;
      mask := 1 shl 31;
      while (run_length and mask = 0) do
      begin
        mask := mask shr 1;
        dec(num_bits);
      end;

      {ignore most significant 1 bit}
      dec(num_bits);

      {output the number as an ordinary binary number from the lsb}
      mask := 1;
      for j := 1 to num_bits do
      begin
        if (run_length and mask <> 0) then
          EncodeSymbol(1)
        else
          EncodeSymbol(0);

        mask := mask shl 1;
      end;


      {DEBUG: Test no run length coding. code 0s directly.
              The value 1 should not appear at all}
      {EncodeSymbol(0);
      inc(i);}

      {i will have been set to the next character during the run_length count}
    end
    else
    begin
      {increment the ascii by 1 to get the symbol}
      EncodeSymbol(block^[i]+1);
      inc(i);
    end;

  end; {While}

  EncodeSymbol(EOF_SYMBOL);
  DoneEncoding;
  ArchiveFile.EndBitWriteAccess;
end;



end.