Arvore

{* paulogp *}
{* mac os 7 *}
program Ada27p;

uses
    MemTypes, QuickDraw, OSIntf;

type
    String20 = string[20];
    Itemponteiro = ^item;
    Item = record
            dado : string20;
            esquerda, direita: Itemponteiro
        end;

var
    novodado : string20;
    raiz: Itemponteiro;
    tecla: string;


procedure processar(no : Itemponteiro);
begin
    write(no^.dado,', ')
end;

procedure emordem( no : Itemponteiro);
begin
    if no <> nil then
    begin
        emordem(no^.esquerda);
        processar(no);
        emordem(no^.direita);
    end;
end;

procedure preordem( no : Itemponteiro);
begin
    if no <> nil then
    begin
        processar(no);
        preordem(no^.esquerda);
        preordem(no^.direita);
    end;
end;

procedure postordem( no : Itemponteiro);
begin
    if no <> nil then
    begin
        postordem(no^.esquerda);
        postordem(no^.direita);
        processar(no);
    end;
end;

procedure procurar(var raiz : Itemponteiro);
begin
    if raiz = nil then
    begin
        new(raiz);
        with raiz^ do
        begin
            dado:= novodado;
            esquerda:= nil;
            direita:= nil;
        end;
    end else
    with raiz^ do
    begin
        if novodado < dado then procurar(esquerda) else
            if novodado > dado then procurar(direita) else
                Writeln ('Erro : duplicacao de dados!')
    end
end;

begin
    repeat
        writeln('Exemplo de Arvore');
        writeln('~~~~~~~~~~~~~~~~~');
        raiz := nil;
        repeat
            write('Dado (return para terminar)? ');
            readln(novodado);
            if length(novodado) > 0 then procurar(raiz)
        until length(novodado) = 0;
        writeln;
        writeln('Preordem:');
        preordem (raiz);
        writeln;
        writeln;
        writeln('Em ordem:');
        emordem (raiz);
        writeln;
        writeln;
        writeln('Postordem:');
        postordem (raiz);
        writeln;
        writeln;
        writeln;
        write('Repetir (s/n): ');
        readln(tecla);
        uprstring(tecla, true);
    until tecla = 'N';
end.