tpu/arbbtools.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

  Herramientas auxiliares para \'arboles binarios
  por cursores. keywords: arbol binario, cursores

  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: arbbtools.pas,v 1.1 2002/04/25 15:57:09 mstorti Exp mstorti $  }
 
unit arbbtools;

interface

uses u_arbbii;

function SIGUIENTE_FICHA    (var pos: integer;
                                   s: string): char;
procedure DEVUELVE_FICHA    (var pos: integer;
                                   s: string);
function CREA_DE_STRING_REC (  s: string;
		      var bosque: bosque_arbbii ;
		      var    pos: integer): curs_nodo ;
function CREA_DE_STRING (      s: string;
		      var bosque: bosque_arbbii): curs_nodo ;
procedure IMPRIME_N (n: curs_nodo; b: bosque_arbbii);

implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function SIGUIENTE_FICHA (var pos: integer; s: string): char;
begin
{ SIGUIENTE_FICHA := copy(s,pos,1);}
  SIGUIENTE_FICHA := s [pos];
  pos := pos + 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure DEVUELVE_FICHA (var pos: integer; s: string);
begin
 { SIGUIENTE_FICHA := copy (s, pos, 1);}
   pos := pos - 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function CREA_DE_STRING_REC (         s: string;
			     var bosque: bosque_arbbii;
			     var pos: integer): curs_nodo ;
var
   eti    : integer;
   f, aux : char;
   n1, n2 : curs_nodo;
begin 
   f := SIGUIENTE_FICHA (pos, s);
   if (f = 'L') then
     CREA_DE_STRING_REC := lambda
   else if (f in ['0'..'9'] ) then begin
     eti := ord (f) - ord ('0');
     aux := SIGUIENTE_FICHA (pos, s);
     if ( aux = '{' ) then
       begin
       n1  := CREA_DE_STRING_REC (s, bosque, pos);
       aux := siguiente_ficha (pos,s);
       if (aux <> ',' ) then begin
         writeln ('No puede encontrar ","');
         exit;
       end ; {if}
       n2  := CREA_DE_STRING_REC (s, bosque, pos);
       aux := SIGUIENTE_FICHA (pos, s);
       if (aux <> '}' ) then begin
         writeln ('No puede encontrar ","');
         exit;
       end ; {if}
       CREA_DE_STRING_REC := BOSQUE.CREA2 (eti, n1, n2);
       end
     else begin
       DEVUELVE_FICHA (pos, s);
       CREA_DE_STRING_REC := BOSQUE.CREA2(eti,lambda,lambda);
     end ; {if}
   end; {if}
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function CREA_DE_STRING (     s: string;
		     var bosque: bosque_arbbii): curs_nodo ;
var
   pos : integer;
begin
   pos := 1;
   CREA_DE_STRING := CREA_DE_STRING_REC (s, bosque, pos);
end; { CREA_DE_STRING }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure IMPRIME_N (n: curs_nodo; b: bosque_arbbii);
var
  mi, md : curs_nodo;
begin
  if (n = lambda) then begin
    write ('L');
    exit;
  end ; {if}
  write (b.ETIQUETA (n));
  mi := b.HIJO_IZQ (n);
  md := b.HIJO_DER (n);
  if (mi <> lambda) or (md <> lambda) then begin
    write ('{');
    IMPRIME_N (mi, b);
    write(',');
    IMPRIME_N (md, b);
    write('}');
  end;
  if b.PADRE (n) = lambda then writeln ('');
end;

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}