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.     type Response_Type is private; 
  24.  
  25.     function Get_Message( response : Response_Type ) return String; 
  26.  
  27.     function Get_Status( response : Response_Type ) return Status; 
  28.  
  29.     procedure Set_Message( response : in out Response_Type; msg : String ); 
  30.  
  31.     procedure Set_Status( response : in out Response_Type; stat : Status ); 
  32.  
  33.     No_Response : constant Response_Type; 
  34.  
  35.     ---------------------------------------------------------------------------- 
  36.  
  37.     type Event is abstract new Object with private; 
  38.     type A_Event is access all Event'Class; 
  39.  
  40.     function Get_Name( this : not null access Event'Class ) return String; 
  41.     pragma Postcondition( Get_Name'Result'Length > 0 ); 
  42.  
  43.     function Get_Id( this : not null access Event'Class ) return Event_Id; 
  44.  
  45.     function Copy( src : A_Event ) return A_Event; 
  46.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  47.  
  48.     procedure Delete( this : in out A_Event ); 
  49.     pragma Postcondition( this = null ); 
  50.  
  51. private 
  52.  
  53.     use Ada.Real_Time; 
  54.     use Ada.Strings.Unbounded; 
  55.  
  56.     type Event_Id is new Ada.Containers.Hash_Type; 
  57.  
  58.     type Event_Type is 
  59.         record 
  60.             id   : Event_Id := Event_Id'First; 
  61.             name : Unbounded_String; 
  62.         end record; 
  63.  
  64.     type Response_Type is 
  65.         record 
  66.             stat : Status := ST_NONE; 
  67.             msg  : Unbounded_String; 
  68.         end record; 
  69.  
  70.     No_Response : constant Response_Type := Response_Type'(others => <>); 
  71.  
  72.     ---------------------------------------------------------------------------- 
  73.  
  74.     type Event is abstract new Object with 
  75.         record 
  76.             eType : Event_Type; 
  77.             eTime : Time := Time_First; 
  78.         end record; 
  79.  
  80.     procedure Construct( this : access Event; name : String ); 
  81.     pragma Precondition( name'Length > 0 ); 
  82.  
  83.     function To_String( this : access Event ) return String; 
  84.  
  85. end Events;