-- Chapter 23 - Program 1
with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Float_Text_IO;

package Conveyance4 is 

   -- A very simple transportation record.
   type TRANSPORT is tagged private;

   procedure Set_Values(Vehicle_In : in out TRANSPORT; 
                        Wheels_In  : INTEGER; 
                        Weight_In  : FLOAT);
   function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER;
   function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT;


   -- Extend TRANSPORT to a CAR type.
   type CAR is new TRANSPORT with private;

   procedure Set_Values(Vehicle_In : in out CAR; 
                        Passenger_Count_In : INTEGER);
   function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER;


   -- Extend TRANSPORT to a TRUCK type.
   type TRUCK is new TRANSPORT with private;

   procedure Set_Values(Vehicle_In : in out TRUCK; 
                        Wheels_In : INTEGER;  
                        Weight_In : FLOAT; 
                        Passenger_Count_In : INTEGER; 
                        Payload_In : FLOAT);

   function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER;


   -- Derive an identical type for BICYCLE.
   type BICYCLE is new TRANSPORT with private;


      -- Print_Values is a class-wide operation. It can accept objects
      --  of any type within the TRANSPORT heirarchy.
   procedure Print_Values(Any_Vehicle : TRANSPORT'Class);

private

   type TRANSPORT is tagged
      record
         Wheels : INTEGER;
         Weight : FLOAT;
      end record;

   type CAR is new TRANSPORT with
      record
         Passenger_Count : INTEGER;
      end record;

   type TRUCK is new TRANSPORT with
      record
         Passenger_Count : INTEGER;
         Payload         : FLOAT;
      end record;

   type BICYCLE is new TRANSPORT with null record;

end Conveyance4;



package body Conveyance4 is

-- Subprograms for the TRANSPORT record
procedure Set_Values(Vehicle_In : in out TRANSPORT; 
                     Wheels_In : INTEGER; 
                     Weight_In : FLOAT) is
begin
   Vehicle_In.Wheels := Wheels_In;
   Vehicle_In.Weight := Weight_In;
end Set_Values;


function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER is
begin
   return Vehicle_In.Wheels;
end Get_Wheels;


function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT is
begin
   return Vehicle_In.Weight;
end Get_Weight;


-- Subprograms for the CAR record
procedure Set_Values(Vehicle_In : in out CAR; 
                     Passenger_Count_In : INTEGER) is
begin
   Vehicle_In.Passenger_Count := Passenger_Count_In;
end Set_Values;


function Get_Passenger_Count(Vehicle_In : CAR) return INTEGER is
begin
   return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;


-- Subprograms for the TRUCK record
procedure Set_Values(Vehicle_In : in out TRUCK; 
                     Wheels_In : INTEGER; 
                     Weight_In : FLOAT; 
                     Passenger_Count_In : INTEGER; 
                     Payload_In : FLOAT) is
begin
      -- This is one way to set the values in the base class
   Vehicle_In.Wheels := Wheels_In;
   Vehicle_In.Weight := Weight_In;

      -- This is another way to set the values in the base class
   Set_Values(TRANSPORT(Vehicle_In), Wheels_In, Weight_In);

      -- This sets the values in this class
   Vehicle_In.Passenger_Count := Passenger_Count_In;
   Vehicle_In.Payload := Payload_In;
end Set_Values;


function Get_Passenger_Count(Vehicle_In : TRUCK) return INTEGER is
begin
   return Vehicle_In.Passenger_Count;
end Get_Passenger_Count;


-- Print_Values is a class-wide operation. It can accept objects
--  of any type within the TRANSPORTheirarchy.
procedure Print_Values(Any_Vehicle : TRANSPORT'Class) is
begin
   Put("This vehicle has");
   Put(Any_Vehicle.Wheels, 2);
   Put(" wheels, and weighs");
   Put(Any_Vehicle.Weight, 5, 1, 0);
   Put(" pounds.");
   New_Line;

-- The following line of code will produce an error because TRANSPORT
--  and BICYCLE do not contain this variable.
-- Put(Any_Vehicle.Passenger_Count, 5);

end Print_Values;

end Conveyance4;



-- Result of execution
--
-- (This program cannot be executed alone.)