with
     lace.Event,
     lace.Subject,
     lace.Observer;

private
with
     ada.Containers.Vectors,
     ada.Containers.indefinite_hashed_Maps;


generic
   type T is abstract tagged limited private;

package lace.make_Subject
--
--  Makes a user class T into an event Subject.
--
is
   pragma remote_Types;

   type Item is abstract limited new T
                                 and Subject.item with private;
   type View is access all Item'Class;

   procedure destroy (Self : in out Item);


   -------------
   -- Attributes
   --

   overriding
   function Observers      (Self : in Item;   of_Kind : in Event.Kind) return Subject.Observer_views;
   overriding
   function observer_Count (Self : in Item) return Natural;


   -------------
   -- Operations
   --

   overriding
   procedure   register (Self : access Item;   the_Observer : in Observer.view;
                                               of_Kind      : in Event.Kind);
   overriding
   procedure deregister (Self : in out Item;   the_Observer : in Observer.view;
                                               of_Kind      : in Event.Kind);

   overriding
   procedure emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event);

   overriding
   function  emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event)
                   return subject.Observer_views;



private

   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.


   -------------------------
   -- Event observer vectors
   --
   use type Observer.view;

   package event_Observer_Vectors     is new ada.Containers.Vectors (Positive, Observer.view);
   subtype event_Observer_Vector      is event_Observer_Vectors.Vector;
   type    event_Observer_Vector_view is access all event_Observer_Vector;


   -------------------------------------
   -- Event kind Maps of event observers
   --
   use type Event.Kind;
   package event_kind_Maps_of_event_observers is new ada.Containers.indefinite_hashed_Maps (Event.Kind,
                                                                                            event_Observer_Vector_view,
                                                                                            Event.Hash,
                                                                                            "=");
   subtype event_kind_Map_of_event_observers  is event_kind_Maps_of_event_observers.Map;


   -----------------
   -- Safe observers
   --
   protected
   type safe_Observers
   is
      procedure destruct;

      procedure add (the_Observer : in Observer.view;
                     of_Kind      : in Event.Kind);

      procedure rid (the_Observer : in Observer.view;
                     of_Kind      : in Event.Kind);

      function  fetch_Observers (of_Kind : in Event.Kind) return Subject.Observer_views;
      function  observer_Count return Natural;

   private
      the_Observers : event_kind_Map_of_event_observers;
   end safe_Observers;


   ---------------
   -- Subject Item
   --
   type Item is abstract limited new T
                                 and Subject.item
   with
      record
         safe_Observers : make_Subject.safe_Observers;
      end record;

end lace.make_Subject;
