-- Chapter 25 - Program 3
with Ada.Text_IO, Unchecked_Deallocation;
use Ada.Text_IO;

procedure BTree is

   Test_String : constant STRING := "DBCGIF";
   Data_String : constant STRING := "This tests ADA";

   type B_TREE_NODE;                 -- Incomplete declaration

   type NODE_POINT is access B_TREE_NODE;

   type B_TREE_NODE is               -- Complete declaration
      record
         One_Letter : CHARACTER;
         Left       : NODE_POINT;
         Right      : NODE_POINT;
      end record;

   procedure Free is new Unchecked_Deallocation(B_TREE_NODE,
                                                      NODE_POINT);

   pragma Controlled(NODE_POINT);

   Root  : NODE_POINT;    -- Always points to the root of the tree

   procedure Traverse_List(Start_Node : NODE_POINT) is
   begin
      if Start_Node.Left /= null then
         Traverse_List(Start_Node.Left);
      end if;
      Put(Start_Node.One_Letter);
      if Start_Node.Right /= null then
         Traverse_List(Start_Node.Right);
      end if;
   end Traverse_List;

   procedure Store_Character(In_Char : CHARACTER) is
   Temp : NODE_POINT;

      procedure Locate_And_Store(Begin_Node : in out NODE_POINT) is
      begin
         if In_Char < Begin_Node.One_Letter then
            if Begin_Node.Left = null then
               Begin_Node.Left := Temp;
            else
               Locate_And_Store(Begin_Node.Left);
            end if;
         else
            if Begin_Node.Right = null then
               Begin_Node.Right := Temp;
            else
               Locate_And_Store(Begin_Node.Right);
            end if;
         end if;
      end Locate_And_Store;

   begin
      Temp := new B_TREE_NODE;
         Temp.One_Letter := In_Char; -- New record is now defined
                                     -- The system sets Next_Rec
                                     -- to the value of null
      if Root = null then
         Root := Temp;
      else
         Locate_And_Store(Root);
      end if;
      Put("Ready to traverse list. --->");
      Traverse_List(Root);
      New_Line;
   end Store_Character;

begin
            -- Store the characters in Data_String in a Binary Tree
   for Index in Data_String'RANGE loop
      Store_Character(Data_String(Index));
   end loop;

            -- Traverse the list
   New_Line;
   Put_Line("Now for the final traversal of Data_String.");
   Put("Ready to traverse list. --->");
   Traverse_List(Root);
   New_Line(2);

   Root := null;    -- Needed to clear out the last tree

            -- Store the characters in Test_String in a Binary Tree
   for Index in Test_String'RANGE loop
      Store_Character(Test_String(Index));
   end loop;

            -- Traverse the list
   New_Line;
   Put_Line("Now for the final traversal of Test_String.");
   Put("Ready to traverse list. --->");
   Traverse_List(Root);
   New_Line;

            -- Now deallocate the tree
   declare
      procedure Free_Up(Current_Node : in out NODE_POINT) is
      begin
         if Current_Node.Left /= null then
            Free_Up(Current_Node.Left);
         end if;
         if Current_Node.Right /= null then
            Free_Up(Current_Node.Right);
         end if;
         Free(Current_Node);
      end Free_Up;
   begin
      if Root /= null then
         Free_Up(Root);
      end if;
   end;

end BTree;




-- Result of execution
--
-- Ready to traverse list. --->T
-- Ready to traverse list. --->Th
-- Ready to traverse list. --->Thi
-- Ready to traverse list. --->This
-- Ready to traverse list. ---> This
-- Ready to traverse list. ---> Thist
-- Ready to traverse list. ---> Tehist
-- Ready to traverse list. ---> Tehisst
-- Ready to traverse list. ---> Tehisstt
-- Ready to traverse list. ---> Tehissstt
-- Ready to traverse list. --->  Tehissstt
-- Ready to traverse list. --->  ATehissstt
-- Ready to traverse list. --->  ADTehissstt
-- Ready to traverse list. --->  AADTehissstt
--
-- Now for the final traversal of Data_String.
-- Ready to traverse list. --->  AADTehissstt

-- Ready to traverse list. --->D
-- Ready to traverse list. --->BD
-- Ready to traverse list. --->BCD
-- Ready to traverse list. --->BCDG
-- Ready to traverse list. --->BCDGI
-- Ready to traverse list. --->BCDFGI

-- Now for the final traversal of Test_String.
-- Ready to traverse list. --->BCDFGI