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