rsvk/Component/StreamStrucAriEncoderUnit.pas

170 lines
4.2 KiB
Plaintext
Raw Permalink Normal View History

2020-09-21 18:06:13 -05:00
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.