program Huffman;
{ Programa aceita como entrada: caracteres alfanumericos (acentuados 
  ou nao) e sinais de pontuacao ".", "!", "...", "," , etc. }
const
  VAZIO    = '!!!!!!!!!!';
  RETIRADO = '**********';
  M = 1000;
  N = 10; { Tamanho da chave }
  BASENUM = 128; { Base numerica que o algoritmo trabalha }
  MAXALFABETO = 255; { Constante utilizada em ExtraiProximaPalavra }
  MAXTAMVETORESBO = 10;
type
  TipoApontador   = integer;
  TipoChave       = packed array [1..n] of char;
  TipoPesos       = array [1..n] of integer;
  TipoItem        = record
                      Chave: TipoChave;
                      { outros componentes }
                      Freq: integer;
                      Ordem: integer;
                    end;
  TipoIndice      = 0..M;
  TipoDicionario  = array [TipoIndice] of TipoItem;
  TipoAlfabeto    = array [0..MAXALFABETO] of boolean;
  TipoBaseOffset  = record
                      Base  : integer;
                      Offset: integer;
                    end;
  TipoVetoresBO   = array [1..MAXTAMVETORESBO] of TipoBaseOffset;
  TipoArqResult   = File of Byte;
  TipoPalavra     = String [255];
  TipoVetorPalavra= array [1..M] of TipoPalavra;

var ArqTxt, ArqAlf: text;  ArqComprimido: TipoArqResult;
    NomeArqTxt, Opcao: TipoPalavra;  NomeArqComp: TipoPalavra;

procedure GeraPesos(var p: TipoPesos);
var i: integer;
begin
  randomize;
  for i:= 1 to N do p[i] := trunc(1000000 * random + 1);
end;

function h (Chave: TipoChave; p: TipoPesos): TipoIndice;
var i, Soma: integer;
begin
  Soma := 0;
  for i := 1 to N do Soma := Soma + ord(Chave[i]) * p[i];
  h := Soma mod M;
end;

procedure Inicializa (var T: TipoDicionario);
var i: integer;
begin
  for i := 0 to M do begin T[i].Chave := VAZIO; T[i].Freq := 0; T[i].Ordem := 0 end;
end;

function Pesquisa (Ch: TipoChave; var p: TipoPesos;
                   var T: TipoDicionario): TipoApontador;
var i: integer;
    Inicial: integer;
begin
  Inicial := h(Ch, p);
  i := 0;
  while (T[(Inicial + i) mod M].Chave <> VAZIO) and
        (T[(Inicial + i) mod M].Chave <> Ch) and
        (i < M) do i := i + 1;
  if T[(Inicial + i) mod M].Chave = Ch
  then Pesquisa := (Inicial + i) mod M
  else Pesquisa := M { Pesquisa sem sucesso }
end;

procedure Insere (x: TipoItem; var p: TipoPesos;
                  var T: TipoDicionario);
var i: integer;
    Inicial: integer;
begin
  if Pesquisa(x.Chave, p, T) < M
  then writeln('Elemento ja esta presente')
  else begin
       Inicial := h(x.Chave, p);
       i := 0;
       while ((T[(Inicial + i) mod M].Chave <> VAZIO) and
          (T[(Inicial + i) mod M].Chave <> RETIRADO)) and
          (i < M) do i := i + 1;
       if i < M
       then T[(Inicial + i) mod M] := x
       else writeln(' Tabela cheia')
       end;
end;

procedure Retira (Ch: TipoChave; var p: TipoPesos;
                  var T: TipoDicionario);
var i: TipoIndice;
begin
  i := Pesquisa(Ch, p, T);
  if i < M
  then T[i].Chave := RETIRADO
  else writeln('Registro nao esta presente')
end; { Retira }

procedure Imprime (var tabela: TipoDicionario);
var i, j: integer;
begin
  for i := 0 to M do
    begin
    write (i: 3, '  ');
    for j := 1 to N do write (tabela[i].Chave[j]);
    write (' -- ', tabela[i].Freq: 4, ' -- ', tabela[i].Ordem: 4);
    writeln
    end
end;

{ Inicio dos procedimentos do Extrator }
procedure DefineAlfabeto (var Alfabeto: TipoAlfabeto; var ArqAlf: text);
var Simbolos: String[MAXALFABETO]; 
    i: integer;
begin { Os Simbolos devem estar juntos em uma linha no arquivo }
  for i := 0 to MAXALFABETO do Alfabeto[i] := false;
  readln(ArqAlf, Simbolos);
  for i:=1 to length(Simbolos) do Alfabeto[ord(Simbolos[i])] := true; 
  Alfabeto[0] := false; { caractere de codigo zero: separador }
end;

function ExtraiProximaPalavra (var Indice: integer; 
                               var Linha: String;
                               var ArqTxt: text;
                               var Alfabeto: TipoAlfabeto): TipoPalavra;
var FimPalavra, Aux: boolean;  Result : TipoPalavra;
begin
  FimPalavra := False; 
  Aux := False; 
  Result := '';
  if Indice = Length(Linha)
  then if eof(ArqTxt)
       then begin
            Linha := char (0); 
	    FimPalavra := True
            end
       else begin
            readln (ArqTxt, Linha);
            { Coloca o caractere de fim de linha em Linha }
            Linha := Linha + char(10) + char(0);  Indice := 1
            end;
  while (Indice <= length(Linha)) and not FimPalavra do
    begin
    if Alfabeto[ord (Linha[Indice])]
    then begin Result := Result + Linha[Indice]; 
    Aux := true; 
    end
    else begin
         if Aux
         then begin if Linha[Indice]<>char(0) then Indice := Indice-1 end
         else Result := Result + Linha[Indice]; 
	 FimPalavra := True;
         end;
    Indice := Indice + 1;
    end;
    ExtraiProximaPalavra := Result;
end;

{ Procedimentos da Compressao e Descompressao }
procedure PrimeiraEtapa (var ArqTxt: text;var Alfabeto: TipoAlfabeto;
                         var Indice: integer; var Palavra, Linha: String;
                         var Vocabulario  : TipoDicionario; p: TipoPesos);
var Elemento: TipoItem;
    i: integer;
begin
  repeat
    Palavra := ExtraiProximaPalavra (Indice,Linha,ArqTxt,Alfabeto);    
    Elemento.Chave := Palavra + char(0); 
    Elemento.Freq := 1;
    if Palavra <> ''
    then begin
         i := Pesquisa (Elemento.Chave, p, Vocabulario);
         if i < M
         then Vocabulario[i].Freq := Vocabulario[i].Freq + 1
         else Insere (Elemento, p, Vocabulario);
         repeat
           Palavra:=ExtraiProximaPalavra (Indice,Linha,ArqTxt,Alfabeto );
           Elemento.Chave := Palavra + char(0);
           { O primeiro espaco depois da palavra nao e codificado }
           if (Trim (Palavra) <> '') and (Trim (Palavra) <> char(0))
           then begin
                i := Pesquisa (Elemento.Chave, p, Vocabulario);
                if i < M
                then Vocabulario[i].Freq := Vocabulario[i].Freq + 1
                else Insere (Elemento, p, Vocabulario);
                end
         until Trim (Palavra) = '';
         end
  until Palavra = '';
end;


procedure CalculaCompCodigo (var A: TipoDicionario; n: integer);
var u,     { Nodos internos usados }
    h,     { Altura da arvore }
    NoInt, { Numero de nodos internos }
    Prox, Raiz, Folha, Disp, x, Resto: integer;
begin
  if n > (BASENUM - 1)
  then begin
       Resto := 1 + ((n - BASENUM) mod (BASENUM - 1));
       if Resto < 2 then Resto := BASENUM;
       end
  else Resto := n - 1;
  NoInt := 1 + ((n - Resto) div (BASENUM - 1));
  for x := (n - 1) downto (n - Resto + 1) do
    A[n].Freq :=  A[n].Freq + A[x].Freq;
  { Primeira Fase }
  Raiz := n;  Folha := n - Resto;
  for Prox := n - 1 downto (n - NoInt + 1) do
    begin
    { Procura Posicao }
    if ((Folha<1) or ((Raiz>Prox) and (A[Raiz].Freq<=A[Folha].Freq)))
    then begin { No interno }
         A[Prox].Freq := A[Raiz].Freq;
         A[Raiz].Freq := Prox;  Raiz := Raiz - 1;
         end
    else begin { No-folha }
         A[Prox].Freq := A[Folha].Freq;  Folha := Folha - 1;
         end;
    { Atualiza Frequencias }
    for x := 1 to (BASENUM - 1) do
      begin
      if ((Folha<1) or ((Raiz>Prox) and (A[Raiz].Freq<=A[Folha].Freq)))
      then begin { No interno }
           A[Prox].Freq := A[Prox].Freq + A[Raiz].Freq;
           A[Raiz].Freq := Prox; Raiz := Raiz - 1;
           end
      else begin { No-folha }
           A[Prox].Freq := A[Prox].Freq+A[Folha].Freq; 
	   Folha := Folha-1;
           end;
      end;
    end;
  { Segunda Fase }
  A[Raiz].Freq := 0; 
  for Prox := Raiz + 1 to n do A[Prox].Freq := A[A[Prox].Freq].Freq + 1;
  { Terceira Fase }
  Disp := 1;  u := 0;  h := 0; Prox := 1;
  while Disp > 0 do
    begin
    while (Raiz <= n) and (A[Raiz].Freq = h) do
      begin u := u + 1; Raiz := Raiz + 1 end;
    while Disp > u do
      begin
      A[Prox].Freq := h; Prox := Prox + 1; Disp := Disp - 1;
      if Prox > n then begin u := 0; break end
      end;
    Disp := BASENUM * u; h := h + 1; u := 0;
    end;
end;

procedure QuickSort (var A: TipoDicionario; var n: TipoIndice);

procedure Particao (Esq, Dir: TipoIndice; var i, j: TipoIndice);
var x, w: TipoItem;
begin
  i := Esq; j := Dir;
  x := A[(i + j) div 2]; { obtem o pivo x }
  repeat
    while x.Freq < A[i].Freq do i := i + 1;
    while x.Freq > A[j].Freq do j := j - 1;
    if i <= j
    then begin
         w := A[i]; A[i] := A[j]; A[j] := w;
         i := i + 1; j := j - 1;
         end;
  until i > j;
end;

  procedure Ordena (Esq, Dir: TipoIndice);
  var i, j: TipoIndice;
  begin
    particao (Esq, Dir, i, j);
    if Esq < j then Ordena (Esq, j);
    if i < Dir then Ordena (i, Dir);
  end;
begin
  Ordena (1, n);
end;

function OrdenaPorFrequencia (var Vocabulario: TipoDicionario): TipoIndice;
var i, n: TipoIndice;  Item: TipoItem;
begin
  n := 1;  Item := Vocabulario[1];
  for i := 0 to M - 1 do
    if Vocabulario[i].Chave <> VAZIO
    then if i <> 1
         then begin Vocabulario[n] := Vocabulario[i]; n := n + 1; end;
  if Item.Chave <> VAZIO
  then Vocabulario[n] := Item else n := n - 1;
  Quicksort (Vocabulario, n);
  OrdenaPorFrequencia := n;
end;

{ Procedimento para gravar um numero inteiro em um arquivo de bytes }
procedure GravaNumInt (var ArqComprimido: TipoArqResult; Num: integer);
var i: integer;
begin
  for i :=  sizeof (integer) - 1 downto 0 do
    write (ArqComprimido, Num shr (i * 8));
end;

{ Procedimento para ler um numero inteiro de um arquivo de bytes }
function LeNumInt (var ArqComprimido: TipoArqResult): integer;
var i, Num, NumResp: integer;
begin
  NumResp := 0;
  for i :=  sizeof (integer) - 1 downto 0 do
    begin
    read (ArqComprimido, Num);  Num := Num shl (i * 8);
    NumResp := NumResp or Num;
    end;
  LeNumInt := NumResp;
end;

function ConstroiVetores (var VetoresBaseOffset: TipoVetoresBO;
                          var Vocabulario: TipoDicionario; n: integer;
                          var ArqComprimido: TipoArqResult): integer;
var Wcs: array[1..MAXTAMVETORESBO] of integer;
    i, MaxCompCod: integer;
begin
  MaxCompCod := Vocabulario[n].Freq;
  for i := 1 to MaxCompCod do Wcs[i] := 0;
  for i := 1 to n do
    begin
    Wcs[Vocabulario[i].Freq] := Wcs[Vocabulario[i].Freq] + 1;
    VetoresBaseOffset[Vocabulario[i].Freq].Offset := 
      i - Wcs[Vocabulario[i].Freq] + 1;
    end;
  VetoresBaseOffset[1].Base := 0;
  for i := 2 to MaxCompCod do
  begin
    VetoresBaseOffset[i].Base := BASENUM*(VetoresBaseOffset[i-1].Base +
                                 Wcs[i-1]);
    if VetoresBaseOffset[i].Offset = 0
    then VetoresBaseOffset[i].Offset := VetoresBaseOffset[i-1].Offset
  end;
  { Salvando as tabelas em disco }
  GravaNumInt (ArqComprimido, MaxCompCod);
  for i:= 1 to MaxCompCod do
    begin
    GravaNumInt(ArqComprimido, VetoresBaseOffset[i].Base);
    GravaNumInt(ArqComprimido, VetoresBaseOffset[i].Offset);
    end;
  ConstroiVetores := MaxCompCod;
end;

function SegundaEtapa (var Vocabulario      : TipoDicionario;
                       var VetoresBaseOffset: TipoVetoresBO;
                       var p                : TipoPesos;
                       var ArqComprimido    : TipoArqResult): integer;
var 
  i, j, NumNodosFolhas, PosArq: integer;  Ch: Char;
  Elemento: TipoItem;  Palavra: TipoPalavra;
begin
  NumNodosFolhas := OrdenaPorFrequencia (Vocabulario);
  CalculaCompCodigo (Vocabulario, NumNodosFolhas);
  SegundaEtapa := ConstroiVetores (VetoresBaseOffset, Vocabulario,
                                   NumNodosFolhas, ArqComprimido);
  { Grava Vocabulario }
  GravaNumInt (ArqComprimido, NumNodosFolhas);
  PosArq := FilePos(ArqComprimido);
  for i := 1 to NumNodosFolhas do
    begin
    j := 1;
    while Vocabulario[i].Chave[j] <> char(0) do
      begin
      write(ArqComprimido, Byte(Vocabulario[i].Chave[j])); j := j + 1;
      end;
    write(ArqComprimido, Byte(char(0)));
    end;
  { Le e reconstroi a condicao de hash no vetor que contem o vocabulario }
  Seek(ArqComprimido, PosArq); Inicializa (Vocabulario);
  for i := 1 to NumNodosFolhas do
    begin
    Palavra := '';
    repeat
      read(ArqComprimido, Byte(Ch));
      if Ch <> char(0)
      then Palavra := Palavra + Ch;
    until Ch = char(0);
    Elemento.Chave := Palavra + char(0); Elemento.Ordem := i;
    j := Pesquisa (Elemento.Chave, p, Vocabulario);
    if j >= M
    then Insere (Elemento, p, Vocabulario);
    end;
end;

procedure Escreve(var ArqComprimido:TipoArqResult; var Codigo,c:integer);
var Saida:array[1..MAXTAMVETORESBO] of byte; i,cTmp,LogBase2,Mask:integer;
begin
  LogBase2 := Round (Ln(BASENUM)/Ln(2));
  Mask := Round(2**logBase2 - 1); i := 1; cTmp := c;
  Saida[i] := (Codigo shr (LogBase2*(c - 1)));
  if (LogBase2 = 7) then Saida[i] := Saida[i] or $80; // Marcacao
  i := i + 1;  c := c - 1;
  while  c > 0 do
    begin
    Saida[i]:=(Codigo shr (LogBase2*(c-1))) and Mask; i:=i+1;  c:=c-1;
    end;
  for i:= 1 to cTmp do write(ArqComprimido, Saida[i]);
end;

function Codifica (var VetoresBaseOffset: TipoVetoresBO; Ordem: integer;
                   var c: integer; MaxCompCod: integer): integer;
begin
  c := 1;
  while (Ordem >= VetoresBaseOffset[c + 1].Offset) and
        (c + 1 <= MaxCompCod) do c := c + 1;
  Codifica := Ordem - VetoresBaseOffset[c].Offset +
              VetoresBaseOffset[c].Base;
end;

procedure TerceiraEtapa(var ArqTxt: text; var Alfabeto: TipoAlfabeto;
                        var Indice: integer; var Palavra, Linha: String;
                        var Vocabulario: TipoDicionario; var p: TipoPesos;
                        var VetoresBaseOffset: TipoVetoresBO;
                        var ArqComprimido: TipoArqResult;
                        MaxCompCod: integer);
var Pos: TipoApontador;  Chave: TipoChave;  Codigo, c: integer;
begin
repeat
  Palavra := ExtraiProximaPalavra (Indice,Linha,ArqTxt,Alfabeto);
  Chave := Palavra + char(0);
  if Palavra <> ''
  then begin
       Pos := Pesquisa (Chave, p, Vocabulario);
       Codigo := Codifica (VetoresBaseOffset, Vocabulario[Pos].Ordem,
                           c, MaxCompCod);
       Escreve(ArqComprimido, Codigo, c);
       repeat
         Palavra:=ExtraiProximaPalavra (Indice,Linha,ArqTxt,Alfabeto);
         { O primeiro espaco depois da palavra nao e codificado }
         if (Trim (Palavra) <> '') and (Trim (Palavra) <> char(0))
         then begin
              Chave := Palavra + char(0);
              Pos := Pesquisa (Chave, p, Vocabulario);
              Codigo:=Codifica(VetoresBaseOffset,Vocabulario[Pos].Ordem,
                               c, MaxCompCod);
              Escreve(ArqComprimido, Codigo, c);
              end;
       until Trim (Palavra) = '';
       end
until Palavra = '';
end;

procedure Compressao (var ArqTxt, ArqAlf: text;
                      var ArqComprimido: TipoArqResult);
var Alfabeto         : TipoAlfabeto;
    Palavra, Linha   : TipoPalavra;
    Ind              : integer;
    MaxCompCod       : integer;
    Vocabulario      : TipoDicionario;
    p                : TipoPesos;
    VetoresBaseOffset: TipoVetoresBO;

begin
  { Inicializacao do Alfabeto }
  DefineAlfabeto (Alfabeto, ArqAlf); { Le o alfabeto definido em arquivo }
  Ind := 0; 
  Linha := '';
  {Inicializacao do Vocabulario }
  Inicializa (Vocabulario); 
  GeraPesos (p);

  { Inicio da Compressao }
  PrimeiraEtapa(ArqTxt, Alfabeto, Ind, Palavra, Linha, Vocabulario, p);
  MaxCompCod := SegundaEtapa (Vocabulario, VetoresBaseOffset,
                              p, ArqComprimido);
  Seek (ArqTxt, 0); { Coloca o cursor de leitura no inicio do arquivo}
  Ind := 0; 
  Linha := '';
  TerceiraEtapa (ArqTxt, Alfabeto, Ind, Palavra, Linha, Vocabulario, p, 
                 VetoresBaseOffset, ArqComprimido, MaxCompCod);
end;

{Procedimentos da Descompressao}
function LeVetores (var ArqComprimido: TipoArqResult;
                    var VetoresBaseOffset: TipoVetoresBO): integer;
var MaxCompCod, i: integer;
begin
  MaxCompCod := LeNumInt (ArqComprimido);
  for i := 1 to MaxCompCod do
    begin
    VetoresBaseOffset[i].Base   := LeNumInt (ArqComprimido);
    VetoresBaseOffset[i].Offset := LeNumInt (ArqComprimido);
    end;
  LeVetores := MaxCompCod;
end;

function LeVocabulario (var ArqComprimido: TipoArqResult;
                        var Vocab        : TipoVetorPalavra): integer;
var NumNodosFolhas, i: integer;
    Palavra: TipoPalavra; Ch: Char;
begin
  NumNodosFolhas := LeNumInt (ArqComprimido);
  for i := 1 to NumNodosFolhas do
    begin
    Palavra := '';
    repeat
      read(ArqComprimido, Byte(Ch));
      if Ch <> char(0) { As palavras estao separadas pelo caratere 0 }
      then Palavra := Palavra + Ch;
    until Ch = char(0);
    Vocab[i] := Palavra;
    end;
  LeVocabulario := NumNodosFolhas;
end;

function Decodifica (var VetoresBaseOffset: TipoVetoresBO;
                     var ArqComprimido: TipoArqResult;
                     MaxCompCod: integer): integer;
var c, Codigo, CodigoTmp, LogBase2: integer;
begin
  LogBase2 := Round (Ln(BASENUM)/Ln(2));  c := 1; 
  read(ArqComprimido, Codigo);
  if (LogBase2 = 7) 
  then Codigo := Codigo - 128; { remove o bit de marcacao }
  while ((c + 1) <= MaxCompCod) and
        ((Codigo shl LogBase2) >= VetoresBaseOffset[c+1].Base) do
    begin
    read(ArqComprimido, CodigoTmp);
    Codigo := (Codigo shl LogBase2) or CodigoTmp; c := c + 1;
    end;
  Decodifica := Codigo - VetoresBaseOffset[c].Base +
                VetoresBaseOffset[c].Offset
end;

procedure Descompressao (var ArqComprimido: TipoArqResult;
                         var ArqTxt, ArqAlf: text);
var Alfabeto         : TipoAlfabeto;
    Ind, MaxCompCod  : integer;
    Vocab            : TipoVetorPalavra;
    VetoresBaseOffset: TipoVetoresBO;
    PalavraAnt       : TipoPalavra;
begin
  DefineAlfabeto (Alfabeto, ArqAlf); { Le o alfabeto definido em arquivo }
  MaxCompCod := LeVetores (ArqComprimido, VetoresBaseOffset);
  Ind := LeVocabulario (ArqComprimido, Vocab);
  Ind := Decodifica (VetoresBaseOffset, ArqComprimido, MaxCompCod);
  PalavraAnt := '\n';  
  write (ArqTxt, Vocab[Ind]);
  while not Eof (ArqComprimido) do
    begin
    Ind := Decodifica (VetoresBaseOffset, ArqComprimido, MaxCompCod);
    if (Alfabeto [Ord(Vocab[Ind][1])]) 
    then if (PalavraAnt[1] <> char(10)) then write (ArqTxt, ' '); 
    PalavraAnt := Vocab[Ind]; write (ArqTxt, Vocab[Ind]);
    end;
end;

{Procedimentos para fazer busca}
const
  MaxTamTexto  = 1000;
  MaxTamPadrao = 10;
  MaxChar      = 256;
  NumMaxErros  = 10;
type
  TipoTexto = array[1..MaxTamTexto] of char;
  TipoPadrao= array[1..MaxTamPadrao] of char;

procedure BMH (var T: TipoTexto; n: integer;
               var P: TipoPadrao; m: integer);
var i, j, k: Integer;
    d: array[0..MaxChar] of integer;
begin
  {-- Pre-processamento do padrao --}
  for j := 0 to MaxChar do d[j] := m;
  for j := 1 to m-1 do d[ord(P[j])] := m-j;
  i := m;
  while i <= n do {-- Pesquisa --}
    begin
    k := i;  j := m;
    while (j>0) and (T[k] = P[j]) do begin k := k - 1; j := j - 1; end;
    if j = 0 then writeln(' Casamento na posicao: ', k + 1:3);
    i := i + d[ord(T[i])];
    end;
end;

procedure Atribui (var P: TipoPadrao; Codigo, c: integer);
var i, cTmp: integer;
begin
  i := 1;  cTmp := c;
  P[i] := Char((Codigo shr (7*(c - 1))) or $80);
  i := i + 1;  c := c - 1;
  while  c > 0 do
    begin
    P[i] := Char((Codigo shr (7*(c - 1))) and 127);
    i := i + 1;  c := c - 1;
    end;
end;

procedure Busca (var ArqComprimido:TipoArqResult; var ArqAlf:text);
var 
  Alfabeto: TipoAlfabeto;           Ind, Codigo, i: integer;
  MaxCompCod: integer;              Vocab: TipoVetorPalavra;
  VetoresBaseOffset: TipoVetoresBO; PalavraAnt, p: TipoPalavra;
  c, Ord, NumNodosFolhas: integer;  T: TipoTexto;
  Padrao: TipoPadrao;               n: integer;
begin
DefineAlfabeto (Alfabeto, ArqAlf); {Le o alfabeto definido em arquivo}
MaxCompCod := LeVetores (ArqComprimido, VetoresBaseOffset);
NumNodosFolhas := LeVocabulario (ArqComprimido, Vocab); n := 1;
while not Eof (ArqComprimido) do
  begin read(ArqComprimido, Byte(T[n])); n := n + 1 end;
while true do
  begin
  write('Padrao (digite s para terminar):'); readln(p);
  if p = 's' then break;  Ind := 1;
  while Ind <= NumNodosFolhas do
    begin if Vocab[Ind]=p then begin Ord:=Ind; break end; Ind:=Ind+1;
    end;
  if (Ind = NumNodosFolhas+1) 
  then begin writeln('Padrao: ',p,' nao encontrado');continue; end;        
  Codigo := Codifica (VetoresBaseOffset, Ord, c, MaxCompCod);
  Atribui(Padrao, Codigo, c);
  BMH (T, n, Padrao, c);
  end 
end;

begin
while Opcao <> 't' do
begin
  writeln ('*********************************************************');
  writeln ('*                       Opcoes                          *');
  writeln ('*-------------------------------------------------------*');
  writeln ('* (c) Compressao                                        *');
  writeln ('* (d) Descompressao                                     *');
  writeln ('* (p) Pesquisa no texto comprimido                      *');
  writeln ('* (t) Termina                                           *');
  writeln ('*********************************************************');
  write ('* Opcao:'); readln (Opcao);
  Assign (ArqAlf, 'alfabeto.txt'); reset (ArqAlf);
  if Opcao = 'c'
  then begin
       write ('Arquivo texto a ser comprimido:'); readln (NomeArqTxt);
       write ('Arquivo comprimido a ser gerado:');readln (NomeArqComp);
       Assign(ArqTxt, NomeArqTxt); Assign(ArqComprimido, NomeArqComp);
       reset (ArqTxt); Rewrite (ArqComprimido);
       Compressao (ArqTxt, ArqAlf, ArqComprimido);
       close (ArqTxt); close (ArqComprimido);
       end
  else if Opcao = 'd'
       then begin
            write ('Arquivo comprimido a ser descomprimido:');
            readln (NomeArqComp);write ('Arquivo texto a ser gerado:');
            readln (NomeArqTxt); Assign (ArqTxt, NomeArqTxt);
            Assign (ArqComprimido, NomeArqComp); Rewrite (ArqTxt);
            Reset (ArqComprimido);
            Descompressao (ArqComprimido, ArqTxt, ArqAlf);
            close (ArqTxt); close (ArqComprimido);
            end
       else if Opcao = 'p'
            then begin
                 write ('Arquivo comprimido para ser pesquisado:');
                 readln (NomeArqComp); Assign (ArqComprimido, NomeArqComp);
                 reset (ArqComprimido); Busca (ArqComprimido, ArqAlf);
                 close (ArqComprimido);
                 end;
  close (ArqAlf);
end;
end.