{ DOS text
	ДИНАМИЧЕСКИЙ метод Хаффмана

	     Основные процедуры.

 Реализация базовых функций для динамического сжатия Хаффмана
   1) Инициализация дерева - "dhInitTree".
   2) Вычисление кода для байта - "dhEncodeChar".
   3) Декодирование битов - "dhDecodeBits".

   В этот файл вынесены основные функции динамического метода Хаффмана.
}
{ Win text
	─╚═└╠╚╫┼╤╩╚╔ ьхЄюф ╒рЇЇьрэр

	     ╬ёэютэ√х яЁюЎхфєЁ√.

 ╨хрышчрЎш  срчют√ї ЇєэъЎшщ фы  фшэрьшўхёъюую ёцрЄш  ╒рЇЇьрэр
   1) ╚эшЎшрышчрЎш  фхЁхтр - "dhInitTree".
   2) ┬√ўшёыхэшх ъюфр фы  срщЄр - "dhEncodeChar".
   3) ─хъюфшЁютрэшх сшЄют - "dhDecodeBits".

   ┬ ¤ЄюЄ Їрщы т√эхёхэ√ юёэютэ√х ЇєэъЎшш фшэрьшўхёъюую ьхЄюфр ╒рЇЇьрэр.
}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 2005

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

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

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 375-41-46
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit DHufBase;

INTERFACE
  USES {$IFDef Delphi}SysUtils, {$EndIF} HufTypes, DHufType {$IFDEF LogCoding}, DHBaseDb {$EndIF DEF LogCoding};

{ ╚эшЎшрышчрЎш  фхЁхтр }{ Инициализация дерева }
procedure dhInitTree(
       aMaxTotalCounter:tFriquency; { ополовинить счетчики после aMaxTotalCounter байтов}
   var aTreeData:tDynHuffmanFullTreeData
);

{ ┬√ўшёыхэшх ъюфр фы  срщЄр aByte }{ Вычисление кода для байта aByte }
procedure dhEncodeChar(
       aByte:tByte;
   var aCode:tCodeEx;
   var aTreeData:tDynHuffmanFullTreeData
); {$IFDef Delphi} register {$EndIF}

{ ┬√ўшёыхэшх ъюфр фы  срщЄр aByte ╧╨▀╠╬ ┬ ┴╙╘┼╨ }{ Вычисление кода для байта aByte }
function dhEncodeCharEx(
       aByte:tByte;
   var aCode:tCodeDataEx;
       aCodeLength:tCodeLength;
   var aTreeData:tDynHuffmanFullTreeData
):tCodeLength; {$IFDef Delphi} register {$EndIF}

{ ─хъюфшЁютрэшх aCodeBitCount сшЄют шч aCodeBits т єчхы aNode, эрўшэр  ё aNode }
{ Декодирование aCodeBitCount битов из aCodeBits в узел aNode, начиная с aNode }
function dhDecodeBits(var aCodeBits:tCodeMaxPortion;
		       var aCodeBitCount:tCodeMaxPortionLength;
		       var aNode:tNodeIndex;
		       var aTreeData:tDynHuffmanFullTreeData
):boolean;

{ ┬ёяюьюурЄхы№эр  ЇєэъЎш  фы  фышээюую ёўхЄўшър срщЄют т BP7. ┬ Delphi эх шёяюы№чєхЄё . }
{ Вспомогательная функция для длинного счетчика байтов в BP7. В Delphi не используется. }
function VLC2Comp(const aVLC:tVeryLongCounter):comp;

IMPLEMENTATION
{$F+}
  USES uMiscFun;

procedure ZeroingVLC(var aVeryLongCounter:tVeryLongCounter); forward;
procedure IncVLC(var aVeryLongCounter:tVeryLongCounter; aIncrement:word); forward;
procedure IncVLBC(var aVeryLongBitCounter:tVeryLongBitCounter; aBitCountIncrement:tCodeLength); forward;
procedure dhReBuildTree(aByte:tByte;
   var aTreeData:tDynHuffmanFullTreeData
); forward;


{  ╧╨╬╤╥└▀ ─┼╩╬─╚╨╬┬╩└ ╧╨╬╒╬─╬╠ ╧╬ ─┼╨┼┬╙
 ─хъюфшЁютрэшх aCodeBitCount сшЄют шч aCodeBits т єчхы aNode,
эрўшэр  ё aNode. ╬фэютЁхьхээю юсэюты хЄ фхЁхтю.

└ЁуєьхэЄ√:
  aCodeBits - сшЄ√ фы  фхъюфшЁютрэш ;
  aCodeBitCount - ўшёыю сшЄ;
  aNode - шэфхъё єчыр фы  эрўрыр фхъюфшЁютрэш ;
  aTreeData - фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ: TRUE - срщЄ фхъюфшЁютрэ,
	    шэрўх FALSE - фхъюфшЁютрэю фю яЁюьхцєЄюўэюую єчыр, Є/ъ чръюэўшышё№ сшЄ√ т aCodeBits.
  aCodeBits - юёЄрЄюъ эхфхъюфшЁютрээ√ї сшЄ ёфтшэєЄ√щ т ёЄюЁюэє ьырф°шї сшЄ;
  aCodeBitCount - ўшёыю эхфхъюфшЁютрээ√ї сшЄ;
  aNode - шэфхъё єчыр фю ъюЄюЁюую фхъюфшЁютрэю, шыш (хёыш ЇєэъЎш  тхЁэєыр TRUE) фхъюфшЁютрээ√щ срщЄ;
  aTreeData - яхЁхёЄЁюхээюх фхЁхтю.

}
{  ПРОСТАЯ ДЕКОДИРОВКА ПРОХОДОМ ПО ДЕРЕВУ
 Декодирование aCodeBitCount битов из aCodeBits в узел aNode,
начиная с aNode. Одновременно обновляет дерево.

Аргументы:
  aCodeBits - биты для декодирования;
  aCodeBitCount - число бит;
  aNode - индекс узла для начала декодирования;
  aTreeData - данные дерева Хаффмана.

Возвращает: TRUE - байт декодирован,
	    иначе FALSE - декодировано до промежуточного узла, т/к закончились биты в aCodeBits.
  aCodeBits - остаток недекодированных бит сдвинутый вправо;
  aCodeBitCount - число недекодированных бит;
  aNode - индекс узла (если TRUE = декодированный байт);
  aTreeData - перестроенное дерево.
}
function dhDecodeBits(
        var aCodeBits:tCodeMaxPortion;
        var aCodeBitCount:tCodeMaxPortionLength;
        var aNode:tNodeIndex;
        var aTreeData:tDynHuffmanFullTreeData
):boolean;
  var
    Node:tHalfIndexEx;
    CodeBits:tCodeMaxPortion;
    CodeBitCount:tCodeMaxPortionLength;
begin
  dhDecodeBits:=FALSE;
  if aCodeBitCount=0 then begin
    Exit;
  end;
  CodeBits:=aCodeBits;
  Node:=aNode;
  if Node=cRootNode then
    Node:=cRootNode_UpperNode; {254}

  { ─хъюфшЁютър яЁюїюфюь яю фхЁхтє. }
  { Декодировка проходом по дереву. }
  with aTreeData do begin
    for CodeBitCount:=Pred(aCodeBitCount) downto 0 do begin
      Node:=Nodes[(Node shl 1) or (CodeBits and 1)].UpperNode;
      CodeBits:=CodeBits shr 1;
      { хёыш срщЄ фхъюфшЁютрэ }	{ если байт декодирован }
      if (Node>=cBaseNodeCount) then begin
	  { юсэютшЄ№ фхЁхтю } { обновить дерево }
          Dec(Node,cBaseNodeCount);
	  aNode:=Node;
	  dhReBuildTree(Node, aTreeData);
	  aCodeBits:=CodeBits;
	  aCodeBitCount:=CodeBitCount;
	  dhDecodeBits:=TRUE;
	  Exit;
      end;
    end;
  end;

  { ╟ряюьшэрхь фхъюфшЁютрээє■ ўрёЄ№. }
  { Запоминаем декодированную часть. }
  aNode:=Node;
  aCodeBitCount:=0;
end;

{ ╤┴╨╬╤ ╤╫┼╥╫╚╩╬┬ ╧╨╚ ╧┼╨┼╧╬╦═┼═╚╚

╬яюыютшэштрхЄ ёўхЄўшъш фы  ┴└╟╬┬█╒ єчыют фхЁхтр ш яхЁхёЄЁрштрхЄ фхЁхтю.

└ЁуєьхэЄ√:
  aTreeData - фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ:
  aTreeData - ёю ёўхЄўшърьш Ёртэ√ьш яюыютшэх шёїюфэюую чэрўхэш  ш яхЁхёЄЁюхээюх фхЁхтю.

}
{ СБРОС СЧЕТЧИКОВ ПРИ ПЕРЕПОЛНЕНИИ

Ополовинивает счетчики для БАЗОВЫХ узлов дерева и перестраивает дерево.

Аргументы:
  aTreeData - данные дерева Хаффмана.

Возвращает:
  aTreeData - со счетчиками равными половине исходного занчения и перестроенное дерево.

}
procedure dhHalfCounters(
	var aTreeData:tDynHuffmanFullTreeData
);
  var b:tBaseNodeIndex; i,f,l,j:tIndex;
      Index:tBaseNodesDataEx; EOP:boolean;
      {$IfOpt R+} tc, ntc:tFriquency;{$EndIf}
begin
  with aTreeData do begin
    {$IFDEF XLogCoding}
    writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': '
    , 'dhHalfCountersEx', Nodes[cRootNode].Counter );
    {$EndIF XDEF LogCoding}

    {$IfOpt R+} tc:=Nodes[cRootNode].Counter;{$EndIf}

    { юяюыютшэштрхь тёх ёўхЄўшъш фы  срчютющ ЄрсышЎ√ ш ёЄЁюшь шэфхъё
    фы  срчют√ї єчыют }
    { ополовиниваем все счетчики для базовой таблицы и строим индекс
    для базовых узлов }

   { яхЁт√х фтр єчыр ьюцэю яЁюяєёЄшЄ№ - юэш єцх эр эєцэюь ьхёЄх}
   { первые два узла можно пропустить - они уже на нужном месте}
    Nodes[0].Counter:=Succ(Nodes[0].Counter shr 1);
    Nodes[1].Counter:=Succ(Nodes[1].Counter shr 1);
    b:=Low(b)+1;
    i:=Low(i)+2;
    repeat
      if (Nodes[i].UpperNode>=cBaseNodeCount) then begin
        Inc(b);
	{ ёўхЄўшъ юяюыютшэштрхь }{ счетчик ополовиниваем }
	with Index[b] do begin
          UpperNode:=Nodes[i].UpperNode;
	  Counter:=Succ(Nodes[i].Counter shr 1);
	end;
      end;
      Inc(i);
    until b=High(b);
  { яю юъюэўрэшш ¤Єюую Ўшъыр т ьрёёштх Index эрїюфшЄё  єяюЁ фюўхээр 
    яю тючЁрёЄрэш■ ўрёЄюЄ√ (Counter) яюёыхфютрЄхы№эюёЄ№ "срчют√ї єчыют" }
  { по окончании этого цикла в массиве Index находится упорядоченная
    по возрастанию частоты последовательность номеров элементов исходной таблицы частот }

    {$IfOpt R+}
      ntc:=Nodes[0].Counter+Nodes[1].Counter;
      for b:=Low(b)+2 to High(b) do begin
	Inc(ntc,Index[b].Counter);
      end;
      if tc<=ntc then begin
	{ ёыш°ъюь ьрыхэ№ъюх чэрўхэшх фы  юяюыютшэштрэш  ёўхЄўшъют }
	{ слишком маленькое значение для ополовинивания счетчиков }
	writeln('Error: ', tc, ' ', ntc); readln;
	RunError(201);
      end;
    {$EndIf}


    { ═└╫╚═└┼╠ ╤╥╨╬╚╥▄ ─┼╨┼┬╬ !!!эєыхт√ї ўрёЄюЄ√ эхЄ!!!}
    { НАЧИНАЕМ СТРОИТЬ ДЕРЕВО !!!нулевых частоты нет!!!}

    { ╚эшЎшрышчшЁєхь фтх яюёыхфютрЄхы№эюёЄш:
      1 - т Index;
      2 - т Nodes (эрўшэр  ё cBaseNodeCount)}
    { Инициализируем две последовательности:
      1 - в Index;
      2 - в Nodes (начиная с cBaseNodeCount)}

    { т√сшЁрхь ьшэшьры№э√х єчы√ фы  юс·хфшэхэш  т эют√щ єчхы
     ш шёъы■ўрхь ¤Єш єчы√ (яхЁт√щ ш тЄюЁющ) шч Єхъє∙хщ ЄрсышЎ√ }
    { выбираем минимальные узлы для объединения в новый узел
     и исключаем эти узлы (первый и второй) из текущей таблицы }

    i:=Low(i)+2; { i - фрыхх эюьхЁ яхЁтюую эхюсЁрсюЄрээюую єчыр шч Index}
		 { i - далее номер первого необработанного узла из Index}
    f:=Low(f)+2; { f - фрыхх эюьхЁ яхЁтюую ётюсюфэюую єчыр т Nodes }
		 { f - далее номер первого свободного узла в Nodes }

    { фюсрты хь т ЄрсышЎє эют√щ єчхы }
    { добавляем в таблицу новый узел }

    l:=cBaseNodeCount; { эют√щ єчхы }{ новый узел }
    j:=cBaseNodeCount;  { фрыхх j= эюьхЁ яхЁтюую эхюсЁрсюЄрээюую єчыр шч Nodes (тЄюЁр  яюёыхфютрЄхы№эюёЄ№) }
			{ далее j= номер первого необработанного узла из Nodes (вторая последовательность) }
    with Nodes[cBaseNodeCount] do begin
      { чряюьшэрхь ёєььє ёўхЄўшъют ўрёЄюЄ√ тїюцфхэшщ }
      { запоминаем сумму счетчиков частоты вхождений }
      Counter:=Nodes[0].Counter+Nodes[1].Counter;
      { чряюьшэрхь ёё√ыъє эр яЁхф√фє∙шх єчы√ }
      { запоминаем ссылку на предыдущие узлы }
      UpperNode:=0;
    end;

    { яюър эх яєёЄр 1 яюёыхфютрЄхы№эюёЄ№ }
    { пока не пуста 1 последовательность }
    while i<cBaseNodeCount do begin
      { фюсрты хь т ЄрсышЎє эют√щ єчхы }
      { добавляем в таблицу новый узел }
      Inc(l);

      { т√сшЁрхь ьшэшьры№э√х єчы√ фы  юс·хфшэхэш  т эют√щ єчхы }
      { выбираем минимальные узлы для объединения в новый узел }

      { чэрўхэшх 1-ую ёўхЄўшър 2-щ яюёыхфютрЄхы№эюёЄш
      ёЁртэштрхь ёю чэрўхэшь 1-ую ёўхЄўшър 1-щ яюёыхфютрЄхы№эюёЄш }
      { значение 1-го счетчика 2-й последовательности
      сравниваем со значеним 1-го счетчика 1-й последовательности }
      if Nodes[j].Counter<Index[i].Counter then begin
	{ хёыш чэрўхэшх 1-ую ёўхЄўшър 2-щ яюёыхфютрЄхы№эюёЄш ьхэ№°х, Єю
	  т√сшЁрхь хую ъръ яхЁт√щ (ыхт√щ) єчхы фы  ёыш эш  }
	{ если значение 1-го счетчика 2-й последовательности меньше, то
	  выбираем его как первый (левый) узел для слияния }
	Nodes[f]:=Nodes[j];
	Refs.NextNode[Nodes[f].UpperNode]:=f;

	{ ш шёъы■ўрхь ¤ЄюЄ єчхы шч 2-щ яюёыхфютрЄхы№эюёЄш }
	{ и исключаем этот узел из 2-й последовательности }
	Inc(j);
	Inc(f);

	{ яЁютхЁ хь юъюэўрэшх яюёыхфютрЄхы№эюёЄш 2}
	{ проверяем окончание последовательности 2}
	EOP:=(j=l);
	if EOP then begin
	  { хёыш яюёыхф. 2 чръюэўшырё№, Єю т√сшЁрхь  1-щ єчхы
	  1-щ яюёыхфютрЄхы№эюёЄш ъръ тЄюЁющ (яЁрт√щ) єчхы фы  ёыш эш  }
	  { если послед. 2 закончилась, то выбираем  1-й узел
	  1-й последовательности как второй (правый) узел для слияния }
	  Nodes[f]:=Index[i];
	  Refs.NextNode[Index[i].UpperNode]:=f;
	  { ш шёъы■ўрхь ¤ЄюЄ єчхы шч 1-щ яюёыхфютрЄхы№эюёЄш }
	  { и исключаем этот узел из 1-й последовательности }
	  Inc(i);
	end;
      end else begin
	{ хёыш чэрўхэшх 1-ую ёўхЄўшър 1-щ яюёыхфютрЄхы№эюёЄш ьхэ№°х, Єю
	т√сшЁрхь хую ъръ яхЁт√щ (ыхт√щ) єчхы фы  ёыш эш  }
	{ если значение 1-го счетчика 1-й последовательности меньше, то
	выбираем его как первый (левый) узел для слияния }
	Nodes[f]:=Index[i];
	Refs.NextNode[Index[i].UpperNode]:=f;

	{ ш шёъы■ўрхь ¤ЄюЄ єчхы шч 1-щ яюёыхфютрЄхы№эюёЄш }
	{ и исключаем этот узел из 1-й последовательности }
	Inc(i);
	Inc(f);

	{ яЁютхЁ хь юъюэўрэшх яюёыхфютрЄхы№эюёЄш 1}
	{ проверяем окончание последовательности 1}
	EOP:=(i=cBaseNodeCount);
	if EOP then begin
	  { хёыш яюёыхф. 1 чръюэўшырё№, Єю т√сшЁрхь  1-щ єчхы
	   2-щ яюёыхфютрЄхы№эюёЄш ъръ тЄюЁющ (яЁрт√щ) єчхы фы  ёыш эш  }
	  { если послед. 1 закончилась, то выбираем  1-й узел
	   2-й последовательности как второй (правый) узел для слияния }
	  Nodes[f]:=Nodes[j];
	  Refs.NextNode[Nodes[f].UpperNode]:=f;
	  { ш шёъы■ўрхь ¤ЄюЄ єчхы шч 2-щ яюёыхфютрЄхы№эюёЄш }
	  { и исключаем этот узел из 2-й последовательности }
	  Inc(j);
	end;
      end;
      if not EOP then begin
	 { хёыш т яюёыхфютрЄхы№эюёЄ ї хёЄ№ єчы√, Єю
	 чэрўхэшх 1-ую ёўхЄўшър 2-щ яюёыхфютрЄхы№эюёЄш
	 ёЁртэштрхь ёю чэрўхэшь 1-ую ёўхЄўшър 1-щ яюёыхфютрЄхы№эюёЄш }
	 { если в последовательностях есть узлы, то
	 значение 1-го счетчика 2-й последовательности
	 сравниваем со значеним 1-го счетчика 1-й последовательности }
	if Nodes[j].Counter<Index[i].Counter then begin
	  { хёыш чэрўхэшх 1-ую ёўхЄўшър 2-щ яюёыхфютрЄхы№эюёЄш ьхэ№°х, Єю
	    т√сшЁрхь хую ъръ ъръ тЄюЁющ (яЁрт√щ) єчхы фы  ёыш эш  }
	  { если значение 1-го счетчика 2-й последовательности меньше, то
	    выбираем его как как второй (правый) узел для слияния }
	  Nodes[f]:=Nodes[j];
	  Refs.NextNode[Nodes[f].UpperNode]:=f;

	  { ш шёъы■ўрхь ¤ЄюЄ єчхы шч 2-щ яюёыхфютрЄхы№эюёЄш }
	  { и исключаем этот узел из 2-й последовательности }
	  Inc(j);

	end else begin
	  { шэрўх т√сшЁрхь 1-щ єчхы
	    1-щ яюёыхфютрЄхы№эюёЄш ъръ тЄюЁющ (яЁрт√щ) єчхы фы  ёыш эш  }
	  { иначе выбираем 1-й узел
	    1-й последовательности как второй (правый) узел для слияния }
	  Nodes[f]:=Index[i];
	  Refs.NextNode[Index[i].UpperNode]:=f;

	   { ш шёъы■ўрхь ¤ЄюЄ єчхы шч 1-щ яюёыхфютрЄхы№эюёЄш }
	   { и исключаем этот узел из 1-й последовательности }
	   Inc(i);
	end;
      end;

      with Nodes[l] do begin
	{ чряюьшэрхь ёєььє ёўхЄўшъют ўрёЄюЄ√ тїюцфхэшщ }
	{ запоминаем сумму счетчиков частоты вхождений }
	Counter:=Nodes[Pred(f)].Counter+Nodes[f].Counter;
	{ чряюьшэрхь ёё√ыъє эр яЁхф√фє∙шх єчы√ }
	{ запоминаем ссылку на предыдущие узлы }
	UpperNode:=f shr 1;
      end;
      Inc(f);
    end;

    { яюър эх яєёЄр 2 яюёы. } { пока не пуста 2 посл. }
    while (f<l) do begin
      { фюсрты хь т ЄрсышЎє эют√щ єчхы }
      { добавляем в таблицу новый узел }
      Inc(l);
      { юс·хфшэ хь ьшэшьры№э√х єчы√ т эют√щ єчхы }
      { объединяем минимальные узлы в новый узел }
      Refs.NextNode[Nodes[f].UpperNode]:=f;
      Inc(f);
      Refs.NextNode[Nodes[f].UpperNode]:=f;
      with Nodes[l] do begin
	{ чряюьшэрхь ёєььє ёўхЄўшъют ўрёЄюЄ√ тїюцфхэшщ }
	{ запоминаем сумму счетчиков частоты вхождений }
	Counter:=Nodes[Pred(f)].Counter+Nodes[f].Counter;
	{ чряюьшэрхь ёё√ыъє эр яЁхф√фє∙шх єчы√ }
	{ запоминаем ссылку на предыдущие узлы }
	UpperNode:=f shr 1;
      end;
      Inc(f);
    end;

    IncVLC(TotalHalfCounterCount,1);
  end;
end;

{ ╧┼╨┼╤╥╨╬┼═╚┼ ─┼╨┼┬└

╧хЁхёЄЁрштрхЄ фхЁхтю т ёююЄтхЄёЄтшш ё шчьхэхэшхь ёўхЄўшър срщЄр aByte эр +1.

└ЁуєьхэЄ√:
  aByte - чэрўхэшх юўхЁхфэюую срщЄр;
  aTreeData - фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ:
  aTreeData - яхЁхёЄЁюхээюх фхЁхтю.
}
{ ПЕРЕСТРОЕНИЕ ДЕРЕВА

Перестраивает дерево в соответствии с изменением счетчика байта aByte на +1.

Аргументы:
  aByte - значение очередного байта;
  aTreeData - данные дерева Хаффмана.

Возвращает:
  aTreeData - перестроенное дерево.
}
procedure dhReBuildTree(
        aByte:tByte;
   var  aTreeData:tDynHuffmanFullTreeData
);

  var
    c:tFriquency;
    i, i0{, i1, ix} :tIndex;
    node:tNodeData;

begin
 {$IFDEF LogCoding}
{   writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','dhBuildTree ');}
 {$EndIF DEF LogCoding}

  with aTreeData do begin
    { хёыш фюёЄшуэєЄ яЁхфхы фы  чэрўхэш  ёўхЄўшъют }
    { если достигнут предел для значения счетчиков }
    if Nodes[cRootNode].Counter>=MaxTotalCounter then begin
      { юяюыютшэштрхь ёўхЄўшъш }{ ополовиниваем счетчики }
      dhHalfCounters(aTreeData);
    end;

    { єтхышўштрхь яюыэюх ўшёыю срщЄ }{ увеличиваем полное число байт }
    Inc(Nodes[cRootNode].Counter);
    { яюыєўрхь ёё√ыъє эр яючшЎш■ срщЄр aByte т єяюЁ фюўхээюь ёяшёъх-фхЁхтх }
    { получаем ссылку на позицию байта aByte в упорядоченном списке-дереве }
    i0:=Refs.Byte[aByte];

    { яюър эх єЄъэхьё  т ъюЁхэ№ } { пока не уткнемся в корень }
    repeat
      { єтхышўштрхь ёўхЄўшъ єчыр } { увеличиваем счетчик узла }
      Inc(Nodes[i0].Counter);
      { чряюьшэрхь ёўхЄўшъ } { запоминаем счетчик }
      c:=Nodes[i0].Counter;
      { ёЁртэштрхь ёю ёыхфє■∙шь т єяюЁ фюўхээюь ёяшёъх }
      { сравниваем со следующим в упорядоченном списке }
      if c>Nodes[Succ(i0)].Counter then begin
        { хёыш єяюЁ фюўхээюёЄ№ эрЁє°хэр }
        { если упорядоченность нарушена }

	{ ш∙хь сышцрщ°шщ ёыхфє■∙шщ ёўхЄўшъ, сюы№°шщ шыш Ёртэ√щ фрээюьє }
	{ ищем ближайший следующий счетчик, больший или равный данному }
	i:=i0;
	repeat
	  Inc(i0);
	until c<=Nodes[Succ(i0)].Counter;

	{ юсьхэштрхь єчы√ }{ обмениваем узлы }
	node:=Nodes[i0];
	Nodes[i0]:=Nodes[i];
	Nodes[i]:=node;

	{ юсэюты хь ёё√ыъш фы  єчыют-яЁхфъют }
	{ обновляем ссылки для узлов-предков }
        Refs.NextNode[node.UpperNode]:=i;

	{ юсэюты хь ёё√ыъш фы  єчыют-яЁхфъют }
	{ обновляем ссылки для узлов-предков }
	Refs.NextNode[Nodes[i0].UpperNode]:=i0;
      end;
      i0:=Refs.NextNode[i0 shr 1];
    until i0=cRootNode;

    IncVLC(TotalByteCount,1);

  end;
end;

{ ╚═╚╓╚└╦╚╟└╓╚▀ ─┼╨┼┬└

╟ряюыэ хЄ фхЁхтю шёїюфэ√ьш фрээ√ьш, Єръ ўЄюс√ ъюф срщЄр=чэрўхэш■ срщЄр

└ЁуєьхэЄ√:
  aTreeData - эхшэшЎшрышчЁютрээ√х фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ:
  aTreeData - шэшЎшрышчшЁютрээюх фхЁхтю.
}
{ ИНИЦИАЛИЗАЦИЯ ДЕРЕВА

Заполняет дерево исходными данными, так чтобы код байта=значению байта

Аргументы:
  aTreeData - неинициализрованные данные дерева Хаффмана.

Возвращает:
  aTreeData - инициализированное дерево.
}
procedure dhInitTree(
       aMaxTotalCounter:tFriquency; { ополовинить счетчики после aMaxTotalCounter байтов}
   var aTreeData:tDynHuffmanFullTreeData
);
  var b:tByte; i,ii:tIndex;
begin
  { яюёЄЁюхэшх шёїюфэюую фхЁхтр }
  { построение исходного дерева }
  with aTreeData do begin
     if aMaxTotalCounter<cMin_MaxTotalCounter then aMaxTotalCounter:=cMin_MaxTotalCounter;
     { яюыэюх ўшёыю ёюёўшЄрээ√ї срщЄ яюёых ъюЄюЁюую яЁютюфшЄё  юяюыютшэштрэшх ёўхЄўшъют }
     { полное число сосчитанных байт после которого проводится ополовинивание счетчиков }
     MaxTotalCounter:=aMaxTotalCounter;
     { чряюыэ хь срчютє■ ўрcЄ№ фхЁхтр }{ заполняем базовую чаcть дерева }
     for b:=Low(b) to High(b) do begin
       Refs.Byte[b]:=b;
       with Nodes[b] do begin
	 Counter:=1;
	 UpperNode:=b+cBaseNodeCount;
       end;
     end;
     { ёЄЁюшь юёЄрЄюъ фхЁхтр }{ строим остаток дерева }
     ii:=Low(b);
     for i:=Succ(High(b)) to High(i) do begin
       with Nodes[i] do begin
	 UpperNode:=ii shr 1;
	 Counter:=Nodes[ii].Counter+Nodes[ii+1].Counter;
       end;
       { єёЄрэртыштрхь яЁшчэръ ёыхфє■∙шщ єчхы }
       { устанавливаем признак следующий узел }
       Refs.NextNode[ii shr 1]:=i;
       Inc(ii,2);
     end;

     { юсэєы хь ёўхЄўшъш }
     { обнуляем счетчики }
     ZeroingVLC(TotalHalfCounterCount);
     ZeroingVLC(TotalByteCount);
     with TotalBitCount do begin
       BitCount:=0;
       ZeroingVLC(ByteCount);
     end;

  end;
end;

{ ╩╬─╚╨╬┬└═╚┼ ╤╚╠┬╬╦└

┬√ўшёы хЄ ъюф фы  ёшьтюыр aByte, шчьхэ хЄ ёўхЄўшъш ш яхЁхёЄЁрштрхЄ фхЁхтю т ёююЄтхЄёЄтшш ё шчьхэхэшхь ёўхЄўшъют срщЄ

└ЁуєьхэЄ√:
  aByte - чэрўхэшх юўхЁхфэюую срщЄр фы  ъюфшЁютрэш ;
  aCode - яхЁхьхээр  фы  тючтЁрЄр ъюфр ╒рЇЇьрэр,
	!!! ╤ ╬╤╥└╥╩╬╠ ┴╚╥ (эхяюыэ√ь срщЄюь), фышэр юёЄрЄър т aCode.Length эх сюыхх 7 сшЄ.
  aTreeData -  фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ:
  aCode - юёЄрЄюъ ъюфр+ъюф ╒рЇЇьрэр фы  aByte.
  aTreeData - яхЁхёЄЁюхээюх фхЁхтю.
}
{ КОДИРОВАНИЕ СИМВОЛА

Вычисляет код для символа aByte, изменяет счетчики и перестраивает дерево в соответствии с изменением счетчиков байт

Аргументы:
  aByte - значение очередного байта для кодирования;
  aCode - переменная для возврата кода Хаффмана,
	!!! С ОСТАТКОМ БИТ (неполным байтом), длина остатка в aCode.Length не более 7 бит.
  aTreeData -  данные дерева Хаффмана.

Возвращает:
  aCode - остаток кода+код Хаффмана для aByte.
  aTreeData - перестроенное дерево.
}
procedure dhEncodeChar(
       aByte:tByte;
   var aCode:tCodeEx;
   var aTreeData:tDynHuffmanFullTreeData
);
  var
    bc,bc1:tCodeByteIndexEx1;
    n:tIndex;
    c:0..7;
    ol,nl:tCodeLength;
    pBytes:^tCodeBytesEx1;
    pb:^byte;
    b:byte;
  type
    pW=^Word;
  const
    maxBC=HIGH(tCodeByteIndexEx);

begin
 {$IFDEF LogCoding}
{   writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','dhEncodeChar: ', aByte);}
 {$EndIF DEF LogCoding}

  { ┬√ўшёыхэшх ъюфр фы  срщЄр aByte }
  { Вычисление кода для байта aByte }
  with aTreeData do begin
    pBytes:=@aCode.Code.AllBytes;
    { яюыєўрхь ёё√ыъє эр єчхы фы  aByte }
    { получаем ссылку на узел для aByte }
    n:=Refs.Byte[aByte];

    { ┬√ўшёы хь ъюф (эю сшЄ√ чрэюё Єё  эрўшэр  ёю ёЄрЁ°хую сшЄр т aCode.Code) }
    { Вычисляем код (но биты заносятся начиная со старшего бита в aCode.Code) }
    pb:=@aCode.Code.Bytes[maxBC];
    repeat
      b:=0;
      for c:=7 downto 0 do begin
	{ ╧ЁютхЁ хь  ты хЄё  ыш фрээ√щ єчхы ╧╨└┬█╠ яЁхф√фє∙шь єчыюь фы  ёыхфє■∙хую,
	  хёыш ─└, Єю єёЄрэртыштрхь т сшЄютющ Ўхяюўъх 1.}
	{ Проверяем является ли данный узел ПРАВЫМ предыдущим узлом для следующего,
	  если ДА, то устанавливаем в битовой цепочке 1.}
	b:=(b shl 1) or (n and 1);
	{ яюыєўрхь ёё√ыъє эр ёыхфє■∙шщ єчхы т фхЁхтх. }
	{ получаем ссылку на следующий узел в дереве. }
	n:=Refs.NextNode[n shr 1];
	{ яютЄюЁ хь, яюър эх фющфхь фю ъюЁэхтюую єчыр фхЁхтр. }
	{ повторяем, пока не дойдем до корневого узла дерева. }
	if (n=cRootNode) then begin
	  b:=(b shl c);
	  break;
	end;
      end;
      pb^:=b;
      Dec(pb);
      { яютЄюЁ хь, яюър эх фющфхь фю ъюЁэхтюую єчыр фхЁхтр. }
      { повторяем, пока не дойдем до корневого узла дерева. }
    until (n=cRootNode);
    bc:=longint(pb)-longint(pBytes);

    { ╤фтшурхь т√ўшёыхээ√щ ъюф }
    { Сдвигаем и вычисленный код }
    ol:=aCode.Length; {фышэр юёЄрЄър ъюфр т aCode.Code}
    bc1:=(maxBC-bc); {ўшёыю яюыэ√ї ш эхяюыэ√ї срщЄют эютюую ъюфр}
    nl:=bc1*8-c; {ўшёыю сшЄ эютюую ъюфр}
    IncVLBC(TotalBitCount, nl); { єтхышўштрхь ёўхЄўшъ сшЄ }
    Inc(aCode.Length,nl); {яюыэр  фышэр ъюфр т сшЄрї ╬ёЄрЄюъ+═ют√щ}
    Inc(bc);
    if c=ol then begin
      if ol=0 then
        Move(pBytes^[bc],pBytes^[Low(bc1)], bc1+1)
      else begin
        Inc(pBytes^[Low(bc1)], pBytes^[bc]);
        Move(pBytes^[bc+1], pBytes^[Low(bc1)+1], bc1);
      end;
    end else begin
      if c>ol then begin
        bc1:=Low(bc1);
        if ol>0 then begin
          c:=c-ol;
          Inc(pBytes^[Low(bc1)],Lo((pW(@pBytes^[bc])^ shr c)));
          Inc(bc); Inc(bc1);
        end;
      end else begin
        c:=ol-c;
        Inc(pBytes^[Low(bc1)],(pBytes^[bc] shl c));
        c:=8-c;
        bc1:=Low(bc1)+1;
      end;
      for bc:=bc to maxBC do begin
        pBytes^[bc1]:=Lo(pW(@pBytes^[bc])^ shr c);
        Inc(bc1);
      end;
{???      aCode.Code.Bytes[bc1]:=0;}
    end;

 {$IFDEF xLogCoding}
   if aCode.Length>8 then
    writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','Code: ', aCode.Length,'-', aCode.Code.Words[0] )
   else
    writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','Code: ', aCode.Length,'-', aCode.Code.Bytes[0] );
 {$EndIF DEF LogCoding}

    { ╧хЁхёЄЁрштрхь фхЁхтю } { Перестраиваем дерево }
    dhReBuildTree(aByte, aTreeData);
  end;
end;

{ ╩╬─╚╨╬┬└═╚┼ ╤╚╠┬╬╦└

┬√ўшёы хЄ ъюф фы  ёшьтюыр aByte, шчьхэ хЄ ёўхЄўшъш ш яхЁхёЄЁрштрхЄ фхЁхтю т ёююЄтхЄёЄтшш ё шчьхэхэшхь ёўхЄўшъют срщЄ

└ЁуєьхэЄ√:
  aByte - чэрўхэшх юўхЁхфэюую срщЄр фы  ъюфшЁютрэш ;
  aCode - яхЁхьхээр  фы  тючтЁрЄр ъюфр ╒рЇЇьрэр, !!! ╤ ╬╤╥└╥╩╬╠ ┴╚╥ (эхяюыэ√ь срщЄюь), фышэр юёЄрЄър т aCodeLength.
  aCodeLength - фышэр юёЄрЄър сшЄ т aCode, эх сюыхх 7 сшЄ;
  aTreeData - фрээ√х фхЁхтр ╒рЇЇьрэр.

┬ючтЁр∙рхЄ:
  яюыэє■ фышэє ъюфр т сшЄрї т яхЁхьхээющ aCode (юёЄрЄюъ+фышэр эютюую ъюфр);
  aCode - юёЄрЄюъ ъюфр+ъюф ╒рЇЇьрэр фы  aByte;
  aTreeData - яхЁхёЄЁюхээюх фхЁхтю.
}
{ КОДИРОВАНИЕ СИМВОЛА

Вычисляет код для символа aByte, изменяет счетчики и перестраивает дерево в соответствии с изменением счетчиков байт

Аргументы:
  aByte - значение очередного байта для кодирования;
  aCode - переменная для возврата кода Хаффмана, !!! С ОСТАТКОМ БИТ (неполным байтом), длина остатка в aCodeLength.
  aCodeLength - длина остатка бит в aCode, не более 7 бит;
  aTreeData - данные дерева Хаффмана.

Возвращает:
  полную длину кода в битах в переменной aCode (остаток+длина нового кода);
  aCode - остаток кода+код Хаффмана для aByte;
  aTreeData - перестроенное дерево.
}
function dhEncodeCharEx(
       aByte:tByte;
   var aCode:tCodeDataEx;
       aCodeLength:tCodeLength;
   var aTreeData:tDynHuffmanFullTreeData
):tCodeLength;
  var
    bc,bc1:tCodeByteIndexEx1;
    n:tIndex;
    c:0..7;
    nl:tCodeLength;
    pBytes:^tCodeBytesEx1;
    pNextNode:^tNextNodes;
    pb:^byte;
    b:byte;
  type
    pW=^Word;
  const
    maxBC=HIGH(tCodeByteIndexEx);

begin
 {$IFDEF LogCoding}
{   writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','dhEncodeChar: ', aByte);}
 {$EndIF DEF LogCoding}

  { ┬√ўшёыхэшх ъюфр фы  срщЄр aByte }
  { Вычисление кода для байта aByte }
  aCode.AdditionalByte:=0;
  pBytes:=@aCode.AllBytes;

  { яюыєўрхь ёё√ыъє эр єчхы фы  aByte }
  { получаем ссылку на узел для aByte }
  n:=aTreeData.Refs.Byte[aByte];
  pNextNode:=@aTreeData.Refs.NextNode0;

    { ┬√ўшёы хь ъюф (эю сшЄ√ чрэюё Єё  эрўшэр  ёю ёЄрЁ°хую сшЄр т aCode.Code) }
    { Вычисляем код (но биты заносятся начиная со старшего бита в aCode.Code) }
    pb:=@aCode.Bytes[maxBC];
    repeat
      b:=0;
      for c:=7 downto 0 do begin
	{ ╧ЁютхЁ хь  ты хЄё  ыш фрээ√щ єчхы ╧╨└┬█╠ яЁхф√фє∙шь єчыюь фы  ёыхфє■∙хую,
	  хёыш ─└, Єю єёЄрэртыштрхь т сшЄютющ Ўхяюўъх 1.}
	{ Проверяем является ли данный узел ПРАВЫМ предыдущим узлом для следующего,
	  если ДА, то устанавливаем в битовой цепочке 1.}
{	b:=((b shl 1) and $ff) or (n and 1);}
	b:=(b shl 1) or (n and 1);
	{ яюыєўрхь ёё√ыъє эр ёыхфє■∙шщ єчхы т фхЁхтх. }
	{ получаем ссылку на следующий узел в дереве. }
	n:=pNextNode^[n shr 1];
	{ яютЄюЁ хь, яюър эх фющфхь фю ъюЁэхтюую єчыр фхЁхтр. }
	{ повторяем, пока не дойдем до корневого узла дерева. }
	if (n=cRootNode) then begin
{	  b:=(b shl c) and $ff;}
	  b:=(b shl c);
	  break;
	end;
      end;
      pb^:=b;
      Dec(pb);
      { яютЄюЁ хь, яюър эх фющфхь фю ъюЁэхтюую єчыр фхЁхтр. }
      { повторяем, пока не дойдем до корневого узла дерева. }
    until (n=cRootNode);
    { ┬√ўшёы хь, ёъюы№ъю срщЄ шёяюы№чютрэю }
    bc:=longint(pb)-longint(pBytes);

    { ╤фтшурхь т√ўшёыхээ√щ ъюф }
    { Сдвигаем и вычисленный код }
    bc1:=(maxBC-bc); {ўшёыю яюыэ√ї ш эхяюыэ√ї срщЄют эютюую ъюфр}
    nl:=bc1*8-c; {ўшёыю сшЄ эютюую ъюфр}
    IncVLBC(aTreeData.TotalBitCount, nl); { єтхышўштрхь ёўхЄўшъ сшЄ }
    dhEncodeCharEx:=aCodeLength+nl; {яюыэр  фышэр ъюфр т сшЄрї ╬ёЄрЄюъ+═ют√щ}
    Inc(bc);
    if c=aCodeLength then begin
      if aCodeLength=0 then
        Move(pBytes^[bc],pBytes^[Low(bc1)], bc1+1)
      else begin
        pBytes^[Low(bc1)]:=pBytes^[Low(bc1)] or pBytes^[bc];
        Move(pBytes^[bc+1], pBytes^[Low(bc1)+1], bc1);
      end;
    end else begin
      if c>aCodeLength then begin
        bc1:=Low(bc1);
        if aCodeLength>0 then begin
          c:=c-aCodeLength;
          pBytes^[Low(bc1)]:=pBytes^[Low(bc1)] or Lo((pW(@pBytes^[bc])^ shr c));
          Inc(bc); bc1:=Low(bc1)+1;
        end;
      end else begin
        c:=aCodeLength-c;
{        pBytes^[Low(bc1)]:=pBytes^[Low(bc1)] or ((pBytes^[bc] shl c) and $ff);}
        pBytes^[Low(bc1)]:=pBytes^[Low(bc1)] or Lo((pBytes^[bc] shl c));
        c:=8-c;
        bc1:=Low(bc1)+1;
      end;
      for bc:=bc to maxBC do begin
        pBytes^[bc1]:=Lo(pW(@pBytes^[bc])^ shr c);
        Inc(bc1);
      end;
    end;

 {$IFDEF xLogCoding}
   if aCodeLength+nl>8 then
    writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','Code: ', aCode.Length,'-', aCode.Code.Words[0] )
   else
    writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','Code: ', aCode.Length,'-', aCode.Code.Bytes[0] );
 {$EndIF DEF LogCoding}

    { ╧хЁхёЄЁрштрхь фхЁхтю } { Перестраиваем дерево }
    dhReBuildTree(aByte, aTreeData);

end;


procedure ZeroingVLC(var aVeryLongCounter:tVeryLongCounter);
  {$IfNDef Delphi}
   var i:tVeryLongCounterWordsNumber;
  {$EndIf}
begin
  {$IfDef Delphi}
   aVeryLongCounter:=0;
  {$Else}
     for i:=low(i)  to high(i) do aVeryLongCounter[i]:=0;
  {$EndIf};
end;

procedure IncVLC(var aVeryLongCounter:tVeryLongCounter; aIncrement:word);
  {$IfNDef Delphi}
   const cN=High(tVeryLongCounterWordsNumber);
  {$EndIf}
begin
  {$IfDef Delphi}
   Inc(aVeryLongCounter, aIncrement);
  {$Else}
    asm
      les di,aVeryLongCounter
      mov ax,aIncrement
      xor dx,dx
      add word(es:[di]),ax
      jnc @END
      mov cx,cN
      @loop:
	inc di; inc di
	adc es:[di],dx
	jnc @END
      loop @loop
      @END:
    end;
  {$EndIf}
end;

function VLC2Comp(const aVLC:tVeryLongCounter):comp;
{$IfDef Delphi}
begin
  Result:=aVLC;
end;
{$Else}
  var x:comp; i:byte;
begin
  x:=0;
  for i:=3 downto 0 do begin
    x:=(x*High(word))+aVLC[i];
  end;
  VLC2Comp:=x;
end;
{$EndIf}


procedure IncVLBC(var aVeryLongBitCounter:tVeryLongBitCounter; aBitCountIncrement:tCodeLength);
  var w:word;
begin
  with aVeryLongBitCounter do begin
    w:=word(aBitCountIncrement)+BitCount;
    BitCount:=w and 7;
   {$IfDef Delphi}
    Inc(ByteCount, (w shr 3));
   {$Else}
    IncVLC(ByteCount, (w shr 3));
  {$EndIF}
  end;
end;


END.