1. with Objects;                           use Objects; 
  2. with Statuses;                          use Statuses; 
  3.  
  4. private with Ada.Containers; 
  5. private with Ada.Strings.Unbounded; 
  6. private with Ada.Real_Time; 
  7.  
  8. package Events is 
  9.  
  10.     type Event_Id is private; 
  11.  
  12.     function "="( l, r : Event_Id ) return Boolean; 
  13.  
  14.     function To_Event_Id( evtName : String ) return Event_Id; 
  15.     pragma Precondition( evtName'Length > 0 ); 
  16.  
  17.     type Event_Type is private; 
  18.  
  19.     function "="( l, r : Event_Type ) return Boolean; 
  20.  
  21.     ---------------------------------------------------------------------------- 
  22.  
  23.     -- A Response_Type respresents a response to an event by an event listener. 
  24.     type Response_Type is private; 
  25.  
  26.     -- Returns the message string returned by the event listener in it's response. 
  27.     function Get_Message( response : Response_Type ) return String; 
  28.  
  29.     -- Returns the status returned by the event listener in it's response. 
  30.     function Get_Status( response : Response_Type ) return Status; 
  31.  
  32.     -- Sets the Response's status and message. This is to be called by an event 
  33.     -- listener returning a response. 
  34.     procedure Set_Response( response : in out Response_Type; 
  35.                             stat     : Status; 
  36.                             msg      : String := "" ); 
  37.  
  38.     -- The default no-response with a status of NONE and no message. 
  39.     No_Response : constant Response_Type; 
  40.  
  41.     ---------------------------------------------------------------------------- 
  42.  
  43.     -- An Event object indicates an event/change has taken place and it contains 
  44.     -- all of the information required to describe that change. 
  45.     type Event is abstract new Object with private; 
  46.     type A_Event is access all Event'Class; 
  47.  
  48.     -- Returns the name of the event which ocurred. All event instances of the 
  49.     -- same class share the same name. 
  50.     function Get_Name( this : not null access Event'Class ) return String; 
  51.     pragma Postcondition( Get_Name'Result'Length > 0 ); 
  52.  
  53.     -- Returns the event identifier. This is a hash of the event's name for 
  54.     -- quick event type comparison. All event instances of the same class share 
  55.     -- the same event identifier. However, in the case of a hash collision, it 
  56.     -- is not correct to assume that instances of one event class will not have 
  57.     -- the same id as instances of another event class with a different name. 
  58.     function Get_Id( this : not null access Event'Class ) return Event_Id; 
  59.  
  60.     -- Returns a deep copy of Event 'src'. All events are required to be 
  61.     -- copyable. 
  62.     function Copy( src : A_Event ) return A_Event; 
  63.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  64.  
  65.     -- Deletes the Event. 
  66.     procedure Delete( this : in out A_Event ); 
  67.     pragma Postcondition( this = null ); 
  68.  
  69. private 
  70.  
  71.     use Ada.Real_Time; 
  72.     use Ada.Strings.Unbounded; 
  73.  
  74.     type Event_Id is new Ada.Containers.Hash_Type; 
  75.  
  76.     type Event_Type is 
  77.         record 
  78.             id   : Event_Id := Event_Id'First; 
  79.             name : Unbounded_String; 
  80.         end record; 
  81.  
  82.     type Response_Type is 
  83.         record 
  84.             stat : Status := ST_NONE; 
  85.             msg  : Unbounded_String; 
  86.         end record; 
  87.  
  88.     No_Response : constant Response_Type := Response_Type'(others => <>); 
  89.  
  90.     ---------------------------------------------------------------------------- 
  91.  
  92.     type Event is abstract new Object with 
  93.         record 
  94.             eType : Event_Type; 
  95.             eTime : Time := Time_First; 
  96.         end record; 
  97.  
  98.     procedure Construct( this : access Event; name : String ); 
  99.     pragma Precondition( name'Length > 0 ); 
  100.  
  101.     function To_String( this : access Event ) return String; 
  102.  
  103. end Events;