labs_solar_system_1.0.0_4f650637/src/adv_170_multiple_inheritance/answers/solar_system.ads

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
-----------------------------------------------------------------------
--                              Ada Labs                             --
--                                                                   --
--                 Copyright (C) 2008-2023, AdaCore                  --
--                                                                   --
-- This program is free software: you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public License as    --
-- published by the Free Software Foundation, either version 3 of    --
-- the License, or (at your option) any later version.               --
--                                                                   --
-- This program is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     --
-- GNU General Public License for more details.                      --
--                                                                   --
-- You should have received a copy of the GNU General Public License --
-- along with this program.  If not, see                             --
-- <https://www.gnu.org/licenses/>.                                  --
-----------------------------------------------------------------------

with Ada.Containers.Bounded_Vectors;

package Solar_System is

   type Orbit_Ref_I is interface;
   function Get_X (O : Orbit_Ref_I) return Float is abstract;
   function Get_Y (O : Orbit_Ref_I) return Float is abstract;

   type Movable_I is interface;
   type Moving_Access_I is access all Movable_I;

   procedure Move (B : in out Movable_I) is abstract;

   type Orbiting_Body_I is interface and Movable_I and Orbit_Ref_I;

   type Orbiting_Body_T is new Orbiting_Body_I with private;

   procedure Move (B : in out Orbiting_Body_T);
   function Create_Orbiting
     (Distance     : Float; Speed : Float; Angle : Float;
      Turns_Around : access Orbit_Ref_I'Class) return access Orbiting_Body_T;

   type Still_Body_I is interface and Orbit_Ref_I;

   type Still_Body_Access_I is access all Still_Body_I;

   type Still_Body_T is new Still_Body_I with private;

   function Create_Still (X : Float; Y : Float) return access Still_Body_T;

   type Solar_System_I is interface and Movable_I;
   procedure Add_Still_Body
     (S : in out Solar_System_I; B : access Still_Body_I'Class) is abstract;
   procedure Add_Moving_Body
     (S : in out Solar_System_I; B : access Movable_I'Class) is abstract;

   type Solar_System_T is new Solar_System_I with private;
   function Create_Solar_System return access Solar_System_T;
   procedure Add_Still_Body
     (S : in out Solar_System_T; B : access Still_Body_I'Class);
   procedure Add_Moving_Body
     (S : in out Solar_System_T; B : access Movable_I'Class);

   procedure Move (S : in out Solar_System_T);

private
   type Body_Base_T is new Orbit_Ref_I with record
      X : Float;
      Y : Float;
   end record;
   function Get_X (O : Body_Base_T) return Float;
   function Get_Y (O : Body_Base_T) return Float;

   type Orbiting_Body_T is new Body_Base_T and Orbiting_Body_I with record
      Distance     : Float;
      Speed        : Float;
      Angle        : Float;
      Turns_Around : access Orbit_Ref_I'Class;
   end record;

   type Still_Body_T is new Body_Base_T and Still_Body_I with null record;

   type Object_Range_T is range 1 .. 100;

   --     package Still_Container is new Ada.Containers.Vectors(Index_Type   => Object_Range_T,
   --                                                           Element_Type => Still_Body_Access_I);
   --     package Orbiting_Container is new Ada.Containers.Vectors(Index_Type   => Object_Range_T,
   --                                                              Element_Type => Moving_Access_I);

   package Still_Container is new Ada.Containers.Bounded_Vectors
     (Index_Type => Object_Range_T, Element_Type => Still_Body_Access_I);
   package Orbiting_Container is new Ada.Containers.Bounded_Vectors
     (Index_Type => Object_Range_T, Element_Type => Moving_Access_I);

   type Solar_System_T is new Solar_System_I with record
      Still_Objects  : Still_Container.Vector (100);
      Moving_Objects : Orbiting_Container.Vector (100);
   end record;

end Solar_System;