http://www.adaconcept.com/programs/fabejarasok.adb
--Rotter Gyorgy
--binaris fa, (es bejarasainak) megvalositasa mutatokkal + felszabaditas


with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Unchecked_Deallocation;                                     --ezzel a sablon eljarassal tudjuk a kezunkbe venni a dinamikus valamik felszabaditasat

use Ada.Text_IO;
use Ada.Integer_Text_IO;


procedure fabejarasok is

   type CsucsTipus;                                                  --| trukk,  ilyet igy lehet csinalni ("kolcsonosen egymasra hivatkozas")
   type FaTipus is access CsucsTipus;     --M_CsucsTipus             --|
   type CsucsTipus is record                                         --|
      ertek:  Integer;                                               --|
      bal:  FaTipus;                                                 --|
      jobb: FaTipus;                                                 --|
   end record;                                                       --|

   type TombTipus is array (Integer range <>) of Integer;            --az ertek-eknek...


   procedure Felszabadit is new Ada.Unchecked_Deallocation(CsucsTipus,FaTipus);--igy peldanyosithatjuk a sajat mutatott-tipus (bazistipus), es mutato-tipus tipusainkkal a sajat felszabadito eljarasunkat
                                                        --(mire mutat,mi mutat)

   procedure PreorderBejaras (f: FaTipus) is
   begin
      if (f/=null) then
           Put (f.ertek);                                            --| elvegzendo muvelet
           New_Line;                                                 --|
         PreorderBejaras (f.bal);
         PreorderBejaras (f.jobb);
      end if;
   end PreorderBejaras;

   procedure InorderBejaras (f:FaTipus) is
   begin
      if (f/=null) then
         InorderBejaras (f.bal);
           Put (f.ertek);                                            --| elvegzendo muvelet
           New_Line;                                                 --|
         InorderBejaras (f.jobb);
      end if;
   end InorderBejaras;

   procedure PostorderBejarasFelszabaditassal (f: in out FaTipus) is
   begin
      if (f/=null) then
         PostorderBejarasFelszabaditassal(f.bal);
         PostorderBejarasFelszabaditassal(f.jobb);
           Put (f.ertek);                                            --| elvegzendo muvelet
           New_Line;                                                 --|
         Felszabadit(f);
      end if;
   end PostorderBejarasFelszabaditassal;

   procedure Beszuras(be: Integer; f: in out FaTipus) is
   begin
      if f=null then
         f:= new CsucsTipus'(be, null, null);
      elsif be<f.ertek then
         Beszuras(be, f.bal);
      else
         Beszuras(be, f.jobb);
      end if;
   end Beszuras;



   procedure Beszuras(A: TombTipus; f: in out FaTipus) is            --feluldefinialas/tulterheles!!! (az elozo integer-t kapott ez TombTipus-t)
   begin
      for I in A'Range loop
         Beszuras(A(I), f);                                          --a tipus miatt tudja a fordito, hogy mit kell meghivni
      end loop;
   end Beszuras;

   fa: FaTipus := null;                                               --ures fa
   bemenet: constant TombTipus := (4,5,2,1,3);

   --igy fog kinezni:
   --
   --                  4                       =>  preorder:  4,2,1,3,5
   --                 / \
   --                2   5                     =>  inorder:   1,2,3,4,5
   --               / \
   --              1   3                       =>  postorder: 1,3,2,5,4
   --



begin

   Beszuras(bemenet, fa);
   put_line("Preorder bejaras");
   PreorderBejaras (fa);
   new_line;
   put_line("Inorder bejaras (figyeld a szamokat!!! :))");
   InorderBejaras (fa);
   new_line;
   put_line("Postorder bejaras");
   PostorderBejarasFelszabaditassal(fa);

end fabejarasok;