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