1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, 2013 
  3. -- 
  4.  
  5. with Ada.Containers.Vectors;     use Ada.Containers; 
  6. with Ada.Real_Time;              use Ada.Real_Time; 
  7. with Ada.Task_Identification;    use Ada.Task_Identification; 
  8. with Ada.Unchecked_Deallocation; use Ada; 
  9. with Barrier_Type;               use Barrier_Type; 
  10. with Generic_Protected;                                        pragma Elaborate_All (Generic_Protected); 
  11. with Generic_Realtime_Buffer;                                  pragma Elaborate_All (Generic_Realtime_Buffer); 
  12. with Vectors_3D;                 use Vectors_3D; 
  13. with Rotations;                  use Rotations;                pragma Elaborate_All (Rotations); 
  14. with Swarm_Configuration;        use Swarm_Configuration; 
  15. with Swarm_Structures_Base;      use Swarm_Structures_Base; 
  16. with Vehicle_Message_Type;       use Vehicle_Message_Type; 
  17. with Vehicle_Task_Type;          use Vehicle_Task_Type; 
  18.  
  19. package Swarm_Structures is 
  20.  
  21.    pragma Elaborate_Body; 
  22.  
  23.    No_Of_Buffered_Incoming_Messages : constant Positive := 10; 
  24.    No_Of_Buffered_Outgoing_Messages : constant Positive := 2; 
  25.  
  26.    type Distance_Entries is 
  27.       record 
  28.          Index         : Swarm_Element_Index; 
  29.          Distance      : Distances; 
  30.          Position_Diff : Positions; 
  31.          Velocity_Diff : Velocities; 
  32.       end record; 
  33.  
  34.    pragma Warnings ("H"); -- "<" hides a default operator in package Standard 
  35.    function "<" (L, R : Distance_Entries) return Boolean; 
  36.    pragma Warnings ("h"); 
  37.  
  38.    package Distance_Vectors is new Vectors (Swarm_Element_Index, Distance_Entries); 
  39.  
  40.    package Sort_Distances is new Distance_Vectors.Generic_Sorting; 
  41.  
  42.    type Buffer_Size_Outgoing is mod No_Of_Buffered_Outgoing_Messages; 
  43.    type Buffer_Size_Incoming is mod No_Of_Buffered_Incoming_Messages; 
  44.  
  45.    package Buffers_Outgoing is new Generic_Realtime_Buffer (Inter_Vehicle_Messages, Buffer_Size_Outgoing); 
  46.    package Buffers_Incoming is new Generic_Realtime_Buffer (Inter_Vehicle_Messages, Buffer_Size_Incoming); 
  47.  
  48.    use Buffers_Outgoing; 
  49.    use Buffers_Incoming; 
  50.  
  51.    protected type Vehicle_Comms is 
  52.       procedure Send          (Message :     Inter_Vehicle_Messages); 
  53.       entry     Receive       (Message : out Inter_Vehicle_Messages); 
  54.       procedure Push_Message  (Message :     Inter_Vehicle_Messages); 
  55.       procedure Fetch_Message (Message : out Inter_Vehicle_Messages); 
  56.       function  Has_Incoming_Messages return Boolean; 
  57.       function  Has_Outgoing_Messages return Boolean; 
  58.    private 
  59.       Sent_Messages     : Buffers_Outgoing.Realtime_Buffer; 
  60.       Received_Messages : Buffers_Incoming.Realtime_Buffer; 
  61.    end Vehicle_Comms; 
  62.  
  63.    protected type Vehicle_Controls is 
  64.       procedure Set_Steering (V : Vector_3D); 
  65.       procedure Set_Throttle (T : Throttle_T); 
  66.       function Read_Steering return Vector_3D; 
  67.       function Read_Throttle return Throttle_T; 
  68.    private 
  69.       Steering_Direction : Vector_3D  := Zero_Vector_3D; 
  70.       Throttle           : Throttle_T := Idle_Throttle; 
  71.    end Vehicle_Controls; 
  72.  
  73.    type Globes_Touched_A is array (Energy_Globes_Defaults'Range) of Boolean; 
  74.  
  75.    No_Globes_Touched : constant Globes_Touched_A := (others => False); 
  76.  
  77.    package Protected_Time is new Generic_Protected (Time, Time_First); 
  78.  
  79.    type Charge_Info is record 
  80.       Level          : Vehicle_Charges;            pragma Atomic (Level); 
  81.       Charge_Time    : Protected_Time.Monitor_Ptr; 
  82.       Charge_No      : Natural;                    pragma Atomic (Charge_No); 
  83.       Globes_Touched : Globes_Touched_A := No_Globes_Touched; 
  84.    end record; 
  85.  
  86.    type Neighbours_P       is access all Distance_Vectors.Vector; 
  87.    type Vehicle_Comms_P    is access all Vehicle_Comms; 
  88.    type Vehicle_Controls_P is access all Vehicle_Controls; 
  89.    type Vehicle_Task_P     is access all Vehicle_Task; 
  90.  
  91.    package Protected_Rotation is new Generic_Protected (Quaternion_Rotation, Zero_Rotation); 
  92.  
  93.    type Swarm_Element_State is 
  94.       record 
  95.          Position      : Protected_Point_3D.Monitor_Ptr; 
  96.          Rotation      : Protected_Rotation.Monitor_Ptr; 
  97.          Velocity      : Protected_Vector_3D.Monitor_Ptr; 
  98.          Acceleration  : Protected_Vector_3D.Monitor_Ptr; 
  99.          Charge        : Charge_Info; 
  100.          Neighbours    : Neighbours_P; 
  101.          Controls      : Vehicle_Controls_P; 
  102.          Comms         : Vehicle_Comms_P; 
  103.          Process       : Vehicle_Task_P; 
  104.          Process_abort : Barrier_Ptr; 
  105.          Process_Id    : Task_Id; 
  106.          Vehicle_Id    : Positive; 
  107.          Last_Update   : Time; 
  108.       end record; 
  109.  
  110.    package Swarm_Vectors is new Vectors (Swarm_Element_Index, Swarm_Element_State); 
  111.  
  112.    procedure Free_Neighbours is new Unchecked_Deallocation (Object => Distance_Vectors.Vector, Name => Neighbours_P); 
  113.    procedure Free_Controls   is new Unchecked_Deallocation (Object => Vehicle_Controls,        Name => Vehicle_Controls_P); 
  114.    procedure Free_Comms      is new Unchecked_Deallocation (Object => Vehicle_Comms,           Name => Vehicle_Comms_P); 
  115.    procedure Free_Process    is new Unchecked_Deallocation (Object => Vehicle_Task,            Name => Vehicle_Task_P); 
  116.  
  117.    protected Simulator_Tick is 
  118.       entry Wait_For_Next_Tick; 
  119.       procedure Tick; 
  120.    private 
  121.       Trigger : Boolean := False; 
  122.    end Simulator_Tick; 
  123.  
  124. end Swarm_Structures;