unit StreamStrucAriEncoderUnit;
{-------------------------------------------------------------------------------
Stream 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 Stream.
  Handles the output to the Stream by implementing OutputBit/OutputBits.
  Very similar to FileStrucAriEncoder because it's ported from there.

  procedure EncodeBlock(_Stream: TStream; 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, BitStreamUnit;


type
  {For Stream out, must implement Bit Buffer }
  TStreamAriEncoder = class(TStrucAriEncoder)
  protected
    BitStream: TBitStream;
    procedure OutputBit(bit: byte); override;
    procedure OutputBits(code: longint; count: byte); override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure EncodeBlock(_Stream: TStream; block: PBlock; block_length: integer;
      var OutSize: integer);
  end;


(**) implementation (**)

{ TStreamAriEncoder }

constructor TStreamAriEncoder.Create;
begin
  inherited Create;
end;

destructor TStreamAriEncoder.Destroy;
begin
  inherited;
end;

procedure TStreamAriEncoder.EncodeBlock(_Stream: TStream; block: PBlock;
  block_length: integer; var OutSize: integer);
var
  i, j: longint;
  run_length: integer;
  mask, num_bits: integer;
  StartPos: integer;
begin
  StartPos := _Stream.Position;
  BitStream := TBitStream.Create(_Stream, false);
  BitStream.BeginBitWriteAccess;
  StartEncoding;

  i := 0;
  while (i < block_length) do
  begin

    {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;
  BitStream.EndBitWriteAccess;
  OutSize := _Stream.Position - StartPos;
end;

procedure TStreamAriEncoder.OutputBit(bit: byte);
begin
  BitStream.OutputBit(bit);
  //ShowMessage('asdf');
end;

procedure TStreamAriEncoder.OutputBits(code: Integer; count: byte);
begin
  { Not Implemented }
end;

end.