1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Ada.Strings.Hash_Case_Insensitive; 
  10. with Events.Listeners;                  use Events.Listeners; 
  11. with Processes;                         use Processes; 
  12.  
  13. private with Ada.Containers.Doubly_Linked_Lists; 
  14. private with Ada.Containers.Indefinite_Hashed_Maps; 
  15. private with Mutable_Lists; 
  16.  
  17. package Events.Corrals is 
  18.  
  19.     -- An event Corral is an object for Event_Listener objects to register with, 
  20.     -- to receive events. A Corral in turn registers with the global event 
  21.     -- manager to receive the events for which it has registered listeners. All 
  22.     -- listeners attached to a Corral are serviced by the same event dispatching 
  23.     -- thread. Corrals are necessary to allow events to be dispatched from the 
  24.     -- global event manager thread and processed in different Process_Manager 
  25.     -- processes simultaneously. Each Process_Manager (which is backed by a 
  26.     -- single thread), must have its own event Corral. Note that a Corral 
  27.     -- implements the Process interface. It is meant to be attached to a 
  28.     -- Process_Manager and executed incrementally with other Process objects. 
  29.     type Corral is new Limited_Object and Process with private; 
  30.     type A_Corral is access all Corral'Class; 
  31.  
  32.     -- Creates a new corral to receive events from the global event manager. 
  33.     function Create_Corral( name : String ) return A_Corral; 
  34.     pragma Precondition( name'Length > 0 ); 
  35.     pragma Postcondition( Create_Corral'Result /= null ); 
  36.  
  37.     -- Registers an object as a listener for a specific type of event. Listeners 
  38.     -- will receive all events sent to this corral unless the event has been 
  39.     -- consumed by an earlier registered handler that wants to prevent an event 
  40.     -- from propagating. Event listeners are notified in the order in which they 
  41.     -- register with the corral. 
  42.     procedure Add_Listener( this     : not null access Corral'Class; 
  43.                             listener : not null A_Event_Listener; 
  44.                             evtName  : String ); 
  45.     pragma Precondition( evtName'Length > 0 ); 
  46.  
  47.     -- Returns the name of the corral. 
  48.     function Get_Name( this : not null access Corral'Class ) return String; 
  49.     pragma Postcondition( Get_Name'Result'Length > 0 ); 
  50.  
  51.     -- Queue an event to be dispatched to all the registered listener objects. 
  52.     -- The event will be consumed. 
  53.     procedure Queue_Event( this : not null access Corral'Class; 
  54.                            evt  : in out A_Event ); 
  55.     pragma Precondition( evt /= null ); 
  56.     pragma Postcondition( evt = null ); 
  57.  
  58.     -- Unregisters an object as a listener for a specific type of event. If the 
  59.     -- listener was not previously registered, this has no effect. 
  60.     procedure Remove_Listener( this     : not null access Corral'Class; 
  61.                                listener : not null A_Event_Listener; 
  62.                                evtName  : String ); 
  63.     pragma Precondition( evtName'Length > 0 ); 
  64.  
  65.     -- Dispatches an event immediately and sychronously, separate from the 
  66.     -- queue. The Event_Listener that handles the event may choose to return a 
  67.     -- response to the caller via 'response'. The event 'evt' will be consumed. 
  68.     procedure Trigger_Event( this     : not null access Corral'Class; 
  69.                              evt      : in out A_Event; 
  70.                              response : out Response_Type ); 
  71.     pragma Precondition( evt /= null ); 
  72.     pragma Postcondition( evt = null ); 
  73.  
  74.     -- Deletes the Corral. 
  75.     procedure Delete( this : in out A_Corral ); 
  76.     pragma Postcondition( this = null ); 
  77.  
  78. private 
  79.  
  80.     -- A broker acts as a queueable go-between object that brokers the exchange 
  81.     -- between a calling thread and an event dispatching thread. The calling 
  82.     -- thread puts an event into the broker, inserts it into the corral's event 
  83.     -- thread, and waits for the corral's dispatching thread to get around to 
  84.     -- dispatching the event and returning a response via the broker. 
  85.     protected type Broker_Type is 
  86.  
  87.         -- Set's the broker's event, consuming it. If an event has already been 
  88.         -- set, the first event will be preserved and the second event, 'evt' in 
  89.         -- this case, will be ignored and deleted. 
  90.         procedure Put_Event( evt : in out A_Event ); 
  91.         pragma Postcondition( evt = null ); 
  92.  
  93.         -- Retrieves the broker's event. This can only be called once because 
  94.         -- the internal pointer is cleared when the event is returned. The 
  95.         -- returned event, 'evt', belongs to the caller. 
  96.         procedure Take_Event( evt : in out A_Event ); 
  97.         pragma Precondition( evt = null ); 
  98.  
  99.         -- Sets the response to be returned by Get_Response and allows any 
  100.         -- callers waiting on Get_Response to proceed. 
  101.         procedure Set_Response( response : Response_Type ); 
  102.  
  103.         -- Returns the Event_Listeners's response. This will block until 
  104.         -- Set_Response has been called. 
  105.         entry Get_Response( response : out Response_Type ); 
  106.  
  107.     private 
  108.         my_event    : A_Event := null; 
  109.         my_response : Response_Type := No_Response; 
  110.         initialized : Boolean := False; 
  111.         complete    : Boolean := False; 
  112.     end Broker_Type; 
  113.     type A_Broker is access all Broker_Type; 
  114.  
  115.     ---------------------------------------------------------------------------- 
  116.  
  117.     package Broker_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Broker, "=" ); 
  118.     use Broker_Lists; 
  119.  
  120.     package Event_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Event, "=" ); 
  121.     use Event_Lists; 
  122.  
  123.     -- An Event_Queue is a protected FIFO queue of Events. Events can jump to 
  124.     -- the front of the line for synchronous dispatching by being encapsulated 
  125.     -- in a broker object. 
  126.     protected type Event_Queue is 
  127.  
  128.         -- Adds a brokered event to the queue. Brokered events take precedence 
  129.         -- over any other asynchronous events in the queue. 
  130.         procedure Add( broker : A_Broker ); 
  131.  
  132.         -- Adds an event to the end of the queue for asynchronous dispatching. 
  133.         procedure Add( evt : in out A_Event ); 
  134.         pragma Precondition( evt /= null ); 
  135.         pragma Postcondition( evt = null ); 
  136.  
  137.         -- Marks an event frame. All events that were queued prior to this 
  138.         -- marker will be dispatched before the Corral Process returns execution 
  139.         -- to its Process_Manager. Any events added after this point will be 
  140.         -- dispatched in the next Process tick. 
  141.         procedure Mark_Frame; 
  142.  
  143.         -- Removes the first brokered event to be synchronously dispatched. If 
  144.         -- no brokered events are waiting then null will be returned. 
  145.         procedure Remove( broker : out A_Broker ); 
  146.  
  147.         -- Removes the next event on the queue. If the frame marker is reached 
  148.         -- or the queue is begin shutdown, then null will be returned. 
  149.         procedure Remove( evt : out A_Event ); 
  150.  
  151.         -- Shuts down the event queue, deleting all pending events and 
  152.         -- preventing any further from being queued. 
  153.         procedure Shutdown; 
  154.  
  155.     private 
  156.         queue     : Event_Lists.List; 
  157.         brokers   : Broker_Lists.List; 
  158.         remaining : Integer := 0;       -- queued events remaining in the frame 
  159.         stopped   : Boolean := False; 
  160.     end Event_Queue; 
  161.  
  162.     ---------------------------------------------------------------------------- 
  163.  
  164.     package Listener_Lists is new Mutable_Lists( A_Event_Listener, "=" ); 
  165.     use Listener_Lists; 
  166.  
  167.     -- A Listener_List is a list of Event_Listeners which are all registered 
  168.     -- with a Corral for the same Event. 
  169.     type Listener_List is tagged 
  170.         record 
  171.             corral    : A_Corral := null;    -- parent object; not owned 
  172.             name      : Unbounded_String; 
  173.             listeners : Listener_Lists.A_List := new Listener_Lists.List; 
  174.         end record; 
  175.     type A_Listener_List is access all Listener_List'Class; 
  176.  
  177.     -- Call this with the listener list's owning corral and the event name that 
  178.     -- the list is associated with at time of object creation. 
  179.     procedure Construct( this    : access Listener_List; 
  180.                          owner   : not null A_Corral; 
  181.                          evtName : String ); 
  182.  
  183.     ---------------------------------------------------------------------------- 
  184.  
  185.     package Type_Map is new 
  186.         Ada.Containers.Indefinite_Hashed_Maps( String, 
  187.                                                A_Listener_List, 
  188.                                                Ada.Strings.Hash_Case_Insensitive, 
  189.                                                "=", "=" ); 
  190.     use Type_Map; 
  191.  
  192.     -- A Listener_Registry is a protected object that manages a map of event 
  193.     -- names to their corresponding registered Event_Listener lists. 
  194.     protected type Listener_Registry is 
  195.  
  196.         -- Clears all event listener lists in the registry. 
  197.         procedure Clear; 
  198.  
  199.         -- Returns a reference to the list of event listeners for the given 
  200.         -- event name. If no listeners have been registered for the name yet, an 
  201.         -- empty list is returned. The reference to the listener list that is 
  202.         -- returned is owned by the listener registry. Do not delete it. 
  203.         procedure Get_List( evtName : String; list : out A_Listener_List ); 
  204.  
  205.         -- Call this with the listener registry's owning corral at time of 
  206.         -- object creation to initialize/construct the Listener_Registry. 
  207.         procedure Init( owner : not null A_Corral ); 
  208.  
  209.     private 
  210.         corral   : A_Corral := null; 
  211.         registry : Type_Map.Map; 
  212.     end Listener_Registry; 
  213.  
  214.     ---------------------------------------------------------------------------- 
  215.  
  216.     type Corral is new Limited_Object and Process with 
  217.         record 
  218.             name      : Unbounded_String; 
  219.             listeners : access Listener_Registry := null; 
  220.             queue     : access Event_Queue := null; 
  221.         end record; 
  222.  
  223.     procedure Construct( this : access Corral; name : String ); 
  224.  
  225.     procedure Delete( this : in out Corral ); 
  226.  
  227.     -- Returns the name of the Process. 
  228.     function Get_Process_Name( this : access Corral ) return String; 
  229.  
  230.     -- Dispatches one frame of events from the event queue. 
  231.     procedure Tick( this : access Corral; time : Tick_Time ); 
  232.  
  233.     -- Returns a string representation of the Corral. 
  234.     function To_String( this : access Corral ) return String; 
  235.  
  236. end Events.Corrals;