{ Программ тестирования работы словаря для метода Лемпеля-Зива }
program DicTest;

  USES  xCrt,
	LZTests,
	ComTypes,
	LZTypes,
	LZBase,
	LZDic0,
	LZDic;

var
  Dic:tLZDictionary;

procedure WriteFragment(Code:tIndex); forward;

procedure WriteFragments(const ADic:tLZDictionary);
   var i:tIndex;
begin
  for i:=Succ(cRootIndex) to Pred(ADic.DicDataPtr^.Descriptors.FirstFree) do begin
    if ADic.DicDataPtr^.Successors^[i]=cNilIndex then begin
      write(i,': "');
      WriteFragment(i);
      Write('", ');
    end;
  end;
end;


procedure WriteCode(ACode:tIndex);
  type
    tFlag=(fNewCode, fIncCodeLength);
    tFlags= set of tFlag;
  const Flags:tFlags=[];
  const bs:set of Byte=[];
begin
  if fNewCode in Flags then begin
    Exclude(Flags,fNewCode);
    write(ACode);
    if ACode in bs then
      write('Error!');
    Include(bs,ACode);
  end else if fIncCodeLength in Flags then begin
    Exclude(Flags,fIncCodeLength);
    write(ACode);
  end else begin
    NormVideo;
    case ACode of
      cCode_ResetDictionary: begin
	TextColor(Yellow);
	write('r');
	Include(Flags,fNewCode);
	bs:=[];
      end;
      cCode_IncCodeLength: begin
	TextColor(LightBlue);
	write('i');
	Include(Flags,fIncCodeLength);
      end;
      cCode_NewByte: begin
	TextColor(Yellow);
	write('n');
	Include(Flags,fNewCode);
      end;
      else begin
	write(ACode);
      end;
    end;
  end;
end;

procedure WriteCodes(const Codes:tLZCodesArray; n:tCodesIndex);
  var  i:tCodesIndex; c:tIndex;
  const bs:set of Byte=[];
begin
  i:=0;
  while i<n do begin
    c:=Codes.Code[i];
    case c of
      cCode_ResetDictionary: begin
	TextColor(Yellow);
	Inc(i);
	c:=Codes.Code[i];
	if c in bs then
	  write('Error!');
	write('r, ',c);
	write('(',Chr(c),')');
	NormVideo;
	bs:=[];
      end;
      cCode_IncCodeLength: begin
	TextColor(Yellow);
	Inc(i);
	c:=Codes.Code[i];
	write('i',', ',c);
	NormVideo;
      end;
      cCode_NewByte: begin
	TextColor(Yellow);
	Inc(i);
	c:=Codes.Code[i];
	write('n, ',c);
	if c in bs then
	  write('Error!');
	Include(bs,c);
	NormVideo;
	write('(',Chr(c),')');
      end;
      else begin
	write(c,'(');
	WriteFragment(c);
	write(')');
      end;
    end;
    Inc(i);
    write(', ');
  end;
end;

const
  cInitialBuf='abcdabce abcd abceabcabcabcd     abcaabcdabce abceca ';

type
  tBufIndex=0..Pred(Length(cInitialBuf));
  tBuff=array[tBufIndex] of char;
  tCodesBuffIndex=0..3000;
  tCodesBuff=array[tCodesBuffIndex] of tIndex;

var
  TmpBuf:tBuff;

procedure WriteFragment(Code:tIndex);
begin
  Dic.WriteFragment(Code,TmpBuf,SizeOf(TmpBuf));
end;

var
  Codes:tLZCodesArray;
  n:tIndex;
  nc:tBufferIndex;
  i,j:word;
  InitialBuf,DecodedBuf:tBuff;
  EncodedBuf:tCodesBuff;
  ibI:tBufIndex;
  ebI:tCodesBuffIndex;
  b:byte;

begin
  writeln;
   writeln('Program Test LZDic start...');
  writeln;
  Dic.Init(Dic.SizeInNodesMax);
  Randomize;

  for ibI:=Low(ibI) to High(ibI) do begin
    b:=random(High(b));
    InitialBuf[ibI]:=Chr(b);
    DecodedBuf[ibI]:=#0;
  end;
  InitialBuf:=cInitialBuf;

  for ebI:=Low(ebI) to High(ebI) do begin
    EncodedBuf[ebI]:=cNilIndex;
  end;

  writeln('Кодируем: ');
  ibI:=Low(ibI);
  while (ibI<High(ibI)) do begin
    write(InitialBuf[ibI]);
    Inc(ibI);
  end;
  writeln;
  ebI:=Low(ebI);
  ibI:=Low(ibI);
  while (ebI<High(ebI)) and (ibI<High(ibI)) do begin
    n:=Dic.ByteToCodes(Byte(InitialBuf[ibI]),Codes);
    Inc(ibI);
    if n>High(tCodesIndex) then begin
       write('!',n);
       RunError(201);
    end;
    WriteCodes(Codes,n);
    i:=0;
    while (i<n) and (ebI<High(ebI)) do begin
      EncodedBuf[ebI]:=Codes.Code[i];
      Inc(i);
      Inc(ebI);
    end;
  end;
  if n=0 then begin
    n:=Dic.GetLastCodes(Codes);
    if n>High(tCodesIndex) then begin
       write('!',n);
       RunError(201);
    end;
    WriteCodes(Codes,n);
    i:=0;
    while (i<n) and (ebI<High(ebI)) do begin
      EncodedBuf[ebI]:=Codes.Code[i];
      Inc(i);
      Inc(ebI);
    end;
  end;
  writeln;
  writeln('Исходный размер, байт: ',Dic.InitialSizeInBytes);
  writeln('Упакованный размер, байт: ',Dic.CompressedSizeInBytes);
  writeln('Словарь, узлов: ',Dic.SizeInNodes-Dic.FreeSizeInNodes);
  writeln('Свободно в словаре, узлов: ',Dic.FreeSizeInNodes);
  writeln('Макс. длина фрагмента, байт: ',Dic.CurrentSessionMaxFragmentSize);
  Dic.SeqCheck;
  writeln('Словарь: ');
  WriteFragments(Dic);
  writeln;
  writeln;

  writeln('Декодируем: ');
  Dic.SetDecodeRegime;
  i:=Low(ebI);
  while i<ebI do begin
    n:=Dic.CodeToBytes(EncodedBuf[i],DecodedBuf,SizeOf(DecodedBuf),nc);
    WriteCode(EncodedBuf[i]);
    Inc(i);
    if nc>0 then begin
      j:=0;
      write('(');
      while (j<nc) do begin
	write(DecodedBuf[j]);
	Inc(j);
      end;
      write('), ');
    end else begin
      write(', ');
    end;
  end;
  writeln;

  Dic.Done;
  writeln;
  writeln('Program TestLZDictionary end.');
end.