--  Program 1   May 2022



--  Magic Moments 

-- This program is identical to that in Programming in Ada 2012
-- except for the added comments.

package Geometry is

   -- This root package declares the abstract type Object
   -- and various operations.  Functions such as Area are
   -- abstract so that a concrete subprogram has to be 
   -- declared for each concrete type derived from Object.
   -- This prevents accidentally inheriting a 'dummy' version
   -- such as might happen if Area for Object simply returned
   -- zero.
   --    Distance should perhaps take a class wide parameter since
   -- it will by its very nature apply unchanged to all types.
   --    The function MI is the Moment of Inertia about the centre
   -- of gravity of the object.  The types must be declared so
   -- that the centre of gravity is always the point with
   -- coordinates (X_Coord, Y_Coord).
   --    Name returns a string and thus is unconstrained.
   -- Set_Col is used for alignment when names are output.

   type Object is abstract tagged
      record
         X_Coord: Float;
         Y_Coord: Float;
      end record;

   function Distance(O: Object) return Float;
   function Area(O: Object) return Float is abstract;
   function MI(O: Object) return Float is abstract;
   function Name(O: Object) return String is abstract;
end;

with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;
package body Geometry is

   function Distance(O: Object) return Float is
      --  Returns distance of object from origin.
   begin
      return Sqrt(O.X_Coord**2 + O.Y_Coord**2);
   end Distance;

end Geometry;

package Geometry.Magic is

   -- The function Moment gives the moment about the origin of the 
   -- force downward due to gravity.  The x-axis is horizontal and
   -- the y-axis is vertical. 
   --    The function MO gives the Moment of Inertia about the
   -- origin.

   function Moment(OC: Object'Class) return Float;
   function MO(OC: Object'Class) return Float;
end;

package body Geometry.Magic is

   function Moment(OC: Object'Class) return Float is
      -- This is class wide since the same formula applies to all
      -- types.  Note that it illustrates both the inheritance of a
      -- component (X_Coord) and an operation (Area).  The call of
      -- Area is a dispatching call.  It is assumed that the units
      -- are such that the Mass equals the Area and that the
      -- acceleration due to gravity (g) is 1.
   begin
      return OC.X_Coord * OC.Area;
   end Moment;

   function MO(OC: Object'Class) return Float is
      -- This is also class wide since again the same formula
      -- applies to all types. 
      --    It uses the so-called parallel axis theorem that the
      -- moment of inertia about another point (here the origin)
      -- equals the sum of the moment of inertia about the centre of
      -- gravity (MI) plus the Mass times the square of the distance
      -- of the centre of gravity from the origin.  Remember that
      -- the units are such that the Mass equals the Area.
      --    The calls of MI, Area and Distance are dispatching calls.
   begin
      return OC.MI + OC.Area * OC.Distance**2;
   end MO;
end Geometry.Magic;

package Geometry.Circles is

   -- A Circle is centred at the point (X_Coord, Y_Coord).

   type Circle is new Object with
      record
         Radius: Float;
      end record;

   function Area(C: Circle) return Float;
   function MI(C: Circle) return Float;
   function Name(C: Circle) return String;
end;

with Ada.Numerics;
package body Geometry.Circles is

   function Area(C: Circle) return Float is
   begin
      return Ada.Numerics.Pi * C.Radius**2;
   end Area;

   function MI(C: Circle) return Float is
   begin
      return 0.5 * C.Area * C.Radius**2;
   end MI;

   function Name(C: Circle) return String is
   begin
      return "Circle";    
   end Name;

end Geometry.Circles;

package Geometry.Points is

   -- A Point is simply an Object with no extent and so has
   -- no additional components. It is not used in this
   -- program but included for illustration.

   type Point is new Object with null record;

   function Area(P: Point) return Float;
   function MI(P: Point) return Float;
   function Name(P: Point) return String;
end;

package body Geometry.Points is

   function Area(P: Point) return Float is
   begin
      return 0.0;
   end Area;

   function MI(P: Point) return Float is
   begin
      return 0.0;
   end MI;

   function Name(P: Point) return String is
   begin
      return "Point";
   end Name;

end Geometry.Points;

package Geometry.Triangles is

   -- The point (X_Coord, Y_Coord) is the centre of gravity of
   -- the Triangle (the centroid).  The three sides have lengths
   -- A, B and C.  The orientation of a triangle is irrelevant
   -- in this program.

   type Triangle is new Object with
      record
         A, B, C: Float;    -- lengths of sides
      end record;

   function Area(T: Triangle) return Float;
   function MI(T: Triangle) return Float;
   function Name(T: Triangle) return String;
end;

with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;
package body Geometry.Triangles is

   function Area(T: Triangle) return Float is
      -- The area is computed using Heron's formula.
      -- S is half the perimeter.

      S: constant Float := 0.5 * (T.A + T.B + T.C);
   begin
      return Sqrt(S * (S - T.A) * (S - T.B) * (S - T.C));
   end Area;

   function MI(T: Triangle) return Float is
      -- This formula is not well known.
   begin
      return T.Area * (T.A**2 + T.B**2 + T.C**2) / 36.0;
   end MI;

   function Name(T: Triangle) return String is
   begin
      return "Triangle";
   end Name;

end Geometry.Triangles;

package Geometry.Squares is

   -- As in the case of a triangle, the orientation of a square
   -- is irrelevant in this program.

   type Square is new Object with
      record
         Side: Float;
      end record;

   function Area(S: Square) return Float;
   function MI(S: Square) return Float;
   function Name(S: Square) return String;
end;

package body Geometry.Squares is

   function Area(S: Square) return Float is
   begin
      return S.Side**2;
   end Area;

   function MI(S: Square) return Float is
   begin
      return S.Area * S.Side**2 / 6.0;
   end MI;

   function Name(S: Square) return String is
   begin
      return "Square";
   end Name;

end Geometry.Squares;


package Geometry.Lists is
   type Pointer is access Object'Class;

   type Cell is
      record
         Next: access Cell;
         Element: Pointer;
      end record;

   type List is access Cell;

   procedure Add_To_List(The_List: in out List;
                         Obj_Ptr: in Pointer);
end;

package body Geometry.Lists is

   procedure Add_To_List(The_List: in out List;
                         Obj_Ptr: in Pointer) is
   begin
      The_List := new Cell'(The_List, Obj_Ptr);
   end Add_To_List;

end Geometry.Lists;

with Geometry.Lists;
package Geometry.IO is

   -- These functions read the values of the coordinates
   -- (which are common to all types derived from Object)
   -- and then values of the specific additional components.
   --    They then create an object of the type with the given
   -- values and return a pointer to it.

   function Get_Circle return Lists.Pointer;
   function Get_Triangle return Lists.Pointer;
   function Get_Square return Lists.Pointer;
end;

with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Float_Text_IO;  use Ada.Float_Text_IO;
with Geometry.Circles;
with Geometry.Triangles;
with Geometry.Squares;
package body Geometry.IO is

   function Get_Circle return Lists.Pointer is
      use Circles;
      X_Coord: Float;
      Y_Coord: Float;
      Radius: Float;
   begin
      Get(X_Coord);
      Get(Y_Coord);
      Get(Radius);
      return new Circle'(X_Coord, Y_Coord, Radius);
   end Get_Circle;

   function Get_Triangle return Lists.Pointer is
      use Triangles;
      X_Coord: Float;
      Y_Coord: Float;
      A, B, C: Float;
   begin
      Get(X_Coord);
      Get(Y_Coord);
      loop
         Get(A);  Get(B);  Get(C);
         -- check to ensure a valid triangle
         exit when A < B+C and B < C+A and C < A+B;
         Put("Sorry, not a triangle, " &
             "enter sides again please");
         New_Line;
      end loop;
      return new Triangle'(X_Coord, Y_Coord, A, B, C);
   end Get_Triangle;

   function Get_Square return Lists.Pointer is
      use Squares;
      X_Coord: Float;
      Y_Coord: Float;
      Side: Float;
   begin
      Get(X_Coord);
      Get(Y_Coord);
      Get(Side);
      return new Square'(X_Coord, Y_Coord, Side);
   end Get_Square;

end Geometry.IO;

with Geometry.Lists;  use Geometry;
with Geometry.IO;  use Geometry.IO;
with Ada.Text_IO;  use Ada.Text_IO;
procedure Build_List(The_List: in out Lists.List) is

   -- Builds a list by calling appropriate get functions and
   -- uses Add_To_List to add them to the partly built list.
   -- The_List is initially null. This could be rewritten as
   -- a function.

   Code_Letter: Character;
   Object_Ptr: Lists.Pointer;
begin
   loop
      loop        -- loop to skip leading spaces
         Get(Code_Letter);
         exit when Code_Letter /= ' ';
      end loop;
      case Code_Letter is
         when 'C' | 'c' =>    -- expect a circle
            Object_Ptr := Get_Circle;
         when 'T' | 't' =>    -- expect a triangle
            Object_Ptr := Get_Triangle;
         when 'S' | 's' =>    -- expect a square
            Object_Ptr := Get_Square;
         when others =>
            exit;
      end case;
      Lists.Add_To_List(The_List, Object_Ptr);
   end loop;
end Build_List;

with Geometry.Lists;  use Geometry.Lists;
with Geometry.Magic;  use Geometry.Magic;
with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Float_Text_IO;  use Ada.Float_Text_IO;
procedure Tabulate_Properties(The_List: List) is

   -- Starts from the beginning of the list and prints the
   -- properties of the various objects.  Note that they come
   -- out in the reverse order to that in which they were read.
   -- We cannot use the prefixed notation for the calls of MO
   -- and Moment because they are class wide and declared in a 
   -- child package and not in the package with the type Object.
   -- We could indeed have declared MO and Moment in the parent 
   -- and so dispensed with the child package Geometry.Magic
   -- but that would have largely removed the justification for
   -- calling the program Magic Moments. (Magic Moments was the 
   -- title of a popular song of the 1950s.)

   Local: access Cell := The_List;
   This_One: Pointer;
begin
   New_Line;
   Put("             X       Y       Area     " &
       "   MI        MO     Moment");
   New_Line;
   while Local /= null loop
      This_One := Local.Element;
      New_Line;
      Put(This_One.Name);     Set_Col(10);
      Put(This_One.X_Coord, 4, 2, 0);  Put(' ');
      Put(This_One.Y_Coord, 4, 2, 0);  Put(' ');
      Put(This_One.Area, 6, 2, 0);     Put(' ');
      Put(This_One.MI, 6, 2, 0);       Put(' ');
      Put(MO(This_One.all), 6, 2, 0);  Put(' ');
      Put(Moment(This_One.all), 6, 2, 0); 
      Local := Local.Next;
   end loop;
end Tabulate_Properties;

with Build_List;
with Tabulate_Properties;
with Geometry.Lists;  use Geometry.Lists;
with Ada.Text_IO;
with Ada.Float_Text_IO;
use Ada;
procedure Magic_Moments is
   The_List: List := null;
begin
   Text_IO.Put("Welcome to Magic Moments");
   Text_IO.New_Line(2);
   Text_IO.Put("Enter C, T or S followed by " &
               "coords and dimensions");
   Text_IO.New_Line;
   Text_IO.Put("Terminate list with any other letter");
   Text_IO.New_Line(2);
   Build_List(The_List);
   Tabulate_Properties(The_List);
   Text_IO.New_Line(2);
   Text_IO.Put_Line("Finished");
   Text_IO.Skip_Line(2);
end Magic_Moments;