{DOS-text

 Поддержка динамического дерева для компрессии/декомпрессии методом Хаффмана

}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 2005

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-41-46
   E-mail: aleks@dpt.ustu.ru

(c) Copyright Александров О.Е., 2005

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-41-46
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 2005

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-41-46
   E-mail: aleks@dpt.ustu.ru

(c) Copyright └ыхъёрэфЁют ╬.┼., 2005

   620002, ┼ърЄхЁшэсєЁу, ╩-2, ╙├╥╙, ╩рЇхфЁр ьюыхъєы Ёэющ Їшчшъш
   Єхы. 75-41-46
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit DhCodec;
{$IfDef NoChecking}
  {$R-,S-,Q-}
{$EndIf Def NoChecking}

INTERFACE
  USES HUFTypes, DHUFType, DHufBase {$IFDEF LogCoding}, DHBaseDb {$EndIF DEF LogCoding};


type
  { флаги управления процессом  }
  tFlag=(fEncodeRegime, fDecodeRegime);
  tFlags=set of tFlag;
											      { n]s■ў[' ~[wim a[].ai~.nh'i  - n√x.n ByteToCodes xhz~[∙[' }


  { Динамическое дерево Хаффмана }
  tDHCodec=object
    {$IfDef Delphi}
    protected
    {$EndIf}

      prTreeData:tDynHuffmanFullTreeData; { данные дерева }
      prDicFlags:tFlags; { внутренние флаги управления }

      prCode:tCodeEx; { буфер переноса кода }
      prCodePartNumber:tCodeMaxPortionIndex; {номер еще не перенесенной части }

      prRec:tDecodingRecord;

    private
      procedure ResetRegime;

    public
       { будут установлены после следующего Set(En/De)codeRegime }
       MaxTotalCounter:tFriquency; { ополовинить счетчики после MaxTotalCounter байтов}

      { инициализация }
      constructor Init;
      { освобождение }
      destructor  Done; virtual;

      procedure ByteToCode(aByte:tByte; var aCode:tCodeEx);

    { ---- Кодирование буфера }
      { кодирование буфера AInBuffer в AOutBuffer.
	При кодировании в AOutBuffer записываются только полные байты,
      неполные остаются в промежуточном буфере переноса (менее 1-го байта).
	В буфере переноса может остаться больше данных, если закончилось
      место в AOutBuffer. Оставшиеся данные будут записаны в AOutBuffer
      при следующем вызове Encode. }
      { ъюфшЁютрэшх сєЇхЁр AInBuffer т AOutBuffer.
	╧Ёш ъюфшЁютрэшш т AOutBuffer чряшё√тр■Єё  Єюы№ъю яюыэ√х срщЄ√,
      эхяюыэ√х юёЄр■Єё  т яЁюьхцєЄюўэюь сєЇхЁх яхЁхэюёр (ьхэхх 1-ую срщЄр).
	┬ сєЇхЁх яхЁхэюёр ьюцхЄ юёЄрЄ№ё  сюы№°х фрээ√ї (сюыхх 1-ую срщЄр), хёыш чръюэўшыюё№
      ьхёЄю т AOutBuffer. ╬ёЄрт°шхё  фрээ√х сєфєЄ чряшёрэ√ т AOutBuffer
      яЁш ёыхфє■∙хь т√чютх Encode. }
      function  Encode(const AInBuffer; { буфер со исходными данными }
					{ сєЇхЁ ёю шёїюфэ√ьш фрээ√ьш }
			     AInBufSize:tBufferIndex; { размер буфера с исходными данными }
						      { ЁрчьхЁ сєЇхЁр ё шёїюфэ√ьш фрээ√ьш }
		       var   AEncodedSize:tBufferIndex; { размер закодированной части,
							 !!!может быть меньше AInBufSize, если все не влазит в AOutBuffer }
							{ ЁрчьхЁ чръюфшЁютрээющ ўрёЄш,
							 !!!ьюцхЄ с√Є№ ьхэ№°х AInBufSize, хёыш тёх эх тырчшЄ т AOutBuffer }
		       var   AOutBuffer; { кодированный буфер }{ ъюфшЁютрээ√щ сєЇхЁ }
			     AOutBufSize:tByteBufferIndex; { размер кодированного буфера }
						       { ЁрчьхЁ ъюфшЁютрээюую сєЇхЁр }
		       var   AOutDataSize:tByteBufferIndex { размер кодированных данных в буфере }
						       { ЁрчьхЁ ъюфшЁютрээ√ї фрээ√ї т сєЇхЁх }
      ):boolean;

      function CodeToByte(
		       var aCodeBits:tCodeMaxPortion;
		       var aCodeBitCount:tCodeMaxPortionLength;
		       var aNode:tNodeIndex
		):boolean;
     { ---- Декодирование буфера }
      { декодирование буфера ACodedBuffer в AOutBuffer.
      При декодировании из ACodedBuffer считываются только полные байты,
      остаток запоминается в промежуточном буфере переноса. }
      { фхъюфшЁютрэшх сєЇхЁр ACodedBuffer т AOutBuffer.
      ╧Ёш фхъюфшЁютрэшш шч ACodedBuffer ёўшЄ√тр■Єё  Єюы№ъю яюыэ√х срщЄ√,
      юёЄрЄюъ чряюьшэрхЄё  т яЁюьхцєЄюўэюь сєЇхЁх яхЁхэюёр. }
      function  Decode(const ACodedBuffer;
			     ACodedBufSize:tByteBufferIndex;
		       var   ADecodedSize:tByteBufferIndex;
		       var   AOutBuffer;
			     AOutBufSize:tBufferIndex;
		       var   AOutDataSize:tBufferIndex):boolean;


      function EffectiveMaxTotalCounter:tFriquency;  { ополовинить счетчики после MaxTotalCounter байтов}
      function TotalHalfCount:{$ifndef Delphi}comp{$else}int64{$endif};

      procedure ByteCount(var aValue:tVeryLongCounter);
      procedure CompressedByteCount(var aValue:tVeryLongCounter);
      function  CompressionRatio:double;
      function  CompByteCount:double;
      {$ifdef Delphi}
      function  TotalByteCount:tVeryLongCounter;
      function TotalCompressedByteCount:tVeryLongCounter;
      {$endif def Delphi}

      { Сброс перевод кодека в режим кодирования,
      после чего можно вызывать только ByteToCode.}
      procedure   EncodeReset;

      { Сброс словаря и перевод его в режим декодирования,
      после чего можно вызывать только CodeToByte.}
      procedure   DecodeReset;

  end;

IMPLEMENTATION

function tDHCodec.CodeToByte(
       var aCodeBits:tCodeMaxPortion;
       var aCodeBitCount:tCodeMaxPortionLength;
       var aNode:tNodeIndex
):boolean;
begin
  CodeToByte:=dhDecodeBits(aCodeBits, aCodeBitCount, aNode, prTreeData);
end;

function tDHCodec.Decode(
  const aCodedBuffer;
	aCodedBufSize:tByteBufferIndex;
  var   aDecodedSize:tByteBufferIndex;
  var   aOutBuffer;
	aOutBufSize:tBufferIndex;
  var   aOutDataSize:tBufferIndex
):boolean;
  var
    CodeBits:tCodeMaxPortion;
    CodeBitCount:tCodeMaxPortionLength;
    DecodedSize:tByteBufferIndex;
    NodeIndex:tIndex;
    i:tBufferIndex;
    lOutBufSize:tByteBufferIndex;
begin

 {$IFDEF LogCoding}
   DHBaseDb.SetDecode;
 {$EndIF DEF LogCoding}

  if (aOutBufSize=0) then begin
    { декодирование невозможно } { фхъюфшЁютрэшх эхтючьюцэю }
    Decode:=False;
  end else begin

    { оставшийся от предыдущего вызова код }{ юёЄрт°шщё  юЄ яЁхф√фє∙хую т√чютр ъюф }
    CodeBits:=prRec.CodeBits;
    CodeBitCount:=prRec.CodeBitCount;
    NodeIndex:=prRec.Node;
    i:=0;
    if CodeBitCount>0 then begin
      { декодируем оставшийся от предыдущего буфера код }
      { фхъюфшЁєхь юёЄрт°шщё  юЄ яЁхф√фє∙хую сєЇхЁр ъюф }
      while (i<aOutBufSize) and dhDecodeBits(CodeBits, CodeBitCount, NodeIndex, prTreeData) do begin
	tBuffer(aOutBuffer)[i]:=NodeIndex;
	Inc(i);
	NodeIndex:=cRootNode;
      end;
    end;

    { декодируем буфер aCodedBuffer }{ фхъюфшЁєхь сєЇхЁ aCodedBuffer }
    Decode:=TRUE;
    DecodedSize:=0;
    if aCodedBufSize>SizeOf(CodeBits) then begin
      Dec(aCodedBufSize,SizeOf(CodeBits));
      lOutBufSize:=(aOutBufSize-(SizeOf(CodeBits)-1)*8);
      while (i<lOutBufSize) and (DecodedSize<aCodedBufSize) do begin
        CodeBits:=tPCodeMaxPortion(@tByteBuffer(aCodedBuffer)[DecodedSize])^;
        CodeBitCount:=SizeOf(CodeBits)*8;
        { декодировать биты кода }
        while (i<aOutBufSize) and dhDecodeBits(CodeBits, CodeBitCount, NodeIndex, prTreeData) do begin
          tBuffer(AOutBuffer)[i]:=NodeIndex;
  	  Inc(i);
	  NodeIndex:=cRootNode;
        end;
        Inc(DecodedSize,SizeOf(CodeBits));
      end;
      Inc(aCodedBufSize,SizeOf(CodeBits));
    end;
    while (i<aOutBufSize) and (aCodedBufSize>DecodedSize) do begin
      CodeBits:=tByteBuffer(aCodedBuffer)[DecodedSize];
      CodeBitCount:=8;
      { декодировать биты кода }
      while (i<aOutBufSize) and dhDecodeBits(CodeBits, CodeBitCount, NodeIndex, prTreeData) do begin
	tBuffer(AOutBuffer)[i]:=NodeIndex;
	Inc(i);
	NodeIndex:=cRootNode;
      end;
      Inc(DecodedSize);
    end;
    { сохраняем, то что не декодировали }
    prRec.CodeBits:=CodeBits;
    prRec.CodeBitCount:=CodeBitCount;
    prRec.Node:=NodeIndex;

    { декодировано }{ фхъюфшЁютрэю }
    aDecodedSize:=DecodedSize;
    { записано в выходной буфер }{ чряшёрэю т т√їюфэющ сєЇхЁ }
    aOutDataSize:=i;
  end;
end;

function tDHCodec.Encode(const aInBuffer;
			       aInBufSize:tBufferIndex;
			 var   aEncodedSize:tBufferIndex;
			 var   aOutBuffer;
			       aOutBufSize:tByteBufferIndex;
			 var   aOutDataSize:tByteBufferIndex):boolean;

  var
    Code:tCodeEx;
    lpOutBuffer:^Byte;
    lOutBufSize:tByteBufferIndex;

  procedure CopyCodeToBuffer;
    var l:byte;
  begin
     l:=Code.Length shr 3;
     if l>lOutBufSize then begin
       Move(Code.Code, lpOutBuffer^, lOutBufSize);
       Dec(Code.Length,lOutBufSize shl 3);
       Move(Code.Code.Bytes[lOutBufSize], Code.Code, (l-lOutBufSize));
       lOutBufSize:=0;
     end else if l>0 then begin
       Move(Code.Code, lpOutBuffer^, l);
       Inc(lpOutBuffer, l);
       Dec(Code.Length,l shl 3);
       Code.Code.Bytes[0]:=Code.Code.Bytes[l];
       Dec(lOutBufSize,l);
     end;
  end;

  var
    i:tBufferIndex;
    l:byte;
    cl:tCodeLength;

  const
    cSizeOfCode=SizeOf(tCodeDataEx);
    cSizeOfTByte=SizeOf(tByte);

begin
 {$IFDEF LogCoding}
 DHBaseDb.SetEncode;
 {$EndIF DEF LogCoding}
  if (aOutBufSize=0) then begin
    { невозможно кодирование } { эхтючьюцэю ъюфшЁютрэшх }
    Encode:=False;
  end else begin
    { инициализация выходного битового буфера }{ шэшЎшрышчрЎш  т√їюфэюую сшЄютюую сєЇхЁр }
    lpOutBuffer:=pointer(@aOutBuffer);
    lOutBufSize:=aOutBufSize;
    Code:=prCode;
    aInBufSize:=aInBufSize div cSizeOfTByte;

    { копируем оставшиеся от предыдущего буфера коды }
    { ъюяшЁєхь юёЄрт°шхё  юЄ яЁхф√фє∙хую сєЇхЁр ъюф√ }
    CopyCodeToBuffer;

    { проверка размера входного буфера (данных) }
    { яЁютхЁър ЁрчьхЁр тїюфэюую сєЇхЁр (фрээ√ї) }
    if (aInBufSize=0) then begin
      { !!! на вход передан пустой буфер - переносим в выходной остатки
      (в том числе и неполные байты) и выходим }
      { !!! эр тїюф яхЁхфрэ яєёЄющ сєЇхЁ - яхЁхэюёшь т т√їюфэющ юёЄрЄъш
      (т Єюь ўшёых ш эхяюыэ√х срщЄ√) ш т√їюфшь }
      aEncodedSize:=0;
      { перенос остатка кода в выходной буфер }
      { яхЁхэюё юёЄрЄър ъюфр т т√їюфэющ сєЇхЁ }
      if lOutBufSize>0 then begin
	{ перенос неполного байта, если есть такой}
	{ яхЁхэюё эхяюыэюую срщЄр, хёыш хёЄ№ Єръющ}
        if Code.Length>0 then begin
          lpOutBuffer^:=Code.Code.Bytes[0];
          Dec(lOutBufSize);
        end;
      end;
      i:=aOutBufSize-lOutBufSize;
      aOutDataSize:=i;
    end else begin
      { кодируем буфер данных }{ ъюфшЁєхь сєЇхЁ фрээ√ї }
      i:=0;
      if (lOutBufSize>=cSizeOfCode) then begin
        {ъюфшЁєхь, шёяюы№чє  сєЇхЁ ъръ ьхёЄю фы  яхЁхьхээющ Code.Code.Bytes => шчсхурхь юфэюую ъюяшЁютрэш  шч ярь Єш т ярь Є№}
        tPCodeDataEx(lpOutBuffer)^.Bytes[0]:=Code.Code.Bytes[0];
        cl:=Code.Length;
        while (i<aInBufSize) and (lOutBufSize>=cSizeOfCode) do begin
    	  { кодируем очередной байт } { ъюфшЁєхь юўхЁхфэющ срщЄ }
  	  cl:=dhEncodeCharEx(tBuffer(AInBuffer)[i], tPCodeDataEx(lpOutBuffer)^, (cl and 7), prTreeData);
	  Inc(i);
          l:=cl shr 3;
          Inc(lpOutBuffer,l);
          Dec(lOutBufSize,l);
        end;
        { тючтЁр∙рхь юсЁрЄэю сєЇхЁ ш фышэє т яхЁхьхээє■ Code }
        Code.Code.Bytes[0]:=tPCodeDataEx(lpOutBuffer)^.Bytes[0];
        Code.Length:=cl and 7;
      end;
      { ъюфшЁєхь юёЄрЄюъ }
      while (i<aInBufSize) and (lOutBufSize>0) do begin
	{ кодируем очередной байт } { ъюфшЁєхь юўхЁхфэющ срщЄ }
	dhEncodeChar(tBuffer(AInBuffer)[i], Code, prTreeData);
	{ копируем коды в битовый буфер} { ъюяшЁєхь ъюф√ т сшЄют√щ сєЇхЁ}
	CopyCodeToBuffer;
	Inc(i);
      end;
      { возвращает размеры обработанных данных }
      { тючтЁр∙рхь ЁрчьхЁ√ юсЁрсюЄрээ√ї фрээ√ї }
      aEncodedSize:=i*cSizeOfTByte;
      aOutDataSize:=aOutBufSize-lOutBufSize;
    end;
    prCode:=Code;
    Encode:=(i>0);

    {$IFDEF LogCoding}
      DHBaseDb.SetEncode;
      for i:=0 to i do begin
        writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','Code: ', tBuffer(AOutBuffer)[i] );
      end;
    {$EndIF DEF LogCoding}
  end;
end;

procedure tDHCodec.ByteToCode(aByte:tByte; var aCode:tCodeEx);
begin
  dhEncodeChar(aByte, aCode, prTreeData);
end;

function tDHCodec.EffectiveMaxTotalCounter:tFriquency;  { ополовинить счетчики после MaxTotalCounter байтов}
begin
  EffectiveMaxTotalCounter:=prTreeData.MaxTotalCounter;
end;

constructor tDHCodec.Init;
begin
  MaxTotalCounter:=0;
  EncodeReset;
end;

destructor tDHCodec.Done;
begin
end;


procedure tDHCodec.ResetRegime;
begin
  dhInitTree(MaxTotalCounter, prTreeData);
  Exclude(prDicFlags,fEncodeRegime);
  Exclude(prDicFlags,fDecodeRegime);
 end;

procedure tDHCodec.EncodeReset;
begin
  ResetRegime;
  prCode.Length:=0;
  Include(prDicFlags,fEncodeRegime);
end;

procedure tDHCodec.DecodeReset;
begin
  ResetRegime;
{  prNodeIndex:=prTreeData.TreeIndexes.Root;}
  prRec.Node:=cRootNode;
  prRec.CodeBits:=0;
  prRec.CodeBitCount:=0;
{  prNodeIndex:=cRootNode;}
  Include(prDicFlags,fDecodeRegime);
end;


function tDHCodec.TotalHalfCount:{$ifndef Delphi}comp{$else}int64{$endif};
{$ifndef Delphi}
begin
  TotalHalfCount:=VLC2Comp(prTreeData.TotalHalfCounterCount);
end;
{$else}
begin
  Result:=prTreeData.TotalHalfCounterCount;
end;
{$endif}


procedure tDHCodec.CompressedByteCount(var aValue:tVeryLongCounter);
begin
  aValue:=prTreeData.TotalBitCount.ByteCount;
end;

procedure tDHCodec.ByteCount(var aValue:tVeryLongCounter);
begin
  aValue:=prTreeData.TotalByteCount;
end;

{$ifdef Delphi}
function  tDHCodec.TotalByteCount:tVeryLongCounter;
begin
  Result:=prTreeData.TotalByteCount;
end;

function tDHCodec.TotalCompressedByteCount:tVeryLongCounter;
begin
  Result:=prTreeData.TotalBitCount.ByteCount;
end;
{$endif def Delphi}

{ отношение размера закодированных данных к размеру исходных данных
(только в режиме SetEncodeRegime) }
function  tDHCodec.CompressionRatio:double;
  {$ifNdef Delphi}
  var r:double;
  {$endif}
begin
  {$ifdef Delphi}
  with prTreeData do begin
    CompressionRatio:=TotalBitCount.ByteCount/TotalByteCount;
  end;
  {$else}
  asm
    les si,Self
    lea si,tDHCodec([si]).prTreeData
    fild qword(es:tDynHuffmanFullTreeData([si]).TotalBitCount.ByteCount)
    fild qword(es:tDynHuffmanFullTreeData([si]).TotalByteCount)
    fdivp
    fstp  qword(r)
  end;
  CompressionRatio:=r;
  {$endif}
end;

function  tDHCodec.CompByteCount:double;
  {$ifNdef Delphi}
  var r:double;
  {$endif}
begin
  {$ifdef Delphi}
  with prTreeData do begin
    CompByteCount:=TotalBitCount.ByteCount;
  end;
  {$else}
  asm
    les si,Self
    lea si,tDHCodec([si]).prTreeData
    fild qword(es:tDynHuffmanFullTreeData([si]).TotalBitCount.ByteCount)
    fstp  qword(r)
  end;
  CompByteCount:=r;
  {$endif}
end;

END.