with Ada.Strings.Hash_Case_Insensitive;
with Events.Listeners; use Events.Listeners;
with Processes; use Processes;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Mutable_Lists;
package Events.Corrals is
-- An event Corral is an object for Event_Listener objects to register with,
-- to receive events. A Corral in turn registers with the global event
-- manager to receive the events for which it has registered listeners. All
-- listeners attached to a Corral are serviced by the same event dispatching
-- thread. Corrals are necessary to allow events to be dispatched from the
-- global event manager thread and processed in different Process_Manager
-- processes simultaneously. Each Process_Manager (which is backed by a
-- single thread), must have its own event Corral. Note that a Corral
-- implements the Process interface. It is meant to be attached to a
-- Process_Manager and executed incrementally with other Process objects.
type Corral is new Limited_Object and Process with private;
type A_Corral is access all Corral'Class;
-- Creates a new corral to receive events from the global event manager.
function Create_Corral( name : String ) return A_Corral;
pragma Precondition( name'Length > 0 );
pragma Postcondition( Create_Corral'Result /= null );
-- Registers an object as a listener for a specific type of event. Listeners
-- will receive all events sent to this corral unless the event has been
-- consumed by an earlier registered handler that wants to prevent an event
-- from propagating. Event listeners are notified in the order in which they
-- register with the corral.
procedure Add_Listener( this : not null access Corral'Class;
listener : not null A_Event_Listener;
evtName : String );
pragma Precondition( evtName'Length > 0 );
-- Returns the name of the corral.
function Get_Name( this : not null access Corral'Class ) return String;
pragma Postcondition( Get_Name'Result'Length > 0 );
-- Queue an event to be dispatched to all the registered listener objects.
-- The event will be consumed.
procedure Queue_Event( this : not null access Corral'Class;
evt : in out A_Event );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
-- Unregisters an object as a listener for a specific type of event. If the
-- listener was not previously registered, this has no effect.
procedure Remove_Listener( this : not null access Corral'Class;
listener : not null A_Event_Listener;
evtName : String );
pragma Precondition( evtName'Length > 0 );
-- Dispatches an event immediately and sychronously, separate from the
-- queue. The Event_Listener that handles the event may choose to return a
-- response to the caller via 'response'. The event 'evt' will be consumed.
procedure Trigger_Event( this : not null access Corral'Class;
evt : in out A_Event;
response : out Response_Type );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
-- Deletes the Corral.
procedure Delete( this : in out A_Corral );
pragma Postcondition( this = null );
private
-- A broker acts as a queueable go-between object that brokers the exchange
-- between a calling thread and an event dispatching thread. The calling
-- thread puts an event into the broker, inserts it into the corral's event
-- thread, and waits for the corral's dispatching thread to get around to
-- dispatching the event and returning a response via the broker.
protected type Broker_Type is
-- Set's the broker's event, consuming it. If an event has already been
-- set, the first event will be preserved and the second event, 'evt' in
-- this case, will be ignored and deleted.
procedure Put_Event( evt : in out A_Event );
pragma Postcondition( evt = null );
-- Retrieves the broker's event. This can only be called once because
-- the internal pointer is cleared when the event is returned. The
-- returned event, 'evt', belongs to the caller.
procedure Take_Event( evt : in out A_Event );
pragma Precondition( evt = null );
-- Sets the response to be returned by Get_Response and allows any
-- callers waiting on Get_Response to proceed.
procedure Set_Response( response : Response_Type );
-- Returns the Event_Listeners's response. This will block until
-- Set_Response has been called.
entry Get_Response( response : out Response_Type );
private
my_event : A_Event := null;
my_response : Response_Type := No_Response;
initialized : Boolean := False;
complete : Boolean := False;
end Broker_Type;
type A_Broker is access all Broker_Type;
-- Creates a Broker object for 'evt', consuming it.
procedure Create_Broker( evt : in out A_Event; broker : out A_Broker );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
pragma Postcondition( broker /= null );
-- Deletes the Broker object.
procedure Delete( broker : in out A_Broker );
pragma Postcondition( broker = null );
----------------------------------------------------------------------------
package Broker_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Broker, "=" );
use Broker_Lists;
package Event_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Event, "=" );
use Event_Lists;
-- An Event_Queue is a protected FIFO queue of Events. Events can jump to
-- the front of the line for synchronous dispatching by being encapsulated
-- in a broker object.
protected type Event_Queue is
-- Adds a brokered event to the queue. Brokered events take precedence
-- over any other asynchronous events in the queue.
procedure Add( broker : A_Broker );
-- Adds an event to the end of the queue for asynchronous dispatching.
procedure Add( evt : in out A_Event );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
-- Marks an event frame. All events that were queued prior to this
-- marker will be dispatched before the Corral Process returns execution
-- to its Process_Manager. Any events added after this point will be
-- dispatched in the next Process tick.
procedure Mark_Frame;
-- Removes the first brokered event to be synchronously dispatched. If
-- no brokered events are waiting then null will be returned.
procedure Remove( broker : out A_Broker );
-- Removes the next event on the queue. If the frame marker is reached
-- or the queue is begin shutdown, then null will be returned.
procedure Remove( evt : out A_Event );
-- Shuts down the event queue, deleting all pending events and
-- preventing any further from being queued.
procedure Shutdown;
private
queue : Event_Lists.List;
brokers : Broker_Lists.List;
remaining : Integer := 0; -- queued events remaining in the frame
stopped : Boolean := False;
end Event_Queue;
----------------------------------------------------------------------------
package Listener_Lists is new Mutable_Lists( A_Event_Listener, "=" );
use Listener_Lists;
-- A Listener_List is a list of Event_Listeners which are all registered
-- with a Corral for the same Event.
type Listener_List is tagged
record
corral : A_Corral := null;
name : Unbounded_String;
listeners : access Listener_Lists.List := new Listener_Lists.List;
end record;
type A_Listener_List is access all Listener_List'Class;
-- Adds the listener to the list and registers the list's corral with
-- the event manager if the list was empty.
procedure Add( this : not null access Listener_List'Class;
listener : not null A_Event_Listener );
-- Synchronously notifies each listener in the list until the event is
-- consumed. The response is returned from the last event listener to
-- be notified, or contains error information if an exception was
-- raised by the last listener to be notified.
procedure Call( this : not null access Listener_List'Class;
evt : in out A_Event;
response : out Response_Type );
-- Clears the listener list and unregisters the list's corral with the
-- event manager.
procedure Clear( this : not null access Listener_List'Class );
-- Call this with the listener list's owning corral and the event name that
-- the list is associated with at time of object creation.
procedure Construct( this : access Listener_List;
owner : not null A_Corral;
evtName : String );
-- Removes the listener from the list and unregisters the list's corral
-- with the event manager if the list is now empty.
procedure Remove( this : not null access Listener_List'Class;
listener : not null A_Event_Listener );
----------------------------------------------------------------------------
package Type_Map is new
Ada.Containers.Indefinite_Hashed_Maps( String,
A_Listener_List,
Ada.Strings.Hash_Case_Insensitive,
"=", "=" );
use Type_Map;
-- A Listener_Registry is a protected object that manages a map of event
-- names to their corresponding registered Event_Listener lists.
protected type Listener_Registry is
-- Clears all event listener lists in the registry.
procedure Clear;
-- Returns a reference to the list of event listeners for the given
-- event name. If no listeners have been registered for the name yet, an
-- empty list is returned. The reference to the listener list that is
-- returned is owned by the listener registry. Do not delete it.
procedure Get_List( evtName : String; list : out A_Listener_List );
-- Call this with the listener registry's owning corral at time of
-- object creation to initialize/construct the Listener_Registry.
procedure Init( owner : not null A_Corral );
private
corral : A_Corral := null;
registry : Type_Map.Map;
end Listener_Registry;
----------------------------------------------------------------------------
type Corral is new Limited_Object and Process with
record
name : Unbounded_String;
listeners : access Listener_Registry := null;
queue : access Event_Queue := null;
end record;
procedure Construct( this : access Corral; name : String );
procedure Delete( this : in out Corral );
-- Returns the name of the Process.
function Get_Process_Name( this : access Corral ) return String;
-- Dispatches one frame of events from the event queue.
procedure Tick( this : access Corral; time : Tick_Time );
-- Returns a string representation of the Corral.
function To_String( this : access Corral ) return String;
end Events.Corrals;