aiccabacencoder.pas

很好的源代码

unit AICCabacEncoder;
{ Advanced Image Coding (AIC)
  ===========================
  Context Adaptive Binary Arithmetic Coding: Encoder.
  Parts of the code in this unit are based on the H.264 reference software.
  See JM.txt for license details. }

interface

uses
  AICCabac, AICCommon;

type
  TAICCabacEncoder = class(TAICCabac)
  { Context Adaptive Binary Arithmetic Coding: Encoder }
   private
    FBitsToFollow: Integer;
    procedure StartEncoding;
    { Initializes the encoder }
    procedure StopEncoding;
    { Stops encoding by flushing the buffer }
    procedure PutOneBit(const Bit: Cardinal);
    { Adds one bit (0 or 1) to the buffer.
      When a complete Byte is reached, PutByte is called }
    procedure PutOneBitPlusOutstanding(const Bit: Cardinal);
    { Adds one bit (0 or 1) and any outstanding bits to the buffer
      When a complete Byte is reached, PutByte is called }
    procedure PutByte;
    { Adds 8 encoded bits to the buffer. When the buffer becomes full,
      FlushBuffer is called. }
    procedure FlushBuffer;
    { Writes the contents of the buffer to the stream }
    procedure EncodeSymbol(Symbol: Cardinal; var Context: TCabacContext);
    { Encodes a single symbol (0 or 1) using the given context }
    procedure EncodeSymbolEqProb(const Symbol: Cardinal);
    { Encodes a single symbol (0 or 1) without a context. This is used when
      the probabilities of a symbol being 0 or 1 are both approximately 50%
      and thus a context is not useful }
    procedure EncodeUnaryExpGolombLevel(const Symbol: Cardinal;
      var Context: TCabacContext);
    { Encodes a value as an Exponential Golomb code.
      Each bit of the Golomb code will be coded with the given context }
    procedure EncodeExpGolombEqProb(Symbol: Cardinal; K: Integer);
    { Encodes a value as an Exponential Golomb code.
      No context is used for each bit of the Golomb code, because the
      probabilities of these bits being 0 or 1 are almost equal. }
    procedure WriteSignificanceMap(const ChannelType: TAICChannelType;
      const Coef: TAICIntBlock; CoefCount: Integer);
    { Encodes a map of significant coeficients for channel ChannelType.
      The map is encoded as an array of 0 or 1 values, where 0 is used to
      signal an insignificant coefficient, and 1 is used to signal a
      significant coefficient.
      The contexts CtxCoefficientMap and CtxLastCoefficient are used to
      encode these values }
    procedure WriteSignificantCoefficients(const ChannelType: TAICChannelType;
      const Coef: TAICIntBlock);
    { For every significant coefficient in Coef (that is, with value <> 0), the
      value of this coefficient is encoded from using the contexts
      CtxCoefGreaterOne and CtxCoefAbsolute. }
  public
    procedure AfterConstruction; override;
    { Initialized the encoder }
    procedure BeforeDestruction; override;
    { Stops encoding by flushing the buffer }

    procedure WritePredictionMode(const Value: Integer);
    { Encodes the prediction mode using the CtxPredictionMode contexts }
    procedure WriteCoefficients(const ChannelType: TAICChannelType;
      const Coef: TAICIntBlock);
    { Encodes the DCT coefficients for channel ChannelType. The coefficients
      are stored in the zig zag ordered Coef array.
      The context CtxCodedBlock is used to encode a 0 or 1 value to indicate
      if there are any significant coefficients (that is, if at least one
      coefficient in Coef isn't 0) }
  end;

implementation

uses
  Math;

{ TAICCabacEncoder }

procedure TAICCabacEncoder.AfterConstruction;
begin
  inherited;
  StartEncoding;
end;

procedure TAICCabacEncoder.BeforeDestruction;
begin
  inherited;
  StopEncoding;
end;

procedure TAICCabacEncoder.EncodeExpGolombEqProb(Symbol: Cardinal;
  K: Integer);
begin
  while True do begin
    if Symbol >= (1 shl K) then begin
      EncodeSymbolEqProb(1);
      Dec(Symbol,1 shl K);
      Inc(K);
    end else begin
      EncodeSymbolEqProb(0);
      while K > 0 do begin
        Dec(K);
        EncodeSymbolEqProb((Symbol shr K) and 1);
      end;
      Break;
    end;
  end;
end;

procedure TAICCabacEncoder.EncodeSymbol(Symbol: Cardinal;
  var Context: TCabacContext);
var
  RLPS: Cardinal;
begin
  RLPS := CabacRLPSTable[Context.State,(Range shr 6) and 3];
  if Symbol <> 0 then
    Symbol := 1;
  Dec(Range,RLPS);

  if Symbol <> Context.MPS then begin
    Inc(Low,Range);
    Range := RLPS;
    if Context.State = 0 then
      Context.MPS := Context.MPS xor 1;
    Context.State := CabacACNextStateLPS[Context.State];
  end else
    Context.State := CabacACNextStateMPS[Context.State];

  // Renormalisation
  while Range < CabacQuarter do begin
    if (Low >= CabacHalf) then begin
      PutOneBitPlusOutstanding(1);
      Dec(Low,CabacHalf);
    end else if Low < CabacQuarter then
      PutOneBitPlusOutstanding(0)
    else begin
      Inc(FBitsToFollow);
      Dec(Low,CabacQuarter);
    end;
    Low := Low shl 1;
    Range := Range shl 1;
  end;
end;

procedure TAICCabacEncoder.EncodeSymbolEqProb(const Symbol: Cardinal);
begin
  Low := Low shl 1;
  if Symbol <> 0 then
    Inc(Low,Range);
  if Low >= CabacOne then begin
    PutOneBitPlusOutstanding(1);
    Dec(Low,CabacOne);
  end else if Low < CabacHalf then
    PutOneBitPlusOutstanding(0)
  else begin
    Inc(FBitsToFollow);
    Dec(Low,CabacHalf);
  end;
end;

procedure TAICCabacEncoder.EncodeUnaryExpGolombLevel(
  const Symbol: Cardinal; var Context: TCabacContext);
var
  K, L: Cardinal;
begin
  if Symbol = 0 then
    EncodeSymbol(0,Context)
  else begin
    EncodeSymbol(1,Context);
    L := Symbol - 1;
    K := 1 + 1;
    while (L > 0) and (K <= CabacExpStart) do begin
      EncodeSymbol(1,Context);
      Dec(L); Inc(K);
    end;
    if Symbol < CabacExpStart then
      EncodeSymbol(0,Context)
    else
      EncodeExpGolombEqProb(Symbol - CabacExpStart,0);
  end;
end;

procedure TAICCabacEncoder.FlushBuffer;
begin
  Stream.WriteBuffer(CodeStream[0],CodeStreamLen);
  CodeStreamLen := 0;
end;

procedure TAICCabacEncoder.PutByte;
begin
  CodeStream[CodeStreamLen] := Buffer and $FF;
  BitsToGo := 8;
  Inc(CodeStreamLen);
  if CodeStreamLen >= CabacCodeStreamSize then
    FlushBuffer;
end;

procedure TAICCabacEncoder.PutOneBit(const Bit: Cardinal);
begin
  Buffer := (Buffer shl 1) or Bit;
  Dec(BitsToGo);
  if BitsToGo = 0 then
    PutByte;
end;

procedure TAICCabacEncoder.PutOneBitPlusOutstanding(const Bit: Cardinal);
begin
  PutOneBit(Bit);
  while FBitsToFollow > 0 do begin
    Dec(FBitsToFollow);
    PutOneBit(1 - Bit);
  end;
end;

procedure TAICCabacEncoder.StartEncoding;
begin
  BitsToGo := 9;
  Range := CabacHalf - 2;
end;

procedure TAICCabacEncoder.StopEncoding;
begin
  PutOneBitPlusOutstanding((Low shr (CabacBits - 1)) and 1);
  PutOneBit((Low shr (CabacBits - 2)) and 1);
  PutOneBit(1);
  while BitsToGo <> 8 do
    PutOneBit(0);
  FlushBuffer;
end;

procedure TAICCabacEncoder.WriteCoefficients(
  const ChannelType: TAICChannelType; const Coef: TAICIntBlock);
var
  I, CoefCount: Integer;
begin
  CoefCount := 0;
  for I := 0 to 63 do
    if Coef[I] <> 0 then
      Inc(CoefCount);

  if CoefCount > 0 then begin
    EncodeSymbol(1,CtxCodedBlock);
    WriteSignificanceMap(ChannelType,Coef,CoefCount);
    WriteSignificantCoefficients(ChannelType,Coef);
  end else
    EncodeSymbol(0,CtxCodedBlock);
end;

procedure TAICCabacEncoder.WritePredictionMode(const Value: Integer);
begin
  if Value < 0 then
    EncodeSymbol(1,CtxPredictionMode[0])
  else begin
    EncodeSymbol(0,CtxPredictionMode[0]);
    EncodeSymbol( Value and 1       ,CtxPredictionMode[1]);
    EncodeSymbol((Value shr 1) and 1,CtxPredictionMode[1]);
    EncodeSymbol((Value shr 2) and 1,CtxPredictionMode[1]);
  end;
end;

procedure TAICCabacEncoder.WriteSignificanceMap(
  const ChannelType: TAICChannelType; const Coef: TAICIntBlock;
  CoefCount: Integer);
var
  CtxMap, CtxLast: PCabacContext;
  I, Sig, Last: Integer;
begin
  CtxMap := @CtxCoefficientMap[ChannelType,0];
  CtxLast := @CtxLastCoefficient[ChannelType,0];
  for I := 0 to 62 do begin
    if Coef[I] = 0 then
      Sig := 0
    else
      Sig := 1;
    EncodeSymbol(Sig,CtxMap^);
    if Sig <> 0 then begin
      Dec(CoefCount);
      if CoefCount = 0 then
        Last := 1
      else
        Last := 0;
      EncodeSymbol(Last,CtxLast^);
      if Last <> 0 then
        Exit;
    end;
    Inc(CtxMap);
    Inc(CtxLast);
  end;
  { We don't need to encode the significance of the last coefficient, since
    this can be determined from the CtxLast context }
end;

procedure TAICCabacEncoder.WriteSignificantCoefficients(
  const ChannelType: TAICChannelType; const Coef: TAICIntBlock);
var
  I, C, C1, C2, Ctx, Sign, GreaterOne: Integer;
begin
  C1 := 1; C2 := 0;
  for I := 63 downto 0 do begin
    C := Coef[I];
    if C <> 0 then begin
      if C > 0 then
        Sign := 0
      else begin
        Sign := 1;
        C := -C;
      end;

      if C > 1 then
        GreaterOne := 1
      else
        GreaterOne := 0;

      Ctx := Min(C1,4);
      EncodeSymbol(GreaterOne,CtxCoefGreaterOne[ChannelType,Ctx]);

      if GreaterOne <> 0 then begin
        Ctx := Min(C2,4);
        EncodeUnaryExpGolombLevel(C - 2,CtxCoefAbsolute[ChannelType,Ctx]);
        C1 := 0;
        Inc(C2);
      end else if C1 <> 0 then
        Inc(C1);

      EncodeSymbolEqProb(Sign);
    end;
  end;
end;

end.