-- figure_tagged.ada   shows object oriented use of tagged types

package Fig_Pak is

   type Figure is tagged
      record
         X : Integer;
         Y : Integer;
      end record;
   -- specs. for procs and functions must immediately follow
   function Image(F : Figure) return string ;

   --  The following polymorphisms of "Figure" could appear in a
   -- separate package

   type Circle is new Figure with
      record -- Figure plus radius defines a circle
         r : integer ;
      end record ;

   function Image(F : Circle) return string ;

   type Triangle is new Figure with
      record -- Figure plus two other coordinates define a triangle
         X2 : integer ;
         Y2 : integer ;
         X3 : integer ;
         Y3 : integer ;
      end record ;

   function Image(F : Triangle) return string ;

   type Rectangle is new Figure with
      record -- Figure plus length and width define a rectangle
         L : integer ;
         W : integer ;
      end record ;

   function Image(F : Rectangle) return string ;

end Fig_Pak ;



package body Fig_Pak is

   function Image (F:Figure) return string is
      begin -- Image
      return "Figure" & integer'image(F.x) & integer'image(f.y) ;
      end Image ;

   function Image(F : in     Circle) return String is
      begin -- Image
      return "Circle" & integer'image(F.x) 
              & integer'image(f.y) & integer'image(F.r) ;
      end Image;

   function Image(F : in     Triangle) return String is
      begin -- Image
      return "Triangle" & integer'image(F.x) & integer'image(f.y) 
             & integer'image(F.x2) & integer'image(F.Y2)
             & integer'image(F.x3) & integer'image(F.Y3) ;
      end Image;

   function Image(F : in     Rectangle) return String is
      begin -- Image
      return "Rectangle" & integer'image(F.x) & integer'image(f.y) 
              & integer'image(F.w) & integer'image(F.l) ;
      end Image;

end Fig_Pak ;



with Ada.Text_IO;
with Fig_Pak; use Fig_Pak ;

procedure Fig_Proc is

package Tio renames Ada.Text_Io;
package Iio is new Ada.Text_Io.Integer_Io(Integer);

type F_Point_Type is access Figure'Class ;

F_Ptr : F_Point_Type ;
C     : Circle := (1, 2, 3) ;

   procedure Size_Of (F : in out Figure'Class) is
     X : F_Point_Type ;
     New_F : Figure'Class := F ; -- By assigning a value, the particular type
                                 -- being allocated is determined
   begin -- Size_Of
     X := new Figure'Class'(F) ; -- "new" determine what type to allocate 
                                 -- by the value being assigned
     tio.Put (Image(X.all)) ;    -- dynamically dispatches the correct "Image"
     tio.New_Line ;
   end Size_Of ;

begin -- Fig_Proc

   F_Ptr := new Circle'(1,2,3) ;
   Size_Of (F_Ptr.all) ;
   Tio.Put (Image(F_Ptr.all) ) ;
   Tio.New_Line ;

   F_Ptr := new Figure'(3,4) ;
   Size_Of (F_Ptr.all) ;
   Tio.Put (Image(F_Ptr.all) ) ;
   Tio.New_Line ;

   F_Ptr := new Triangle'(9,8,7,6,5,4) ;
   Size_Of (F_Ptr.all) ;
   Tio.Put (Image(F_Ptr.all) ) ;
   Tio.New_Line ;

   F_Ptr := new Rectangle'(4,5,6,7) ;
   Size_Of (F_Ptr.all) ;
   Tio.Put (Image(F_Ptr.all) ) ;
   Tio.New_Line ;

end Fig_Proc ;

-- Execution results:
-- Circle 1 2 3
-- Circle 1 2 3
-- Figure 3 4
-- Figure 3 4
-- Triangle 9 8 7 6 5 4
-- Triangle 9 8 7 6 5 4
-- Rectangle 4 5 7 6
-- Rectangle 4 5 7 6