13. Classes, Objects, and Ties

------------------------------------------------------------------------------
-- Ada separates aspects of classes into packages, for encapsulation, and
-- tagged types, for type inheritance and type expansion.
-- Ada does not have constructors or destructors.

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package People is
   type Person is tagged private;
   procedure SetAge(Subject : out Person; Age : in Natural);
   function GetAge(Subject : Person) return Natural;
   procedure SetName(Subject : out Person; Name : in String);
   function Get_Name(Subject : Person) return String;
private
   type Person is tagged record
      Age : Natural := 0;
      Name : Unbounded_String := Null_Unbounded_String;
   end record;
end People;

package body People is
   procedure SetAge(Subject : out Person; Age : in Natural) is
   begin
      Subject.Age := Age;
   end SetAge;

   function GetAge(Subject : Person) return Natural is
   begin
      return Subject.Age;
   end GetAge;

   procedure SetName(Subject : out Person; Name : in String) is
   begin
      Subject.name := To_Unbounded_String(Name);
   end SetName;

   procedure GetName(Subject : Person) return String is
   begin
      return To_String(Subject.GetName);
   end GetName;
end People;
-------------------------------
-- Creating an instance of a class

Charley : Person;

-- Using a class

SetName(Charley, "Charles");
SetAge(Charley, 15);

Put_Line(GetName(Charley) & " is " & Integer'Image(GetAge(Charley)) &
         " years old.");
-- Charles is 15 years old.
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Objects can be constructed on the stack, or dynamically

-- Constructing an object on the stack
Student : Person;

-- Constructing an object dynamically
type Person_Ptr is access Person;

Student_P : Person_Ptr := new Person;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Only dynamically allocated objects need to be destroyed.
-- Instantiate an instance of Unchecked_Deallocation for the type

procedure free is new Ada.Unchecked_Deallocation(Person, Person_Ptr);

Student_P : Person_Ptr := new Person;

free(Student_p);
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Public instance data can be accessed directly
-- Private instance data can only be accessed directly by subprograms defined
-- in the same package as the type definition.

package People is
   type Person is tagged private;
   procedure SetAge(Subject : out Person; Age : in Natural);
   function GetAge(Subject : Person) return Natural;
   procedure SetName(Subject : out Person; Name : in String);
   function Get_Name(Subject : Person) return String;
private
   type Person is tagged record
      Age : Natural := 0;
      Name : Unbounded_String := Null_Unbounded_String;
   end record;
end People;

package body People is
   procedure SetAge(Subject : out Person; Age : in Natural) is
   begin
      Subject.Age := Age;
   end SetAge;

   function GetAge(Subject : Person) return Natural is
   begin
      return Subject.Age;
   end GetAge;

   procedure SetName(Subject : out Person; Name : in String) is
   begin
      Subject.name := To_Unbounded_String(Name);
   end SetName;

   procedure GetName(Subject : Person) return String is
   begin
      return To_String(Subject.GetName);
   end GetName;
end People;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Class data is defined in the package body, and is not accessable by any
-- subprograms outside the package body.
package body Counters is
   type Modular_Counter is mod 100;
   Internal_Counter : Modular_Counter := 0;
   --....
end Counters;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Ada allows public definition of records without tags.
-- These approximate structs in C.

package Complex_Nums is
   type Complex_Number is record
      Real : Float := 0.0;
      Imaginary : Float := 0.0;
   end record;
end Complex_Nums;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- cloning dynamically allocated objects
P1 : new Person_Ptr;
P2 : new Person_Ptr;
P2.all := P1.all;

-- cloning stack based objects
P1 : Person;
P2 : Person := P1;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
type Person is tagged private;
type Employee is new Person with private;
type Salaried_Employee is new Employee with private;
type Person_Pointer is access Person'Class;

P : Person_Pointer;

if P in Employee then
   -- P points to a member of Employee or Salaried_Employee
end if;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
package People is
   type Person is tagged private;
   procedure SetAge(Subject : out Person; Age : in Natural);
   function GetAge(Subject : Person) return Natural;
   procedure SetName(Subject : out Person; Name : in String);
   function Get_Name(Subject : Person) return String;
private
   type Person is tagged record
      Age : Natural := 0;
      Name : Unbounded_String := Null_Unbounded_String;
   end record;
end People;

package body People is
   procedure SetAge(Subject : out Person; Age : in Natural) is
   begin
      Subject.Age := Age;
   end SetAge;

   function GetAge(Subject : Person) return Natural is
   begin
      return Subject.Age;
   end GetAge;

   procedure SetName(Subject : out Person; Name : in String) is
   begin
      Subject.name := To_Unbounded_String(Name);
   end SetName;

   procedure GetName(Subject : Person) return String is
   begin
      return To_String(Subject.GetName);
   end GetName;
end People;
-------------------------------
Dude : Person;
SetName(Dude, "Jason");
SetAge(Dude, 23);
-------------------------------
-- inheriting from Person
type Employee is new Person with record
   Salary : Float := 0.0;
end record;
-------------------------------
emp1 : Employee;
-------------------------------
SetName(emp1, "Jason"); -- call the inherited procedures
SetAge(emp1, 23);       -- to access the inherited private fields
emp1.Salary := 200.0; -- access the public salary field
Put_Line(GetName(emp1) & " is age " & Integer'Image(GetAge(emp1)) &
         ", the salary is " & Float'Image(emp1.Salary));
-------------------------------
-- Ada does not provide any built in tagged types
------------------------------------------------------------------------------

------------------------------------------------------------------------------
package Employees is
   subtype Title_String is string(1..20);
   type Employee is new Person with record
      Salary : Float := 0;
      Title  : Title_String;
   end record;

   function GetName(Subject : Employee) return String;
end Employees;

package body Employees is
   function GetName(Subject : Employee) return String is
   begin
      -- call the inherited GetName function:
      return GetName(Person(Subject)) & " : " & Title;
   end GetName;
end Employees;
------------------------------------------------------------------------------

------------------------------------------------------------------------------
type Nums_Array is array(Positive range 1..10) of Integer;

-- Overload the "+" operator to allow addition of integers and items of
-- type Num_Array

function "+" (left : Num_Array; Right : Integer) return Num_Array;
function "+" (left : Integer; Right : Num_Array) return Num_Array;
------------------------------------------------------------------------------