{DOS-text

 Словарь фрагментов для компрессии/декомпрессии Лемпеля-Зива (LZ78)

  Вспомогательная часть. Основные процедуры вынесены в LZDic1.

   1) constructor Init(ASizeInNodes:tIndex); - инициализация
	словаря размером ASizeInNodes символов (узлов).

   2) procedure SetEncodeRegime; - перевод словаря в режим кодирования.
	после чего можно вызывать только ByteToCodes.

   3) procedure   SetDecodeRegime; - перевод словаря  в режим декодирования.
	после чего можно вызывать только CodeToBytes.

   4) function Fragment(ACode:tIndex;
		    var ABuffer;
			ABufferSize:tBufferIndex;
		    var ADataSize:tBufferIndex):tBufferIndex; -
	декодирование фрагмента - без изменения словаря,
	возвращает 0, если декодирован, иначе размер недостающего
	пространства в буфере.
	  Можно вызывать в любом режиме (кодирования /если не задана
	  директива коппиляции "Fast1"/ и декодирования),
	но если кода в словаре нет, то возникает ошибка RunError(201).

 ---- Функции ниже могут послужить примером для выполнения задания

   5) function FindNextByte(AByte:tByte):boolean; -
	найти продолжение AByte для текущего фрагмента
	с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
	Возвращает: TRUE, если продолжение найдено.
	Устанавливает соответствующие значения в
	prLastCode, prFragmentLength и prInitialSizeInBytes.

   6) function SkipFragment(const ABuffer; ABufferSize:tBufferIndex):tBufferIndex;
	пропустить в ABuffer текущий фрагмент
	с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
	Возвращает: длину пропущенного фрагмента.
	Устанавливает соответствующие значения в
	prLastCode, prFragmentLength и prInitialSizeInBytes.

   Другие процедуры см. ниже в определении tLZDictionary.
-------------------------------------------------------------------
   ПРИМЕЧАНИЕ. Директива "$Define Fast1" переводит словарь в быстрый режим:
   1. Массив Predecessors не размещается в памяти, при декодировании
      вместо него используется массив Successors (ссылки Predecessors и
      Successors указывают на одну и ту же область памяти).
   2. При кодировании массив Predecessors не заполняется.
   3. При декодировании не восстанавливается полная структура словаря.
      Восстанавливаются только обратные связи (Predecessors).
   Как следствие при заданной директиве "$Define Fast1":
   1. В процессе кодирования невозможно декодирование фрагмента по словарю.
   2. При декодировании невозможен поиск в словаре.
-----------------------------------------------------}
{WIN-text

╤ыютрЁ№ ЇЁруьхэЄют фы  ъюьяЁхёёшш/фхъюьяЁхёёшш ╦хьяхы -╟штр (LZ78)

  ┬ёяюьюурЄхы№эр  ўрёЄ№. ╬ёэютэ√х яЁюЎхфєЁ√ т√эхёхэ√ т LZDic1.

   1) constructor Init(ASizeInNodes:tIndex); - шэшЎшрышчрЎш 
	ёыютрЁ  ЁрчьхЁюь ASizeInNodes ёшьтюыют (єчыют).

   2) procedure SetEncodeRegime; - яхЁхтюф ёыютрЁ  т Ёхцшь ъюфшЁютрэш .
	яюёых ўхую ьюцэю т√ч√трЄ№ Єюы№ъю ByteToCodes.

   3) procedure   SetDecodeRegime; - яхЁхтюф ёыютрЁ   т Ёхцшь фхъюфшЁютрэш .
	яюёых ўхую ьюцэю т√ч√трЄ№ Єюы№ъю CodeToBytes.

   4) function Fragment(ACode:tIndex;
		    var ABuffer;
			ABufferSize:tBufferIndex):tSignedBufferIndex;
	фхъюфшЁютрэшх ЇЁруьхэЄр - схч шчьхэхэш  ёыютрЁ ,
	тючтЁр∙рхЄ >=0, хёыш фхъюфшЁютрэ, шэрўх <0 ЁрчьхЁ эхфюёЄр■∙хую
	яЁюёЄЁрэёЄтр т сєЇхЁх.
	  ╠юцэю т√ч√трЄ№ т ы■сюь Ёхцшьх (ъюфшЁютрэш  /хёыш Єюы№ъю эх чрфрэр
	  фшЁхъЄштр ъюьяшы Ўшш "Fast1"/ ш фхъюфшЁютрэш ),
	эю хёыш ъюфр т ёыютрЁх эхЄ, Єю тючэшърхЄ ю°шсър RunError(201).

 ---- ╘єэъЎшш эшцх ьюуєЄ яюёыєцшЄ№ яЁшьхЁюь фы  т√яюыэхэш  чрфрэш 

   5) function FindNextByte(AByte:tByte):boolean; -
	эрщЄш яЁюфюыцхэшх AByte фы  Єхъє∙хую ЇЁруьхэЄр
	ё шчьхэхэшхь prLastCode, prFragmentLength ш prInitialSizeInBytes.
	┬ючтЁр∙рхЄ: TRUE, хёыш яЁюфюыцхэшх эрщфхэю.
	╙ёЄрэртыштрхЄ ёююЄтхЄёЄтє■∙шх чэрўхэш  т
	prLastCode, prFragmentLength ш prInitialSizeInBytes.

   6) function SkipFragment(const ABuffer; ABufferSize:tBufferIndex):tBufferIndex;
	яЁюяєёЄшЄ№ т ABuffer Єхъє∙шщ ЇЁруьхэЄ
	ё шчьхэхэшхь prLastCode, prFragmentLength ш prInitialSizeInBytes.
	┬ючтЁр∙рхЄ: фышэє яЁюяє∙хээюую ЇЁруьхэЄр.
	╙ёЄрэртыштрхЄ ёююЄтхЄёЄтє■∙шх чэрўхэш  т
	prLastCode, prFragmentLength ш prInitialSizeInBytes.

   ─Ёєушх яЁюЎхфєЁ√ ёь. эшцх т юяЁхфхыхэшш tLZDictionary.
-------------------------------------------------------------------
   ╧╨╚╠┼╫└═╚┼. ─шЁхъЄштр "$Define Fast1" яхЁхтюфшЄ ёыютрЁ№ т с√ёЄЁ√щ Ёхцшь:
   1. ╠рёёшт Predecessors эх Ёрчьх∙рхЄё  т ярь Єш, яЁш фхъюфшЁютрэшш
      тьхёЄю эхую шёяюы№чєхЄё  ьрёёшт Successors (ёё√ыъш Predecessors ш
      Successors єърч√тр■Є эр юфэє ш Єє цх юсырёЄ№ ярь Єш).
   2. ╧Ёш ъюфшЁютрэшш ьрёёшт Predecessors эх чряюыэ хЄё .
   3. ╧Ёш фхъюфшЁютрэшш эх тюёёЄрэртыштрхЄё  яюыэр  ёЄЁєъЄєЁр ёыютрЁ .
      ┬юёёЄрэртыштр■Єё  Єюы№ъю юсЁрЄэ√х ёт чш (Predecessors).
   ╩ръ ёыхфёЄтшх, яЁш чрфрээющ фшЁхъЄштх "$Define Fast1":
   1. ┬ яЁюЎхёёх ъюфшЁютрэш  эхтючьюцэю фхъюфшЁютрэшх ЇЁруьхэЄр яю ёыютрЁ■.
   2. ╧Ёш фхъюфшЁютрэшш эхтючьюцхэ яюшёъ т ёыютрЁх.

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

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

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

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

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

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

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

INTERFACE
  USES LZMiscFs, {$IfDef Debug}LZTests,{$EndIf} ComTypes, LZTypes, LZBase;

const
  cSizeInNodesMin=500; { минимальный размер словаря }
		       {ьшэшьры№э√щ ЁрчьхЁ ёыютрЁ , чрфрэ шч "яюЄюыюўэ√ї" ёююсЁрцхэшщ, рсёюы■Єэ√щ ьшэшьєь 256+3}
  cSizeInNodesMax=Pred(High(tIndex)); { максимальный размер словаря } {ьръёшьры№э√щ ЁрчьхЁ ёыютрЁ ,
                                                                        чрфрэ шч ёююсЁрцхэшщ ьръёшьры№эюую чэрўхэш  фы  tIndex
									~16 000    фы  16-сшЄэющ яЁюуЁрьь√
									(юуЁрэшўхэшх ярь Єш 64 ╩┴рщЄ);
									~4 000 000 фы  32-сшЄэющ яЁюуЁрьь√
									(юуЁрэшўхэшх ярь Єш 2 ├┴рщЄ); }
  cFragmentLengthMin=4; { минимум максимального размера фрагмента }{ьшэшьры№э√щ ЁрчьхЁ ЇЁруьхэЄр, чрфрэ шч
								    "яюЄюыюўэ√ї" ёююсЁрцхэшщ}

type
  tSizeInNodes=cSizeInNodesMin..cSizeInNodesMax;
  tFragmentSize=cFragmentLengthMin..cSizeInNodesMax;

  { счетчик кодов }{ ёўхЄўшъ ъюфют }
  tCodesCount=0..6;
  { индекс кодов } { шэфхъё ъюфют }
  tCodesIndex=Low(tCodesCount)..Pred(High(tCodesCount));

  { массив значений кодов } { ьрёёшт чэрўхэшщ ъюфют }
  tCodeArray=array[tCodesIndex] of tIndex;
  { массив длин кодов } { ьрёёшт фышэ ъюфют }
  tCodeLengthArray=array[tCodesIndex] of tIndexBitsCounter;

  { данные кодов } { фрээ√х ъюфют }
  tLZCodesArray=record
    Code:tCodeArray;
    Length:tCodeLengthArray;
  end;
  tPLZCodesArray=^tLZCodesArray;

  { внутренние флаги для управления процессом кодирования/декодирования }
  { тэєЄЁхээшх Їыруш фы  єяЁртыхэш  яЁюЎхёёюь ъюфшЁютрэш /фхъюфшЁютрэш  }
  tFlag=(
    fNewByte, { кодировщик, декодировщик - предыдущий код НОВЫЙ_БАЙТ или СБРОС_СЛОВАРЯ }
              { ъюфшЁют∙шъ, фхъюфшЁют∙шъ - яЁхф√фє∙шщ ъюф ═╬┬█╔_┴└╔╥ шыш ╤┴╨╬╤_╤╦╬┬└╨▀ }
    fIncCodeLength, { декодировщик - предыдущий код УВЕЛИЧИТЬ_ДЛИНУ_КОДА }
                    { фхъюфшЁют∙шъ - яЁхф√фє∙шщ ъюф ╙┬┼╦╚╫╚╥▄_─╦╚═╙_╩╬─└ }
    fEncodeRegime, { включен режим кодирования - вызов CodeToBytes запрещен }
                   { тъы■ўхэ Ёхцшь ъюфшЁютрэш  - т√чют CodeToBytes чряЁх∙хэ }
    fDecodeRegime  { включен режим декодирования - вызов ByteToCodes запрещен }
                   { тъы■ўхэ Ёхцшь фхъюфшЁютрэш  - т√чют ByteToCodes чряЁх∙хэ }
  );
  tFlags=set of tFlag;

  tAddProc=function(AByte:byte; ARootIndex:tIndex; var Dic:tDictionary):tNodeIndex;

  { СЛОВАРЬ } { ╤╦╬┬└╨▄ }
  tLZDictionary=object
    {$IfDef Delphi}
    protected
    {$EndIf}
      { внутренние флаги } { тэєЄЁхээшх Їыруш }
      prDicFlags:tFlags;
      { данные словаря } { фрээ√х ёыютрЁ  }
      prDic:tDictionary;
      { последний код - конец текущего фрагмента }
      { яюёыхфэшщ ъюф - ъюэхЎ Єхъє∙хую ЇЁруьхэЄр }
      prLastCode:tIndex;
      { первый байт последнего декодированного фрагмента}
      { яхЁт√щ срщЄ яюёыхфэхую фхъюфшЁютрээюую ЇЁруьхэЄр, шёяюы№чєхЄё  Єюы№ъю фхъюфшЁют∙шъюь }
      prLastDecodedFragmentFirstByte:tByte;
      { длина кода } { фышэр ъюфр }
      prCodeLength:tCodeLength;
      { максимальное значение кода для текущей длины кода }
      { ьръёшьры№эюх чэрўхэшх ъюфр фы  Єхъє∙хщ фышэ√ ъюфр }
      prMaxCode:tNodeIndex;
      { длина текущего фрагмента } { фышэр Єхъє∙хую ЇЁруьхэЄр }
      prFragmentLength:tIndex;
      { максимально допустимая длина фрагмента }
      { ьръёшьры№эю фюяєёЄшьр  фышэр ЇЁруьхэЄр }
      prFragmentLengthLimit:tIndex;
      { достигнутый максимум длины фрагмента для текущего словаря }
      { фюёЄшуэєЄ√щ ьръёшьєь фышэ√ ЇЁруьхэЄр фы  Єхъє∙хую ёыютрЁ  }
      prCurrentMaxFragmentLength,
      { максимум длины фрагмента за сессию кодирования, после EncodeReset }
      { ьръёшьєь фышэ√ ЇЁруьхэЄр чр ёхёёш■ ъюфшЁютрэш , яюёых EncodeReset }
      prCurrentAbsMaxFragmentLength:tIndex;
      { упакованный размер данных - !только при кодировании }
      { єяръютрээ√щ ЁрчьхЁ фрээ√ї - !Єюы№ъю яЁш ъюфшЁютрэшш }
      prCompressedSize:tLZCompressedSize;
      { исходный размер данных  - !только при кодировании}
      { шёїюфэ√щ ЁрчьхЁ фрээ√ї  - !Єюы№ъю яЁш ъюфшЁютрэшш}
      prInitialSizeInBytes:tInt;

      { очистить словарь } { юўшёЄшЄ№ ёыютрЁ№ }
      procedure   ResetDictionary;
      { сбросить фрагмент - начать новый поиск фрагмента с корня }
      { ёсЁюёшЄ№ ЇЁруьхэЄ - эрўрЄ№ эют√щ яюшёъ ЇЁруьхэЄр ё ъюЁэ  }
      procedure   ResetFragment;

      { вычислить увеличение длины кода, необходимое для записи ACode }
      { т√ўшёышЄ№ єтхышўхэшх фышэ√ ъюфр, эхюсїюфшьюх фы  чряшёш ACode }
      function  CodeLengthIncrement(ACode:tIndex):byte;
      { увеличить текущую длину кода на AInc}
      procedure DoIncrementCodeLength(AInc:tCodeLength);
      { вычислить и увеличить текущую длину кода,
      до значения необходимого для записи ACode}
      function  IncrementCodeLength(ACode:tIndex):byte;

      { найти байт AByte в дереве ARootIndex }
      function  Find(ARootIndex:tIndex; AByte:tByte):tIndex;
      { найти байт AByte в дереве prLastCode }
      function  FindLast(AByte:tByte):tIndex;

      { добавить байт AByte в дерево ARootIndex }
      function  Add(ARootIndex:tIndex; AByte:tByte):tIndex;
      { добавить байт AByte в дерево prLastCode }
      function  AddToLast(AByte:tByte):tIndex;
      { добавить байт AByte в корень словаря }
      function  AddRoot(AByte:tByte):tIndex;

      { разместить данные для словаря в ОЗУ }
      function  Allocate(SizeToAllocateInNodes:tSizeInNodes):boolean;
      { удалить данные словаря из ОЗУ }
      procedure DeAllocate;
      { инициализировать переключение режима кодирования/декодирования }
      procedure ResetRegime;

    private
      { размер словаря и признак инициализированности объекта }
      pvSize,pvNotSize:tNodeIndex;

      { число сбросов словаря }
      pvResetCount:tUINT;

      prAdd:tAddProc;

    public
      { инициализация словаря размером ASizeInNodes символов (узлов). }
      constructor Init(ASizeInNodes:tSizeInNodes);
      { освобождение словаря }
      destructor  Done;
      { переустановка размера словаря в ASizeInNodes символов (узлов).
      При этом происходит сброс данных словаря. }
      function Reinit(ASizeInNodes:tIndex):boolean;

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

      { Сброс словаря и перевод его в режим декодирования,
      после чего можно вызывать только CodeToBytes.}
      procedure   SetDecodeRegime;
      { длина следующего кода при декодировке
       (только в режиме SetDecodeRegime) }
      function  NextCodeLength:tIndexBitsCounter;

      { декодирование фрагмента - без изменения словаря,
       возвращает 0, если декодирован,
       иначе размер недостающего пространства в буфере.
	 Можно вызывать в любом режиме (кодирования и
	 декодирования (Fast1 - только при декодировании),
       но если кода в словаре нет то возникает ошибка 201.}
      function Fragment(ACode:tIndex;
		    var ABuffer;
			ABufferSize:tBufferIndex):tSignedBufferIndex;

      { возвращает TRUE, если ACode присутствует в словаре и может быть декодирован }
      function PresentInDictionary(ACode:tIndex):boolean;
      { словарь пуст }
      function  Empty:boolean;
      { свободный размер словаря в узлах }
      function  FreeSizeInNodes:tIndex;
      { полный размер словаря в узлах }
      function  SizeInNodes:tIndex;
      { максимально/минимально возможный полный размер словаря в узлах }
      function  SizeInNodesMax:tIndex;
      function  SizeInNodesMin:tIndex;
      { полный размер словаря в байтах }
      function  DataSizeInBytes:tCardinal;
      { вычисление размера словаря в байтах для aNodesCount узлов }
      function  CalculateDataSizeInBytes(aNodesCount:tIndex):tCardinal;
      { максимально возможный размер фрагмента }
      function  MaxFragmentLength:tIndex;
      procedure MaxFragmentLengthSet(Size:tFragmentSize);
      function  FragmentLengthMin:tIndex;
      function  FragmentLengthMax:tIndex;
      function  CurrentDictionaryMaxFragmentSize:tIndex;
      function  CurrentSessionMaxFragmentSize:tIndex;

      { размер исходных данных (только в режиме SetEncodeRegime)}
      function  InitialSizeInBytes:tInt;
      { размер закодированных данных (только в режиме SetEncodeRegime) }
      function  CompressedSizeInBytes:tInt;

      { отношение размера закодированных данных к размеру исходных данных
      (только в режиме SetEncodeRegime) }
      function  CompressionRatio:{$IfOpt N+}double{$else}real{$EndIf};

      { счетчик сбросов словаря }
      function  DictionaryResetCount:tUInt;

      { вспомогательные функции }
      function  GetFragment(ACode:tIndex; var AWorkBuffer; AWorkBufSize:tBufferIndex):longint;
      procedure WriteFragment(ACode:tIndex; var AWorkBuffer; AWorkBufSize:tBufferIndex);
      procedure WritelnFragment(ACode:tIndex; var AWorkBuffer; AWorkBufSize:tBufferIndex);
      procedure WriteFragments(var AWorkBuffer; AWorkBufSize:tBufferIndex);

      { найти продолжение AByte для текущего фрагмента
      с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
      Возвращает: TRUE, если продолжение найдено  }
      function FindNextByte(AByte:tByte):boolean;
      { Пропустить в ABuffer текущий фрагмент
      с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
      Возвращает: длину пропущенного фрагмента.  }
      function SkipFragment(const ABuffer; ABufferSize:tBufferIndex):tBufferIndex;

      { отладочные функции }
      {$IfDef Debug}
       function SeqCheck:tIndex;
       function DicDataPtr:tPDictionary;
      {$EndIf}
  end;

IMPLEMENTATION

procedure tLZDictionary.ResetRegime;
begin
  ResetDictionary;
  prCurrentAbsMaxFragmentLength:=0;
  pvResetCount:=0;
  prCompressedSize.SizeInBytes.int:=0;
  prCompressedSize.BitsRest:=0;
  prInitialSizeInBytes:=0;
  Exclude(prDicFlags,fEncodeRegime);
  Exclude(prDicFlags,fDecodeRegime);
end;

procedure tLZDictionary.SetEncodeRegime;
begin
  ResetRegime;
  prAdd:=LZBase.AddNodeToBinaryTree;
  Include(prDicFlags,fEncodeRegime);
end;

procedure tLZDictionary.SetDecodeRegime;
begin
  ResetRegime;
  Include(prDicFlags,fDecodeRegime);
  {$IfNDef Fast1}
  prAdd:=LZBase.AddNodeToBinaryTree;
  {$Else}
  prAdd:=LZBase.AddNodeForDecode;
  {$EndIf Fast1}
end;

{ возвращает TRUE, если ACode присутствует в словаре и может быть декодирован }
function tLZDictionary.PresentInDictionary(ACode:tIndex):boolean;
begin
  PresentInDictionary:=(ACode>cRootIndex) and (ACode<prDic.Descriptors.FirstFree);
end;

{ декодирование фрагмента }
function tLZDictionary.Fragment(ACode:tIndex;
			    var ABuffer;
				ABufferSize:tBufferIndex):tSignedBufferIndex;
begin
  {$IfOpt R+}
  if ABufferSize<1 then begin
    RunError(201);
  end;
   {$IfNDef Fast1}
  if (fEncodeRegime in prDicFlags)
      or not (fDecodeRegime in prDicFlags) then begin
    RunError(201);
  end;
   {$EndIf Fast1}
  {$EndIf}
   Fragment:=DecodeNode(ACode, ABuffer, ABufferSize, prDic);
end;

function  tLZDictionary.CurrentDictionaryMaxFragmentSize:tIndex;
begin
  CurrentDictionaryMaxFragmentSize:=prCurrentMaxFragmentLength;
end;

function  tLZDictionary.CurrentSessionMaxFragmentSize:tIndex;
begin
  if prCurrentAbsMaxFragmentLength<prCurrentMaxFragmentLength then
    prCurrentAbsMaxFragmentLength:=prCurrentMaxFragmentLength;
  CurrentSessionMaxFragmentSize:=prCurrentAbsMaxFragmentLength;
end;

function  tLZDictionary.MaxFragmentLength:tIndex;
begin
  if prFragmentLengthLimit<SizeInNodes then
    MaxFragmentLength:=prFragmentLengthLimit
  else
    MaxFragmentLength:=SizeInNodes;
end;

procedure tLZDictionary.MaxFragmentLengthSet(Size:tFragmentSize);
begin
  if Size<cFragmentLengthMin then Size:=cFragmentLengthMin;
  prFragmentLengthLimit:=Size;
end;

function tLZDictionary.Empty:boolean;
begin
  Empty:=(FreeSizeInNodes=SizeInNodes);
end;

function  tLZDictionary.CodeLengthIncrement(ACode:tIndex):byte;
  var b:byte; mc:tUINT;
begin
  b:=0;
  mc:=prMaxCode;
  while ACode>mc do begin
    mc:=Succ(mc shl {$IfNDef ByteAlignedOtput}1 {$Else }8 {$EndIf NDef ByteAlignedOtput});
    Inc(b {$IfDef ByteAlignedOtput},8 {$EndIf Def ByteAlignedOtput});
  end;
  CodeLengthIncrement:=b;
end;

procedure tLZDictionary.DoIncrementCodeLength(AInc:tCodeLength);
begin
  Inc(prCodeLength,AInc);
  prMaxCode:=Pred(1 shl prCodeLength);
end;

function  tLZDictionary.IncrementCodeLength(ACode:tIndex):byte;
  var aInc:tCodeLength;
begin
  aInc:=CodeLengthIncrement(ACode);
  DoIncrementCodeLength(AInc);
  IncrementCodeLength:=aInc;
end;

procedure tLZDictionary.ResetFragment;
begin
  prLastCode:=cRootIndex;
  prFragmentLength:=0;
end;

procedure InitDictionaryData(var Dic:tDictionary; SizeInNodes:tIndex); forward;

procedure tLZDictionary.ResetDictionary;
begin
  if SizeInNodes=0 then
    RunError(201);
  InitDictionaryData(prDic, SizeInNodes);
  prCodeLength:=cInitialCodeLength;
  prMaxCode:=Pred(1 shl cInitialCodeLength);
  if prCurrentAbsMaxFragmentLength<prCurrentMaxFragmentLength then
    prCurrentAbsMaxFragmentLength:=prCurrentMaxFragmentLength;
  prCurrentMaxFragmentLength:=0;
  ResetFragment;
  Exclude(prDicFlags,fNewByte);
  {$IfOpt R+} {$Define RisON} {$R-} {$EndIf}
  Inc(pvResetCount);
  {$IfDef RisON} {$UnDef RisON} {$R+} {$EndIf}
end;

function tLZDictionary.Add(ARootIndex:tIndex; AByte:tByte):tIndex;
begin
  {$IfOpt R+}
  if (ARootIndex<cRootIndex) or (ARootIndex>=prDic.Descriptors.FirstFree) then
    RunError(201);
  {$EndIf}
  Add:=prAdd(AByte, ARootIndex, prDic);
(*  {$IfNDef Fast1}
  Add:=LZBase.AddNodeToBinaryTree(AByte, ARootIndex, prDic);
  {$Else}
  if (fEncodeRegime in prDicFlags) then begin
    Add:=LZBase.AddNodeToBinaryTree(AByte, ARootIndex, prDic);
  end else begin
    Add:=LZBase.AddNodeForDecode(AByte, ARootIndex, prDic)
  end;
  {$EndIf Fast1}*)
end;

function tLZDictionary.AddToLast(AByte:tByte):tIndex;
begin
  AddToLast:=prAdd(AByte, prLastCode, prDic);
(*  {$IfNDef Fast1}
  AddToLast:=LZBase.AddNodeToBinaryTree(AByte, prLastCode, prDic);
  {$Else}
  if (fEncodeRegime in prDicFlags) then begin
    AddToLast:=LZBase.AddNodeToBinaryTree(AByte, prLastCode, prDic);
  end else begin
    AddToLast:=LZBase.AddNodeForDecode(AByte, prLastCode, prDic)
  end;
  {$EndIf Fast1}*)
end;

function  tLZDictionary.AddRoot(AByte:tByte):tIndex;
begin
  AddRoot:=prAdd(AByte, cRootIndex, prDic);
(*  {$IfNDef Fast1}
  AddRoot:=LZBase.AddNodeToBinaryTree(AByte, cRootIndex, prDic);
  {$Else}
  if (fEncodeRegime in prDicFlags) then begin
     AddRoot:=LZBase.AddNodeToBinaryTree(AByte, cRootIndex, prDic);
  end else begin
     AddRoot:=LZBase.AddNodeForDecode(AByte, cRootIndex, prDic)
  end;
  {$EndIf Fast1}*)
end;

function tLZDictionary.Find(ARootIndex:tIndex; AByte:tByte):tIndex;
begin
  {$IfOpt R+}
  if (ARootIndex<cRootIndex) or (ARootIndex>=prDic.Descriptors.FirstFree) then
    RunError(201);
   {$IfNDef Fast1}
  if not (fEncodeRegime in prDicFlags)
      or (fDecodeRegime in prDicFlags) then begin
    RunError(201);
  end;
   {$EndIf Fast1}
  {$EndIf}
  Find:=LZBase.FindNodeInBinaryTree(AByte, prDic.Successors^[ARootIndex], prDic);
end;

function tLZDictionary.FindLast(AByte:tByte):tIndex;
begin
  {$IfOpt R+} {$IfNDef Fast1}
  if not (fEncodeRegime in prDicFlags)
      or (fDecodeRegime in prDicFlags) then begin
    RunError(201);
  end;
  {$EndIf} {$EndIf}
  FindLast:=LZBase.FindNodeInBinaryTree(AByte, prDic.Successors^[prLastCode], prDic);
end;

function tLZDictionary.SizeInNodes;
begin
  if (pvSize=not pvNotSize) then begin
    SizeInNodes:=pvSize;
  end else begin
    SizeInNodes:=0;
  end;
end;

function tLZDictionary.FreeSizeInNodes;
begin
  if (SizeInNodes=0) then begin
    FreeSizeInNodes:=0;
  end else begin
    FreeSizeInNodes:=prDic.Descriptors.Max-prDic.Descriptors.FirstFree;
  end;
end;

function tLZDictionary.CalculateDataSizeInBytes(aNodesCount:tIndex):tCardinal;
begin
  CalculateDataSizeInBytes:=tCardinal(aNodesCount)*(
			       SizeOf(prDic.Nodes^[0])+
			      +SizeOf(prDic.Successors^[0])+
                           {$IfNDef Fast1}
			      +SizeOf(prDic.Predecessors^[0])+
                           {$EndIf}
			      +SizeOf(prDic.Bytes^[0])+
			      +SizeOf(prDic.Flags^[0])
			    )+
			  +SizeOf(prDic.Descriptors);
end;

function tLZDictionary.DataSizeInBytes:tCardinal;
  var sz:tIndex;
begin
  sz:=SizeInNodes;
  if sz=0 then
    DataSizeInBytes:=0
  else
    DataSizeInBytes:=CalculateDataSizeInBytes(sz);
end;

constructor tLZDictionary.Init;
begin
  if ReInit(ASizeInNodes) then begin
    SetEncodeRegime;
  end else begin
    Fail;
  end;
end;

destructor tLZDictionary.Done;
begin
  Deallocate;
end;

function  tLZDictionary.ReInit;
begin
  ReInit:=Allocate(ASizeInNodes);
  prFragmentLengthLimit:=ASizeInNodes;
end;

procedure tLZDictionary.DeAllocate;
  var sz:tCardinal;
begin
  sz:=SizeInNodes;
  if (sz>0) then begin
    FreeMem(prDic.Nodes,sz*SizeOf(prDic.Nodes^[0]));
    FreeMem(prDic.Successors,sz*SizeOf(prDic.Successors^[0]));
   {$IfNDef Fast1}
    FreeMem(prDic.Predecessors,sz*SizeOf(prDic.Predecessors^[0]));
   {$EndIf Fast1}
    FreeMem(prDic.Bytes,sz*SizeOf(prDic.Bytes^[0]));
    FreeMem(prDic.Flags,sz*SizeOf(prDic.Flags^[0]));
  end;
  pvSize:=0;
  pvNotSize:=0;
  prDic.Nodes:=NIL;
  prDic.Successors:=NIL;
  prDic.Predecessors:=NIL;
  prDic.Bytes:=NIL;
  prDic.Flags:=NIL;
end;

{$IfNDef Delphi}
function HeapErrorFunc(Size:word):integer; far;
begin
  HeapErrorFunc:=1;
end;

function tLZDictionary.Allocate(SizeToAllocateInNodes:tSizeInNodes):boolean;
  var OldHeapErr:pointer;
     sz:tCardinal;
begin
  Deallocate;
  Allocate:=FALSE;
  if SizeToAllocateInNodes>0 then begin
    if SizeToAllocateInNodes<SizeInNodesMin then
      SizeToAllocateInNodes:=SizeInNodesMin
    else if SizeToAllocateInNodes>SizeInNodesMax then
      SizeToAllocateInNodes:=SizeInNodesMax;
    sz:=SizeToAllocateInNodes;
    OldHeapErr:=HeapError;
    HeapError:=@HeapErrorFunc;
    GetMem(prDic.Nodes,sz*SizeOf(prDic.Nodes^[0]));
    if prDic.Nodes<>NIL then begin
      GetMem(prDic.Successors,sz*SizeOf(prDic.Successors^[0]));
      if prDic.Successors<>NIL then begin
       {$IfNDef Fast1}
	 GetMem(prDic.Predecessors,sz*SizeOf(prDic.Predecessors^[0]));
       {$Else If Fast1}
	 prDic.Predecessors:=prDic.Successors;
       {$EndIf Fast1}
	if prDic.Predecessors<>NIL then begin
	      GetMem(prDic.Bytes,sz*SizeOf(prDic.Bytes^[0]));
	      if prDic.Bytes<>NIL then begin
		GetMem(prDic.Flags,sz*SizeOf(prDic.Flags^[0]));
	  end;
	end;
      end;
    end;
    if (prDic.Nodes=NIL)
      or (prDic.Successors=NIL)
      or (prDic.Predecessors=NIL)
      or (prDic.Flags=NIL)
      or (prDic.Bytes=NIL) then begin
      if (prDic.Successors<>NIL) then begin
	FreeMem(prDic.Successors,sz*SizeOf(prDic.Successors^[0]));
	prDic.Successors:=NIL;
      end;
      if (prDic.Predecessors<>NIL) then begin
       {$IfNDef Fast1}
	FreeMem(prDic.Predecessors,sz*SizeOf(prDic.Predecessors^[0]));
       {$EndIf Fast1}
	prDic.Predecessors:=NIL;
      end;
      if prDic.Nodes<>NIL then begin
	FreeMem(prDic.Nodes,sz*SizeOf(prDic.Nodes^[0]));
	prDic.Nodes:=NIL;
      end;
      if prDic.Bytes<>NIL then begin
	FreeMem(prDic.Bytes,sz*SizeOf(prDic.Bytes^[0]));
	prDic.Bytes:=NIL;
      end;
      if prDic.Flags<>NIL then begin
	FreeMem(prDic.Flags,sz*SizeOf(prDic.Flags^[0]));
	prDic.Flags:=NIL;
      end;
    end;
    HeapError:=OldHeapErr;
    if prDic.Nodes<>NIL then begin
      pvSize:=SizeToAllocateInNodes;
      pvNotSize:=not pvSize;
      ResetDictionary;
      Allocate:=TRUE;
    end;
  end;
end;
{$Else IfNDef Delphi}

function tLZDictionary.Allocate(SizeToAllocateInNodes:tSizeInNodes):boolean;
  var sz:tCardinal;
begin
  Deallocate;
  Allocate:=FALSE;
  if SizeToAllocateInNodes>0 then begin
    if SizeToAllocateInNodes<SizeInNodesMin then
      SizeToAllocateInNodes:=SizeInNodesMin
    else if SizeToAllocateInNodes>SizeInNodesMax then
      SizeToAllocateInNodes:=SizeInNodesMax;
    sz:=SizeToAllocateInNodes;
    try
      GetMem(prDic.Nodes,sz*SizeOf(prDic.Nodes[0]));
      GetMem(prDic.Successors,sz*SizeOf(prDic.Successors^[0]));
     {$IfNDef Fast1}
      GetMem(prDic.Predecessors,sz*SizeOf(prDic.Predecessors^[0]));
     {$Else If Fast1}
       prDic.Predecessors:=prDic.Successors;
     {$EndIf Fast1}
      GetMem(prDic.Bytes,sz*SizeOf(prDic.Bytes^[0]));
      GetMem(prDic.Flags,sz*SizeOf(prDic.Flags^[0]));
    except
      if Assigned(prDic.Nodes) then
	FreeMem(prDic.Nodes,sz*SizeOf(prDic.Nodes[0]));
      if Assigned(prDic.Successors) then
	FreeMem(prDic.Successors,sz*SizeOf(prDic.Successors^[0]));
     {$IfNDef Fast1}
      if Assigned(prDic.Predecessors) then
	FreeMem(prDic.Predecessors,sz*SizeOf(prDic.Predecessors^[0]));
     {$EndIf Fast1}
      if Assigned(prDic.Bytes) then
	FreeMem(prDic.Bytes,sz*SizeOf(prDic.Bytes^[0]));
      if Assigned(prDic.Flags) then
	FreeMem(prDic.Flags,sz*SizeOf(prDic.Flags^[0]));
      prDic.Nodes:=NIL;
      prDic.Successors:=NIL;
      prDic.Predecessors:=NIL;
      prDic.Bytes:=NIL;
      prDic.Flags:=NIL;
    end;
    if prDic.Nodes<>NIL then begin
      pvSize:=SizeToAllocateInNodes;
      pvNotSize:=not pvSize;
      ResetDictionary;
      Allocate:=TRUE;
    end;
  end;
end;
{$EndIf}


procedure InitDictionaryData(var Dic:tDictionary; SizeInNodes:tIndex);
  var i:tIndex;
begin
  Dic.Descriptors.Max:=SizeInNodes;
  Dic.Descriptors.FirstFree:=cRootIndex+1;
  for i:=Low(i) to Pred(Dic.Descriptors.FirstFree) do begin
    Dic.Nodes^[i]:=cNullNode;
    Dic.Bytes^[i]:=0;
    Dic.Flags^[i]:=[];
  end;
  Dic.Successors^[cRootIndex]:=cNilIndex;
  {$IfNDef Fast1}
  Dic.Predecessors^[cRootIndex]:=cNilIndex;
  {$EndIf Fast1}
end;

function tLZDictionary.DictionaryResetCount:tUInt;
begin
  DictionaryResetCount:=pvResetCount;
end;

function tLZDictionary.InitialSizeInBytes:tInt;
begin
  InitialSizeInBytes:=prInitialSizeInBytes;
end;

function tLZDictionary.CompressedSizeInBytes:tInt;
begin
  if prCompressedSize.BitsRest=0 then
    CompressedSizeInBytes:=prCompressedSize.SizeInBytes.int
  else
    CompressedSizeInBytes:=Succ(prCompressedSize.SizeInBytes.int);
end;

{$IfDef Debug}
function tLZDictionary.SeqCheck:tIndex;
begin
  if SizeInNodes=0 then
    RunError(201);
  if LZTests.SeqCheck(prDic,cRootIndex)<>cNilIndex then
    PrintLine(prDic,cRootIndex);
end;

function tLZDictionary.DicDataPtr:tPDictionary;
begin
  DicDataPtr:=@prDic;
end;

{$EndIf}

procedure tLZDictionary.WriteFragments;
   var i:tIndex;
begin
  for i:=Succ(cRootIndex) to Pred(prDic.Descriptors.FirstFree) do begin
    if prDic.Successors^[i]=cNilIndex then begin
      WriteFragment(i,AWorkBuffer,AWorkBufSize);
    end;
  end;
end;

function tLZDictionary.GetFragment(ACode:tIndex; var AWorkBuffer; AWorkBufSize:tBufferIndex):longint;
begin
  if PresentInDictionary(ACode) then begin
    GetFragment:=Fragment(ACode,AWorkBuffer,AWorkBufSize);
  end else begin
    GetFragment:=0;
  end;
end;

procedure tLZDictionary.WriteFragment;
   var n,j:tBufferIndex;
begin
  n:=GetFragment(ACode, AWorkBuffer,AWorkBufSize);
  if n>0 then begin
    for j:=0 to Pred(n) do begin
      write(ByteToChr(tBuffer(AWorkBuffer)[j]));
    end;
  end else if n=0 then begin
    Write('<кода нет в словаре>');
  end else begin
    Write('<недостаточно места в буфере: ',n,'>');
  end;
end;

procedure tLZDictionary.WritelnFragment;
begin
  write(ACode,': "');
  WriteFragment(ACode, AWorkBuffer,AWorkBufSize);
  Writeln('"');
end;

function  tLZDictionary.SizeInNodesMin:tIndex;
begin
  SizeInNodesMin:=cSizeInNodesMin;
end;

function  tLZDictionary.SizeInNodesMax:tIndex;
begin
  SizeInNodesMax:=cSizeInNodesMax;
end;

function  tLZDictionary.FragmentLengthMin:tIndex;
begin
  FragmentLengthMin:=cFragmentLengthMin;
end;

function  tLZDictionary.FragmentLengthMax:tIndex;
begin
  FragmentLengthMax:=cSizeInNodesMax;
end;

function tLZDictionary.NextCodeLength:tIndexBitsCounter;
begin
  if fNewByte in prDicFlags then begin
    NextCodeLength:=8;
  end else if fIncCodeLength in prDicFlags then begin
    NextCodeLength:=cCodeLengthIncrementLength;
  end else begin
    NextCodeLength:=prCodeLength;
  end;
end;

{ найти продолжение AByte для текущего фрагмента
с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
Возвращает: TRUE, если продолжение найдено и
устанавливает соответствующие значения в
prLastCode, prFragmentLength и prInitialSizeInBytes }
function tLZDictionary.FindNextByte(AByte:tByte):boolean;
  var c:tIndex;      { вспосмогательная переменная }
begin
  {$IfOpt R+}
  if not (fEncodeRegime in prDicFlags)
      or (fDecodeRegime in prDicFlags) then begin
    RunError(201);
  end;
  {$EndIf}
  Inc(prInitialSizeInBytes);
  { поиск продолжения фрагмента }
  c:=FindLast(AByte);
  if c<>cNilIndex then begin
  { продолжение фрагмента найдено - продолжаем поиск }
    FindNextByte:=TRUE; prLastCode:=c; Inc(prFragmentLength);
  end else begin
    FindNextByte:=FALSE;
  end;
end;

{ Пропустить в ABuffer текущий фрагмент
  с изменением prLastCode, prFragmentLength и prInitialSizeInBytes.
Возвращает: длину пропущенного фрагмента и
устанавливает соответствующие значения в
prLastCode, prFragmentLength и prInitialSizeInBytes }
function tLZDictionary.SkipFragment(const ABuffer; ABufferSize:tBufferIndex):tBufferIndex;
  var FragmentSize:tBufferIndex;
begin
  {$IfOpt R+}
  if not (fEncodeRegime in prDicFlags)
      or (fDecodeRegime in prDicFlags) then begin
    RunError(201);
  end;
  {$EndIf}
  { Поиск продолжения в словаре }
  FragmentSize:=LZBase.FindFragmentInDictionary(ABuffer, ABufferSize, prLastCode, prDic);
{  if FragmentSize>0 then begin}
  { Изменение данных по длине текущего фрагмента и размера исходных данных }
    Inc(prFragmentLength,FragmentSize);
    Inc(prInitialSizeInBytes,FragmentSize);
{  end;}
  SkipFragment:=FragmentSize;
end;

{ отношение размера закодированных данных к размеру исходных данных
(только в режиме SetEncodeRegime) }
function  tLZDictionary.CompressionRatio:{$IfOpt N+}double{$else}real{$EndIf};
begin
  CompressionRatio:=CompressedSizeInBytes/InitialSizeInBytes;
end;

END.