Program P133;
 { Arbori de ordinul m }
const m=4;
type Arbore=^Nod;
     Nod=record
               Info : string;
                Dsc : array [1..m] of Arbore
         end;

     AdresaCelula=^Celula;
     Celula=record
                  Info : Arbore;
                   Urm : AdresaCelula
            end;

var  T : Arbore;       { rădăcina }
   Prim,               { primul element din coadă }
 Ultim : AdresaCelula; { ultimul element din coadă }


procedure IntroduInCoada(Q : Arbore);
var R : AdresaCelula;
begin
 new(R);
 R^.Info:=Q;
 R^.Urm:=nil;
 if Prim=nil then begin Prim:=R; Ultim:=R end
          else begin Ultim^.Urm:=R; Ultim:=R end;
end; { IntroduInCoada }

procedure ExtrageDinCoada(var Q : Arbore);
var R : AdresaCelula;
begin
 if Prim=nil then writeln('Coada este vidă')
          else begin
                 R:=Prim;
                 Q:=R^.Info;
                 Prim:=Prim^.Urm;
                 dispose(R);
               end;
end; { ExtrageDinCoada }

procedure CreareArbore(var T : Arbore);
var R, Q : Arbore;
       s : string;
       i : integer;
begin
 T:=nil;                { iniţial arborele este vid }
 Prim:=nil; Ultim:=nil; { iniţial coada este vidă }
 writeln('Daýi rňdňcina: '); readln(s);
 if s<>'' then
    begin
      new(R); { crearea rădăcinii }
      R^.Info:=s;
      T:=R;   { iniţializarea adresei rădăcinii }
      IntroduInCoada(T);
    end;
 while Prim<>nil do  { cît coada nu e vidă }
    begin
      ExtrageDinCoada(R);
      for i:=1 to m do R^.Dsc[i]:=nil;
      writeln('Daţi descendenţii nodului  ', R^.Info);
      i:=1; readln(s);
      while (i<=m) and (s<>'') do
        begin
          new(Q); R^.Dsc[i]:=Q; Q^.Info:=s;
          IntroduInCoada(Q);
          i:=i+1; readln(s);
        end;
 end;
end; { CreareArbore }

procedure AfisareArbore(T : Arbore);
var R : Arbore;
    i : integer;
begin
 if T=nil then writeln('Arbore vid')
    else
      begin
        writeln('Arborele este format din:');
        Prim:=nil; Ultim:=nil;
        IntroduInCoada(T);
        while Prim<>nil do
           begin
             ExtrageDinCoada(R);
             writeln('Nodul ', R^.Info);
             write('  descendenţi: ');
             for i:=1 to m do
               if R^.Dsc[i]<>nil then
                  begin
                     write(R^.Dsc[i]^.Info, ' ');
                     IntroduInCoada(R^.Dsc[i]);
                  end; { then }
             writeln;
           end; { while }
      end; { else }
 readln;
end; { AfisareArbore }

procedure InLatime(T : Arbore);
var R : Arbore;
    i : integer;
begin
 if T<>nil then
    begin
      Prim:=nil; Ultim:=nil;
      IntroduInCoada(T);
      while Prim<>nil do
        begin
          ExtrageDinCoada(R);
          writeln(R^.Info);
          for i:=1 to m do
            if R^.Dsc[i]<>nil then IntroduInCoada(R^.Dsc[i]);
 	end; { while }
      end; { then }
end; { InLatime }

procedure InAdincime(T : Arbore);
var i : integer;
begin
 if T<>nil then
    begin
      writeln(T^.Info);
      for i:=1 to m do InAdincime(T^.Dsc[i]);
    end;
end; { InAdincime }

begin
 CreareArbore(T);
 AfisareArbore(T);
 writeln('Parcurgerea arborelui în lăţime:');
 InLatime(T);
 readln;
 writeln('Parcurgerea arborelui în adîncime:');
 InAdincime(T);
 readln;
end.