1. with Ada.Strings.Hash_Case_Insensitive; 
  2. with Events.Listeners;                  use Events.Listeners; 
  3. with Processes;                         use Processes; 
  4.  
  5. private with Ada.Containers.Doubly_Linked_Lists; 
  6. private with Ada.Containers.Indefinite_Hashed_Maps; 
  7. private with Mutable_Lists; 
  8.  
  9. package Events.Corrals is 
  10.  
  11.     type Corral is new Object and Process with private; 
  12.     type A_Corral is access all Corral'Class; 
  13.  
  14.     -- Creates a new corral to receive events from the global event manager. 
  15.     function Create_Corral( name : String ) return A_Corral; 
  16.     pragma Precondition( name'Length > 0 ); 
  17.     pragma Postcondition( Create_Corral'Result /= null ); 
  18.  
  19.     -- Registers an object as a listener for a specific type of event. Listeners 
  20.     -- will receive all events sent to this corral unless the event has been 
  21.     -- consumed by an earlier registered handler that wants to prevent an event 
  22.     -- from propagating. Event listeners are notified in the order in which they 
  23.     -- register with the corral. 
  24.     procedure Add_Listener( this     : access Corral; 
  25.                             listener : not null A_Event_Listener; 
  26.                             evtName  : String ); 
  27.     pragma Precondition( evtName'Length > 0 ); 
  28.  
  29.     -- Returns the name of the corral. 
  30.     function Get_Name( this : access Corral ) return String; 
  31.     pragma Postcondition( Get_Name'Result'Length > 0 ); 
  32.  
  33.     -- Queue an event to be dispatched to all the registered listener objects. 
  34.     -- The event will be consumed. 
  35.     procedure Queue_Event( this : access Corral; evt : in out A_Event ); 
  36.     pragma Precondition( evt /= null ); 
  37.     pragma Postcondition( evt = null ); 
  38.  
  39.     -- Unregisters an object as a listener for a specific type of event. If the 
  40.     -- listener was not previously registered, this has no effect. 
  41.     procedure Remove_Listener( this     : access Corral; 
  42.                                listener : not null A_Event_Listener; 
  43.                                evtName  : String ); 
  44.     pragma Precondition( evtName'Length > 0 ); 
  45.  
  46.     -- Dispatches an event immediately, separate from the queue. The event will 
  47.     -- be consumed. 
  48.     procedure Trigger_Event( this     : access Corral; 
  49.                              evt      : in out A_Event; 
  50.                              response : out Response_Type ); 
  51.     pragma Precondition( evt /= null ); 
  52.     pragma Postcondition( evt = null ); 
  53.  
  54.     -- Deletes the corral. 
  55.     procedure Delete( this : in out A_Corral ); 
  56.     pragma Postcondition( this = null ); 
  57.  
  58. private 
  59.  
  60.     -- A broker acts as a queueable go-between object that brokers the exchange 
  61.     -- between a calling thread and an event dispatching thread. The calling 
  62.     -- thread puts an event into the broker, inserts it into the corral's event 
  63.     -- thread, and waits for the corral's dispatching thread to get around to 
  64.     -- dispatching the event and returning a response via the broker. 
  65.     protected type Broker_Type is 
  66.  
  67.         -- Consumes the event. However, if an event has already been set, the 
  68.         -- first event will be preserved and the second event pass will be 
  69.         -- ignored and deleted. 
  70.         procedure Put_Event( evt : in out A_Event ); 
  71.         pragma Postcondition( evt = null ); 
  72.  
  73.         -- This can only be called once because the internal pointer is cleared 
  74.         -- when the event is returned. The returned event belongs to the caller. 
  75.         procedure Take_Event( evt : in out A_Event ); 
  76.         pragma Precondition( evt = null ); 
  77.  
  78.         -- Sets the response to be returned by Get_Response and allows any 
  79.         -- callers waiting on Get_Response to proceed. 
  80.         procedure Set_Response( response : Response_Type ); 
  81.  
  82.         -- Returns the event's response. This will block until Set_Response has 
  83.         -- been called. 
  84.         entry Get_Response( response : out Response_Type ); 
  85.  
  86.     private 
  87.         my_event    : A_Event := null; 
  88.         my_response : Response_Type := No_Response; 
  89.         initialized : Boolean := False; 
  90.         complete    : Boolean := False; 
  91.     end Broker_Type; 
  92.     type A_Broker is access all Broker_Type; 
  93.  
  94.     procedure Create_Broker( evt : in out A_Event; broker : out A_Broker ); 
  95.     pragma Precondition( evt /= null ); 
  96.     pragma Postcondition( evt = null ); 
  97.     pragma Postcondition( broker /= null ); 
  98.  
  99.     procedure Delete( broker : in out A_Broker ); 
  100.     pragma Postcondition( broker = null ); 
  101.  
  102.     ---------------------------------------------------------------------------- 
  103.  
  104.     package Broker_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Broker, "=" ); 
  105.     use Broker_Lists; 
  106.  
  107.     package Event_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Event, "=" ); 
  108.     use Event_Lists; 
  109.  
  110.     protected type Event_Queue is 
  111.  
  112.         procedure Add( broker : A_Broker ); 
  113.  
  114.         procedure Add( evt : in out A_Event ); 
  115.         pragma Precondition( evt /= null ); 
  116.         pragma Postcondition( evt = null ); 
  117.  
  118.         procedure Mark_Frame; 
  119.  
  120.         -- Returns null when queue is being shut down. 
  121.         procedure Remove( broker : out A_Broker ); 
  122.  
  123.         -- Returns null when queue is being shut down. 
  124.         procedure Remove( evt : out A_Event ); 
  125.  
  126.         procedure Shutdown; 
  127.  
  128.     private 
  129.         queue     : Event_Lists.List; 
  130.         brokers   : Broker_Lists.List; 
  131.         remaining : Integer := 0;       -- queued events remaining in the frame 
  132.         stopped   : Boolean := False; 
  133.     end Event_Queue; 
  134.  
  135.     ---------------------------------------------------------------------------- 
  136.  
  137.     package Listener_Lists is new Mutable_Lists( A_Event_Listener, "=" ); 
  138.     use Listener_Lists; 
  139.  
  140.     type Listener_List is tagged 
  141.         record 
  142.             corral    : A_Corral := null; 
  143.             name      : Unbounded_String; 
  144.             listeners : access Listener_Lists.List := new Listener_Lists.List; 
  145.         end record; 
  146.     type A_Listener_List is access all Listener_List; 
  147.  
  148.     -- Adds the listener to the list and registers the list's corral with 
  149.     -- the event manager if the list was empty. 
  150.     procedure Add( this     : access Listener_List; 
  151.                    listener : not null A_Event_Listener ); 
  152.  
  153.     -- Synchronously notifies each listener in the list until the event is 
  154.     -- consumed. The response is returned from the last event listener to 
  155.     -- be notified, or contains error information if an exception was 
  156.     -- raised by the last listener to be notified. 
  157.     procedure Call( this     : access Listener_List; 
  158.                     evt      : in out A_Event; 
  159.                     response : out Response_Type ); 
  160.  
  161.     -- Clears the listener list and unregisters the list's corral with the 
  162.     -- event manager. 
  163.     procedure Clear( this : access Listener_List ); 
  164.  
  165.     -- Call this with the listener list's owning corral and the event name that 
  166.     -- the list is associated with at time of object creation. 
  167.     procedure Construct( this    : access Listener_List; 
  168.                          owner   : not null A_Corral; 
  169.                          evtName : String ); 
  170.  
  171.     -- Removes the listener from the list and unregisters the list's corral 
  172.     -- with the event manager if the list is now empty. 
  173.     procedure Remove( this     : access Listener_List; 
  174.                       listener : not null A_Event_Listener ); 
  175.  
  176.     ---------------------------------------------------------------------------- 
  177.  
  178.     package Type_Map is new 
  179.         Ada.Containers.Indefinite_Hashed_Maps( String, 
  180.                                                A_Listener_List, 
  181.                                                Ada.Strings.Hash_Case_Insensitive, 
  182.                                                "=", "=" ); 
  183.     use Type_Map; 
  184.  
  185.     protected type Listener_Registry is 
  186.  
  187.         -- Clears all event listener lists in the registry. 
  188.         procedure Clear; 
  189.  
  190.         -- Returns a reference to the list of event listeners for the given 
  191.         -- event name. If no listeners have been registered for the name yet, an 
  192.         -- empty list is returned. The reference to the listener list that is 
  193.         -- returned is owned by the listener registry. Do not delete it. 
  194.         procedure Get_List( evtName : String; list : out A_Listener_List ); 
  195.  
  196.         -- Call this with the listener registry's owning corral at time of 
  197.         -- object creation. 
  198.         procedure Init( owner : not null A_Corral ); 
  199.  
  200.     private 
  201.         corral   : A_Corral := null; 
  202.         registry : Type_Map.Map; 
  203.     end Listener_Registry; 
  204.  
  205.     ---------------------------------------------------------------------------- 
  206.  
  207.     type Corral is new Object and Process with 
  208.         record 
  209.             name      : Unbounded_String; 
  210.             listeners : access Listener_Registry := new Listener_Registry; 
  211.             queue     : access Event_Queue := new Event_Queue; 
  212.         end record; 
  213.  
  214.     -- Raises COPY_NOT_ALLOWED. 
  215.     procedure Adjust( this : access Corral ); 
  216.  
  217.     procedure Construct( this : access Corral; name : String ); 
  218.  
  219.     procedure Delete( this : in out Corral ); 
  220.  
  221.     function Get_Process_Name( this : access Corral ) return String; 
  222.  
  223.     procedure Tick( this : access Corral; upTime, dt : Time_Span ); 
  224.  
  225.     function To_String( this : access Corral ) return String; 
  226.  
  227. end Events.Corrals;