1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, July 2011 
  3. -- 
  4.  
  5. package body Swarm_Structures is 
  6.  
  7.    -- 
  8.  
  9.    protected body Vehicle_Comms is 
  10.  
  11.       procedure Send (Message : Inter_Vehicle_Messages) is 
  12.  
  13.       begin 
  14.          Put (Sent_Messages, Message); 
  15.       end Send; 
  16.  
  17.       -- 
  18.  
  19.       procedure Push_Message (Message : Inter_Vehicle_Messages) is 
  20.  
  21.       begin 
  22.          Put (Received_Messages, Message); 
  23.       end Push_Message; 
  24.  
  25.       -- 
  26.  
  27.       procedure Fetch_Message (Message : out Inter_Vehicle_Messages) is 
  28.  
  29.       begin 
  30.          Get (Sent_Messages, Message); 
  31.       end Fetch_Message; 
  32.  
  33.       -- 
  34.  
  35.       function Has_Incoming_Messages return Boolean is 
  36.  
  37.       begin 
  38.          return Element_Available (Received_Messages); 
  39.       end Has_Incoming_Messages; 
  40.  
  41.       -- 
  42.  
  43.       function Has_Outgoing_Messages return Boolean is 
  44.  
  45.       begin 
  46.          return Element_Available (Sent_Messages); 
  47.       end Has_Outgoing_Messages; 
  48.  
  49.       -- 
  50.  
  51.       entry Receive (Message : out Inter_Vehicle_Messages) when Element_Available (Received_Messages) is 
  52.  
  53.       begin 
  54.          Get (Received_Messages, Message); 
  55.       end Receive; 
  56.  
  57.    end Vehicle_Comms; 
  58.  
  59.    -- 
  60.    -- 
  61.    -- 
  62.  
  63.    protected body Vehicle_Controls is 
  64.  
  65.       procedure Set_Steering (V : Vector_3D) is 
  66.  
  67.       begin 
  68.          Steering_Direction := V; 
  69.       end Set_Steering; 
  70.  
  71.       -- 
  72.  
  73.       procedure Set_Throttle (T : Throttle_T) is 
  74.  
  75.       begin 
  76.          Throttle := T; 
  77.       end Set_Throttle; 
  78.  
  79.       -- 
  80.  
  81.       function Read_Steering return Vector_3D is 
  82.  
  83.       begin 
  84.          return Steering_Direction; 
  85.       end Read_Steering; 
  86.  
  87.       -- 
  88.  
  89.       function Read_Throttle return Throttle_T is 
  90.  
  91.       begin 
  92.          return Throttle; 
  93.       end Read_Throttle; 
  94.  
  95.       -- 
  96.  
  97.    end Vehicle_Controls; 
  98.  
  99.    --------- 
  100.    -- "<" -- 
  101.    --------- 
  102.  
  103.    function "<" (L, R : Distance_Entries) return Boolean is 
  104.  
  105.    begin 
  106.       return L.Distance < R.Distance; 
  107.    end "<"; 
  108.  
  109.    -- 
  110.  
  111.    protected body Swarm_Lock is 
  112.  
  113.       entry Lock_Write when not Write_Lock and then Readers = 0 is 
  114.  
  115.       begin 
  116.          Write_Lock := True; 
  117.       end Lock_Write; 
  118.  
  119.       entry Unlock_Write when Write_Lock is 
  120.  
  121.       begin 
  122.          Write_Lock := False; 
  123.       end Unlock_Write; 
  124.  
  125.       entry Lock_Read when not Write_Lock and then Lock_Write'Count = 0 is 
  126.  
  127.       begin 
  128.          Readers := Readers + 1; 
  129.       end Lock_Read; 
  130.  
  131.       entry Unlock_Read when Readers > 0 is 
  132.  
  133.       begin 
  134.          Readers := Readers - 1; 
  135.       end Unlock_Read; 
  136.  
  137.    end Swarm_Lock; 
  138.  
  139.    -- 
  140.  
  141.    protected body Simulator_Tick is 
  142.  
  143.       entry Wait_For_Next_Tick when Trigger is 
  144.  
  145.       begin 
  146.          Trigger := Wait_For_Next_Tick'Count > 0; 
  147.       end Wait_For_Next_Tick; 
  148.  
  149.       procedure Tick is 
  150.  
  151.       begin 
  152.          Trigger := True; 
  153.       end Tick; 
  154.  
  155.    end Simulator_Tick; 
  156.  
  157.    -- 
  158. end Swarm_Structures;