-- Chapter 25 - Programming exercise 2
with Ada.Text_IO, Ada.Integer_Text_IO, Unchecked_Deallocation;
use Ada.Text_IO, Ada.Integer_Text_IO;

procedure CH25_2 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;
         Character_Count : INTEGER;
         Left            : NODE_POINT;
         Right           : NODE_POINT;
      end record;

   pragma CONTROLLED(NODE_POINT);

   procedure Free is new Unchecked_Deallocation(B_TREE_NODE,
                                                      NODE_POINT);

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

   procedure Final_Traverse_List(Start_Node : NODE_POINT) is
   begin
      if Start_Node.Left /= null then
         Final_Traverse_List(Start_Node.Left);
      end if;
      Put(Start_Node.One_Letter);
      Put(" is character");
      Put(Start_Node.Character_Count,3);
      Put_Line(" in the string.");
      if Start_Node.Right /= null then
         Final_Traverse_List(Start_Node.Right);
      end if;
   end Final_Traverse_List;

   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(Char_Count : INTEGER;
                             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
         Temp.Character_Count := Char_Count;
      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(Index,Data_String(Index));
   end loop;

            -- Traverse the list
   New_Line;
   Put_Line("Now for the final traversal of Data_String.");
   Final_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(Index,Test_String(Index));
   end loop;

            -- Traverse the list
   New_Line;
   Put_Line("Now for the final traversal of Test_String.");
   Final_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 CH25_2;




-- 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.
--   is character  5 in the string.
--   is character 11 in the string.
-- A is character 12 in the string.
-- A is character 14 in the string.
-- D is character 13 in the string.
-- T is character  1 in the string.
-- e is character  7 in the string.
-- h is character  2 in the string.
-- i is character  3 in the string.
-- s is character  4 in the string.
-- s is character  8 in the string.
-- s is character 10 in the string.
-- t is character  6 in the string.
-- t is character  9 in the string.

-- 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.
-- B is character  2 in the string.
-- C is character  3 in the string.
-- D is character  1 in the string.
-- F is character  6 in the string.
-- G is character  4 in the string.
-- I is character  5 in the string.