abdfstrm.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  if (BufferCount = 0) then
    Result := false

  {otherwise there is data to be processed}
  else begin
    Result := true;

    {if we didn't read anything from the stream, we need to make sure
     that enough buffer is zeroed out so that reading longint values
     don't produce (dreadfully) bogus values}
    if (BytesRead = 0) and ((BufferCount mod 4) <> 0) then begin
      FFakeCount := 4 - (BufferCount mod 4);
      for i := 0 to pred(FFakeCount) do begin
        FBufEnd^ := #0;
        inc(FBufEnd);
      end;
    end;

    {fire the progress event}
    if Assigned(FOnProgress) then begin
      inc(FByteCount, BytesRead);
      Percent := Round((100.0 * FByteCount) / FStreamSize);
      FOnProgress(Percent);
    end;
  end;
end;
{--------}
function TAbDfInBitStream.PeekBits(aCount : integer) : integer;
var
  BitsToGo : integer;
  TempBuffer : integer;
begin
  {check that aCount is in the correct range 1..32}
  Assert((0 <= aCount) and (aCount <= 32),
         'TAbDfInBitStream.PeekBits: count of bits must be between 1 and 32 inclusive');

  {if we have more than enough bits in our bit buffer, return as many
   as needed}
  if (aCount <= FBitsLeft) then
    Result := FBitBuffer and AbExtractMask[aCount]

  {otherwise we shall have to read another integer out of the buffer
   to satisfy the request; note that this will fill the stream buffer
   if required}
  else begin
    BitsToGo := aCount - FBitsLeft;
    Result := FBitBuffer;
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      if not ibsFillBuffer then
        TempBuffer := 0
      else
        TempBuffer := PAb32bit(FBufPos)^
    else
      TempBuffer := PAb32bit(FBufPos)^;
    Result := Result +
             ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);
  end;

  {$IFOPT C+}
  {save the number of bits peeked for an assertion check later}
  FPeekCount := aCount;
  {$ENDIF}
end;
{--------}
function TAbDfInBitStream.PeekMoreBits(aCount : integer) : integer;
var
  BitsToGo : integer;
  TempBuffer : integer;
begin
  BitsToGo := aCount - FBitsLeft;
  Result := FBitBuffer;
  if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
    if not ibsFillBuffer then
      TempBuffer := 0
    else
      TempBuffer := PAb32bit(FBufPos)^
  else
    TempBuffer := PAb32bit(FBufPos)^;
  Result := Result +
           ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);
end;
{--------}
function TAbDfInBitStream.ReadBit : boolean;
begin
  if (FBitsLeft = 0) then begin
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      if not ibsFillBuffer then
        raise EAbInternalInflateError.Create(
          'no more compressed data in stream [TAbDfInBitStream.ReadBit]');
    FBitBuffer := PAb32bit(FBufPos)^;
    inc(FBufPos, sizeof(TAb32bit));
    FBitsLeft := 32;
  end;
  Result := Odd(FBitBuffer);
  FBitBuffer := FBitBuffer shr 1;
  dec(FBitsLeft);
end;
{--------}
function TAbDfInBitStream.ReadBits(aCount : integer) : integer;
var
  BitsToGo : integer;
begin
  {aCount comes from a (possibly corrupt) stream, so check that it is
   the correct range, 1..16}
  if (aCount <= 0) or (aCount > 16) then
    raise EAbInternalInflateError.Create(
       'count of bits must be between 1 and 16 inclusive [TAbDfInBitStream.ReadBits]');

  {if we have more than enough bits in our bit buffer, return as many
   as needed, and update the bitbuffer and the number of bits left}
  if (aCount <= FBitsLeft) then begin
    Result := FBitBuffer and AbExtractMask[aCount];
    FBitBuffer := FBitBuffer shr aCount;
    dec(FBitsLeft, aCount);
  end

  {if we have exactly enough bits in our bit buffer, return them all,
   and update the bitbuffer and the number of bits left}
  else if (aCount = FBitsLeft) then begin
    Result := FBitBuffer;
    FBitBuffer := 0;
    FBitsLeft := 0;
  end

  {otherwise we shall have to read another integer out of the buffer
   to satisfy the request}
  else begin
    BitsToGo := aCount - FBitsLeft;
    Result := FBitBuffer;
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      if not ibsFillBuffer then
        raise EAbInternalInflateError.Create(
          'no more compressed data in stream [TAbDfInBitStream.ReadBits]');
    FBitBuffer := PAb32bit(FBufPos)^;
    inc(FBufPos, sizeof(TAb32bit));
    Result := Result +
              ((FBitBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);
    FBitBuffer := FBitBuffer shr BitsToGo;
    FBitsLeft := 32 - BitsToGo;
  end;
end;
{--------}
procedure TAbDfInBitStream.ReadBuffer(var aBuffer; aCount : integer);
var
  i : integer;
  Buffer : PAnsiChar;
  BytesToRead   : integer;
  BytesInBuffer : integer;
begin
  {this method is designed to read a set of bytes and this can only be
   done if the stream has been byte aligned--if it isn't, it's a
   programming error}
  Assert((FBitsLeft mod 8) = 0,
         'TAbDfInBitStream.ReadBuffer. cannot read a buffer unless the stream is byte-aligned');

  {get the address of the user buffer as a PChar: easier arithmetic}
  Buffer := @aBuffer;

  {if we have some bits left in the bit buffer, we need to copy those
   first}
  if (FBitsLeft > 0) then begin
    BytesToRead := FBitsLeft div 8;
    for i := 0 to pred(BytesToRead) do begin
      Buffer^ := AnsiChar(FBitBuffer and $FF);
      inc(Buffer);
      FBitBuffer := FBitBuffer shr 8;
    end;
    {calculate the count of bytes still to read}
    dec(aCount, BytesToRead);
  end;

  {calculate the number of bytes to copy}
  BytesInBuffer := FBufEnd - FBufPos;
  if (aCount <= BytesInBuffer) then
    BytesToRead := aCount
  else
    BytesToRead := BytesInBuffer;

  {copy the data from our buffer to the user buffer}
  Move(FBufPos^, Buffer^, BytesToRead);

  {update variables}
  dec(aCount, BytesToRead);
  inc(FBufPos, BytesToRead);

  {while there is still data to copy, keep on filling our internal
   buffer and copy it to the user buffer}
  while (aCount <> 0) do begin

    {increment the user buffer pointer past the data just copied}
    inc(Buffer, BytesToRead);

    {fill our buffer}
    if not ibsFillBuffer then
      raise EAbInternalInflateError.Create(
        'no more compressed data in stream [TAbDfInBitStream.ReadBuffer]');

    {calculate the number of bytes to copy}
    BytesInBuffer := FBufEnd - FBufPos;
    if (aCount <= BytesInBuffer) then
      BytesToRead := aCount
    else
      BytesToRead := BytesInBuffer;

    {copy the data from our buffer to the user buffer}
    Move(FBufPos^, Buffer^, BytesToRead);

    {update variables}
    dec(aCount, BytesToRead);
    inc(FBufPos, BytesToRead);
  end;

  {now we've copied everything over, reset the bit variables: they're
   empty and need refilling}
  FBitBuffer := 0;
  FBitsLeft := 0;
end;
{====================================================================}


{===TAbDfOutBitStream================================================}
constructor TAbDfOutBitStream.Create(aStream : TStream);
begin
  {protect against dumb programming mistakes}
  Assert(aStream <> nil,
         'TAbDfOutBitStream.Create: Cannot create a bit stream wrapping a nil stream');

  {create the ancestor}
  inherited Create;

  {save the stream instance, allocate the buffer}
  FStream := aStream;
  GetMem(FBuffer, BitStreamBufferSize);
  FBufEnd := FBuffer + BitStreamBufferSize;
  FBufPos := FBuffer;
end;
{--------}
destructor TAbDfOutBitStream.Destroy;
var
  i : integer;
begin
  {if the buffer was allocated...}
  if (FBuffer <> nil) then begin

    {if there are still some bits in the bit buffer...}
    if (FBitsUsed <> 0) then begin

      {pad the bit buffer to a byte boundary}
      AlignToByte;

      {empty the main buffer if there isn't enough room to copy over
       the 1 to 4 bytes in the bit buffer}
      if ((FBufEnd - FBufPos) < FBitsUsed div 8) then
        obsEmptyBuffer;

      {flush the bit buffer}
      for i := 1 to (FBitsUsed div 8) do begin
        FBufPos^ := AnsiChar(FBitBuffer);
        FBitBuffer := FBitBuffer shr 8;
        inc(FBufPos);
      end;
    end;

    {if there is some data in the main buffer, empty it}
    if (FBufPos <> FBuffer) then
      obsEmptyBuffer;

    {free the buffer}
    FreeMem(FBuffer);
  end;

  {destroy the ancestor}
  inherited Destroy;
end;
{--------}
procedure TAbDfOutBitStream.AlignToByte;
begin
  {round up the number of bits used to the nearest 8}
  FBitsUsed := (FBitsUsed + 7) and $F8;

  {if the bit buffer is now full, flush it to the main buffer}
  if (FBitsUsed = 32) then begin
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      obsEmptyBuffer;
    PAb32bit(FBufPos)^ := FBitBuffer;
    inc(FBufPos, sizeof(TAb32bit));
    FBitBuffer := 0;
    FBitsUsed := 0;
  end;
end;
{--------}
procedure TAbDfOutBitStream.obsEmptyBuffer;
var
  ByteCount    : integer;
  BytesWritten : longint;
begin
  {empty the buffer}
  ByteCount := FBufPos - FBuffer;
  BytesWritten := FStream.Write(FBuffer^, ByteCount);

  {if we couldn't write the correct number of bytes, it's an error}
  if (BytesWritten <> ByteCount) then
    raise EAbInternalDeflateError.Create(
       'could not write to the output atream [TAbDfInBitStream.obsEmptyBuffer]');

  {reset the pointers}
  FBufPos := FBuffer;
end;
{--------}
function TAbDfOutBitStream.Position : longint;
begin
  Assert(false,
         'TAbDfOutBitStream.Position: not implemented yet!');
  Result := -1;
end;
{--------}
procedure TAbDfOutBitStream.WriteBit(aBit : boolean);
begin
  {only set the corresponding bit in the bit buffer if the passed bit
   is set (the bit buffer is set to zero when emptied, so we don't
   actually have to record clear bits)}
  if aBit then
    FBitBuffer := FBitBuffer or (1 shl FBitsUsed);

  {we've now got one more bit}
  inc(FBitsUsed);

  {if the bit buffer is now full, flush it to the main buffer}
  if (FBitsUsed = 32) then begin
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      obsEmptyBuffer;
    PAb32bit(FBufPos)^ := FBitBuffer;
    inc(FBufPos, sizeof(TAb32bit));
    FBitBuffer := 0;
    FBitsUsed := 0;
  end;
end;
{--------}
procedure TAbDfOutBitStream.WriteBits(aBits : integer; aCount : integer);
begin
  {protect against programming mistakes...}
  {..the count should be in the range 1 to 16 (BTW, the latter is only
     used once: Deflate64 with length symbol 258)}
  Assert((0 < aCount) and (aCount <= 16),
         'TAbDfOutBitStream.WriteBits: aCount should be from 1 to 16');
  {..there shouldn't be more than aCount bits}
  Assert((aBits shr aCount) = 0,
         'TAbDfOutBitStream.WriteBits: aBits has more than aCount bits');

  {copy as many bits as we can to the bit buffer}
  FBitBuffer := FBitBuffer or (aBits shl FBitsUsed);

  {increment the number of bits used}
  inc(FBitsUsed, aCount);

  {if we've overshot...}
  if (FBitsUsed >= 32) then begin

    {the bit buffer is now full, so flush it}
    if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then
      obsEmptyBuffer;
    PAb32bit(FBufPos)^ := FBitBuffer;
    inc(FBufPos, sizeof(TAb32bit));

    {patch up the bit buffer and the number of bits used}
    dec(FBitsUsed, 32);
    FBitBuffer := aBits shr (aCount - FBitsUsed);
  end;
end;
{--------}
procedure TAbDfOutBitStream.WriteBuffer(var aBuffer; aCount : integer);
var
  Buffer : PAnsiChar;
  BytesToCopy : integer;
begin
  {guard against dumb programming errors: we must be byte aligned}
  Assert((FBitsUsed and $7) = 0,
         'TAbDfOutBitStream.WriteBuffer: must be byte aligned');

  {use the user buffer as a PChar}
  Buffer := @aBuffer;