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
type Corral is new Object and Process with private;
type A_Corral is access all Corral'Class;
function Create_Corral( name : String ) return A_Corral;
pragma Precondition( name'Length > 0 );
pragma Postcondition( Create_Corral'Result /= null );
procedure Add_Listener( this : access Corral;
listener : not null A_Event_Listener;
evtName : String );
pragma Precondition( evtName'Length > 0 );
function Get_Name( this : access Corral ) return String;
pragma Postcondition( Get_Name'Result'Length > 0 );
procedure Queue_Event( this : access Corral; evt : in out A_Event );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
procedure Remove_Listener( this : access Corral;
listener : not null A_Event_Listener;
evtName : String );
pragma Precondition( evtName'Length > 0 );
procedure Trigger_Event( this : access Corral;
evt : in out A_Event;
response : out Response_Type );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
procedure Delete( this : in out A_Corral );
pragma Postcondition( this = null );
private
protected type Broker_Type is
procedure Put_Event( evt : in out A_Event );
pragma Postcondition( evt = null );
procedure Take_Event( evt : in out A_Event );
pragma Precondition( evt = null );
procedure Set_Response( response : Response_Type );
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;
procedure Create_Broker( evt : in out A_Event; broker : out A_Broker );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
pragma Postcondition( broker /= null );
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;
protected type Event_Queue is
procedure Add( broker : A_Broker );
procedure Add( evt : in out A_Event );
pragma Precondition( evt /= null );
pragma Postcondition( evt = null );
procedure Mark_Frame;
procedure Remove( broker : out A_Broker );
procedure Remove( evt : out A_Event );
procedure Shutdown;
private
queue : Event_Lists.List;
brokers : Broker_Lists.List;
remaining : Integer := 0;
stopped : Boolean := False;
end Event_Queue;
package Listener_Lists is new Mutable_Lists( A_Event_Listener, "=" );
use Listener_Lists;
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;
procedure Add( this : access Listener_List;
listener : not null A_Event_Listener );
procedure Call( this : access Listener_List;
evt : in out A_Event;
response : out Response_Type );
procedure Clear( this : access Listener_List );
procedure Construct( this : access Listener_List;
owner : not null A_Corral;
evtName : String );
procedure Remove( this : access Listener_List;
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;
protected type Listener_Registry is
procedure Clear;
procedure Get_List( evtName : String; list : out A_Listener_List );
procedure Init( owner : not null A_Corral );
private
corral : A_Corral := null;
registry : Type_Map.Map;
end Listener_Registry;
type Corral is new Object and Process with
record
name : Unbounded_String;
listeners : access Listener_Registry := new Listener_Registry;
queue : access Event_Queue := new Event_Queue;
end record;
procedure Adjust( this : access Corral );
procedure Construct( this : access Corral; name : String );
procedure Delete( this : in out Corral );
function Get_Process_Name( this : access Corral ) return String;
procedure Tick( this : access Corral; upTime, dt : Time_Span );
function To_String( this : access Corral ) return String;
end Events.Corrals;