abdfstrm.pas

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

      with aBitStrm do begin
        BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed);
        BitsUsed := BitsUsed + ((Code shr 16) and $FF);
        if (BitsUsed >= 32) then
          WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF);
      end;
      {$ENDIF}

      {if there are extra bits to be output for this distance, calculate
       them and output them}
      ExtraBits := Code shr 24;
      if (ExtraBits <> 0) then begin
        {$IFOPT C+}
        aBitStrm.WriteBits((Dist - dfc_DistanceBase[Symbol]),
                           ExtraBits);
        {$ELSE}
        with aBitStrm do begin
          BitBuffer := BitBuffer or
                     ((Dist - dfc_DistanceBase[Symbol]) shl BitsUsed);
          BitsUsed := BitsUsed + ExtraBits;
          if (BitsUsed >= 32) then
            WriteMoreBits((Dist - dfc_DistanceBase[Symbol]),
                          ExtraBits);
        end;
        {$ENDIF}
      end;
    end;
  end;

{clear the stream; ready for some more items}
{  Clear;}
end;
{--------}
function TAbDfLZStream.lzsGetApproxSize : integer;
var
  i : integer;
begin
  {note: calculates an approximate compressed size without taking too
         long about it. The average encoded bit length for literals
         and lengths is assumed to be 8. Distances are assumed to
         follow the static tree definition (ie, 5 bits per distance,
         plus any extra bits).
         There are FLitCount literals, FDistCount lengths, and
         FDistCount distances}
  Result := (13 * FDistCount) + (8 * FLitCount);
  for i := 4 to 31 do
    inc(Result, FDistBuckets^[i] * dfc_DistExtraBits[i]);
  Result := Result div 8;
end;
{--------}
function TAbDfLZStream.lzsGetStaticSize : integer;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to 143 do
    inc(Result, FLitBuckets^[i] * 8);
  for i := 144 to 255 do
    inc(Result, FLitBuckets^[i] * 9);
  inc(Result, FLitBuckets^[256] * 7);
  for i := 257 to 279 do
    inc(Result, FLitBuckets^[i] *
                (7 + dfc_LitExtraBits[i - dfc_LitExtraOffset]));
  for i := 280 to 284 do
    inc(Result, FLitBuckets^[i] *
                (8 + dfc_LitExtraBits[i - dfc_LitExtraOffset]));
  if FUseDeflate64 then
    inc(Result, FLitBuckets^[285] * (8 + 16))
  else
    inc(Result, FLitBuckets^[285] * 8);

  for i := 0 to 31 do
    inc(Result, FDistBuckets^[i] * (5 + dfc_DistExtraBits[i]));
end;
{--------}
function TAbDfLZStream.lzsGetStoredSize : integer;
begin
  Result := FStoredSize;
{Result := FSlideWin.Position - FStartOfs;}
end;
{--------}
function TAbDfLZStream.lzsIsFull : boolean;
begin
  {if the number of hits on the (eventual) literal tree is a multiple
   of 8192, the stream is full if the majority were straight literals
   and we're getting approx 50% compression}
  if (((FLitCount + FDistCount) and $1FFF) = 0) then begin
    Result := (FDistCount < FLitCount) and
              (lzsGetApproxSize < (FStoredSize div 2));
    if Result then
      Exit;
  end;

  {otherwise the stream is full if the number of hits on the literal
   tree or on the distance tree is 32768}
{    Result := (FCurPos - FStream) > (StreamSIze - 100);}
  Result := (FDistCount >= 32768) or
            ((FLitCount + FDistCount) >= 32768);
end;
{--------}
procedure TAbDfLZStream.ReadStoredBuffer(var aBuffer; aCount : integer);
begin
  FSlideWin.ReadBuffer(aBuffer, aCount, FStartOfs);
  inc(FStartOfs, aCount);
end;
{--------}
procedure TAbDfLZStream.Rewind;
begin
  {position the stream at the beginning}
  FStrmEnd := FCurPos;
  FCurPos := FStream;
end;
{====================================================================}


{===TAbDfCodeLenStream===============================================}
constructor TAbDfCodeLenStream.Create(aLog : TAbLogger);
begin
  {create the ancestor}
  inherited Create;

  {allocate the stream (to contain all literals and distances and
   possible extra data}
  GetMem(FStream, (285 + 32) * 2);
  FPosition := FStream;

  {allocate the buckets}
  FBuckets := AllocMem(sizeof(TAbDfCodeLenBuckets));
end;
{--------}
destructor TAbDfCodeLenStream.Destroy;
begin
  {free the stream}
  if (FStream <> nil) then
    FreeMem(FStream);

  {free the buckets}
  if (FBuckets <> nil) then
    Dispose(FBuckets);

  {destroy the ancestor}
  inherited Destroy;
end;
{--------}
procedure TAbDfCodeLenStream.Build(const aCodeLens : array of integer;
                                         aCount    : integer);
var
  i : integer;
  State       : (ScanStart, ScanNormal, Got2nd, Got3rd);
  Count       : integer;
  ThisCount   : integer;
  CodeLen     : integer;
  PrevCodeLen : integer;
  CurPos      : PAnsiChar;
  Buckets     : PAbDfCodeLenBuckets;
begin
  {start the automaton}
  State := ScanStart;
  CurPos := FStream;
  Buckets := FBuckets;
  Count := 0;
  PrevCodeLen := 0;

  {for all the codelengths in the array (plus a fake one at the end to
   ensure all codeslengths are counted)...}
  for i := 0 to aCount do begin

    {get the current codelength}
    if (i = aCount) then
      CodeLen := -1
    else
      CodeLen := aCodeLens[i];

    {switch based on the state...}
    case State of
      ScanStart :
        begin
          PrevCodeLen := CodeLen;
          State := ScanNormal;
        end;

      ScanNormal :
        begin
          {if the current code is the same as the previous, move to
           the next state}
          if (CodeLen = PrevCodeLen) then
            State := Got2nd

          {otherwise output the previous code}
          else begin
            CurPos^ := AnsiChar(PrevCodeLen);
            inc(CurPos);
            inc(Buckets^[PrevCodeLen]);
            PrevCodeLen := CodeLen;
          end;
        end;

      Got2nd :
        begin
          {if the current code is the same as the previous, move to
           the next state; we now have three similar codes in a row}
          if (CodeLen = PrevCodeLen) then begin
            State := Got3rd;
            Count := 3;
          end

          {otherwise output the previous two similar codes, move back
           to the initial state}
          else begin
            CurPos^ := AnsiChar(PrevCodeLen);
            inc(CurPos);
            CurPos^ := AnsiChar(PrevCodeLen);
            inc(CurPos);
            inc(Buckets^[PrevCodeLen], 2);
            PrevCodeLen := CodeLen;
            State := ScanNormal;
          end;
        end;

      Got3rd:
        begin
          {if the current code is the same as the previous, increment
           the count of similar codes}
          if (CodeLen = PrevCodeLen) then
            inc(Count)

          {otherwise we need to output the repeat values...}
          else begin

            {if the previous code were a zero code...}
            if (PrevCodeLen = 0) then begin

              {while there are zero codes to be output...}
              while (Count <> 0) do begin

                {if there are less than three zero codes, output them
                 individually}
                if (Count < 3) then begin
                  while (Count <> 0) do begin
                    CurPos^ := #0;
                    inc(CurPos);
                    inc(Buckets^[0]);
                    dec(Count);
                  end;
                end

                {if there are less than 11 successive zero codes,
                 output a 17 code and the count of zeros}
                else if (Count < 11) then begin
                  CurPos^ := #17;
                  inc(CurPos);
                  inc(Buckets^[17]);
                  CurPos^ := AnsiChar(Count - 3);
                  inc(CurPos);
                  Count := 0;
                end

                {otherwise output an 18 code and the count of zeros}
                else begin
                  ThisCount := Count;
                  if (ThisCount > 138) then
                    ThisCount := 138;
                  CurPos^ := #18;
                  inc(CurPos);
                  inc(Buckets^[18]);
                  CurPos^ := AnsiChar(ThisCount - 11);
                  inc(CurPos);
                  dec(Count, ThisCount);
                end;
              end;
            end

            {otherwise the previous code was a non-zero code...}
            else begin

              {output the first code}
              CurPos^ := AnsiChar(PrevCodeLen);
              inc(CurPos);
              inc(Buckets^[PrevCodeLen]);
              dec(Count);

              {while there are more codes to be output...}
              while (Count <> 0) do begin

                {if there are less than three codes, output them
                 individually}
                if (Count < 3) then begin
                  while (Count <> 0) do begin
                    CurPos^ := AnsiChar(PrevCodeLen);
                    inc(CurPos);
                    inc(Buckets^[PrevCodeLen]);
                    dec(Count);
                  end;
                end

                {otherwise output an 16 code and the count}
                else begin
                  ThisCount := Count;
                  if (ThisCount > 6) then
                    ThisCount := 6;
                  CurPos^ := #16;
                  inc(CurPos);
                  inc(Buckets^[16]);
                  CurPos^ := AnsiChar(ThisCount - 3);
                  inc(CurPos);
                  dec(Count, ThisCount);
                end;
              end;
            end;

            {move back to the initial state}
            PrevCodeLen := CodeLen;
            State := ScanNormal;
          end;
        end;
    end;
  end;

  {set the read position}
  FStrmEnd := CurPos;
  FPosition := FStream;
end;
{--------}
procedure TAbDfCodeLenStream.Encode(aBitStrm : TAbDfOutBitStream;
                                    aTree    : TAbDfDecodeHuffmanTree);
var
  Symbol    : integer;
  ExtraData : integer;
  Code      : longint;
  CurPos    : PAnsiChar;
  StrmEnd   : PAnsiChar;
begin
  {prepare for the loop}
  CurPos := FPosition;
  StrmEnd := FStrmEnd;

  {while there are tokens in the stream...}
  while (CurPos <> StrmEnd) do begin

    {get the next symbol}
    Symbol := ord(CurPos^);
    inc(CurPos);

    {if the symbol is 0..15, get the code and output it}
    if (Symbol <= 15) then begin
      {$IFOPT C+} {if Assertions are on}
      Code := aTree.Encode(Symbol);
      {$ELSE}
      Code:= aTree.Encodes^[Symbol];
      {$ENDIF}
      aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);
    end

    {otherwise the symbol is 16, 17, or 18}
    else begin
      {get the extra data}
      ExtraData := ord(CurPos^);
      inc(CurPos);
      {get the code and output it}
      {$IFOPT C+} {if Assertions are on}
      Code := aTree.Encode(Symbol);
      {$ELSE}
      Code:= aTree.Encodes^[Symbol];
      {$ENDIF}
      aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);
      if (Symbol = 16) then
        aBitStrm.WriteBits(ExtraData, 2)
      else if (Symbol = 17) then
        aBitStrm.WriteBits(ExtraData, 3)
      else {Symbol = 18}
        aBitStrm.WriteBits(ExtraData, 7);
    end;
  end;
end;
{====================================================================}

end.