!topic Standard event queue package
!key LSN-1032 on Standard event queue package
!reference MS-9.9.1;4.6
!keywords event queue, selective entry call
!from Tucker Taft 92-07-02
!discussion

Having dropped the general multi-way selective entry call
in mapping-spec version 4.6, there might be some
value in standardizing the interface to an "event queue"
package to support waiting on multiple events.

The general idea is to use tagged types and protected
types to support a heterogenous queue of event descriptors.
Any number of tasks can submit events to the queue, and
one or more tasks can wait for events.  In addition, an event
queue can be redirected to another event queue, providing
a simple form of event queue combination.

This capability is worth standardizing if we anticipate that
independently developed subsystems will want to be interconnected
via event queues.  If the package is not standard, each
subsystem will invent its own event queue mechanism, and
a single task will not be able to wait on events generated
from multiple subsystems.

On the other hand, this capability is not worth standardizing
if we believe that it is trivial for any given project
to build their own, and there is not a sufficient need for
interoperability between independently developed subsystems
to justify the costs of defining such a standard package.

In any case, here is a possible standard event queue package.
We would appreciate comments on whether this or something like
it is worth standardizing.  We are particularly interested
in the User Teams who had earlier made use of selective entry call.

-----------------------------------

package Events is
    type Root_Event_Type is tagged private;
      -- The root type for the class of event object types

    Null_Root_Event : constant Root_Event_Type;
      -- The Root_Event_Type value to be used in an extension 
      -- aggregate for a type derived from Root_Event_Type

    type Event_Ptr is access all Root_Event_Type'CLASS;
      -- All events are represented by pointers to 
      -- an event object (event descriptor).

    procedure Default_Action(Event : access Root_Event_Type);
      -- This is the default action to be taken in response to the event.
      -- This may be overridden for each event type.
      -- The default implementation does nothing.

    procedure Deallocate(Event : in out Event_Ptr);
      -- This is simply an instantiation of Unchecked_Deallocation
      -- on Root_Event_Type'CLASS and Event_Ptr.
      -- It is erroneous to call this if the event object was
      -- not dynamically allocated.

    procedure Delete_Event_Object(Event : access Root_Event_Type);
      -- This (dispatching) procedure deletes an event object.
      -- After calling this procedure, the event pointer should
      -- no longer be used.
      -- The (default) implementation of this is to call Deallocate.

    procedure Delete_Event(Event : in out Event_Ptr);
      -- This procedure simply calls Delete_Event_Object and
      -- then sets its parameter to null.

    type Event_Queue;
    type Event_Queue_Ptr is access all Event_Queue;
      -- This pointer type is used for redirection of events

    protected type Event_Queue is 
      -- This protected type represents an event queue

        procedure Add_Event(Event : Event_Ptr);
          -- Link an event object onto the event queue
          -- (FIFO) Queue is singly linked through event objects.

        entry Await_Event(Event : out Event_Ptr);
          -- Unlink first event object from event queue;
          -- Wait if there are none.

        function Event_Count return Natural;
          -- Return count of event objects

        procedure Flush_Events;
          -- Flush the event queue.
          -- This calls Delete_Event_Object on each event on the queue.

        procedure Redirect_Events(Queue : Event_Queue_Ptr);
          -- This procedure causes all currently and subsequently queued 
          -- events to be redirected to the event queue designated by Queue.
          -- If Queue is null, then redirection is turned off.
          -- Event_Count will return 0 while redirecting

        function Current_Redirection return Event_Queue_Ptr;
          -- Return current redirection, or null if not being redirected.

    private
      -- possible representation:
        First, Last : Event_Ptr := null;
        Count : Natural := 0;
        Redirection : Event_Queue_Ptr := null;
    end Event_Queue;

private
  -- possible representation:
    type Root_Event_Type is tagged record
        Next_Event : Event_Ptr;
    end record;

    Null_Root_Event : constant Root_Event_Type := (Next_Event => null);
end Events;

-----------------------------------------------------
Here is a possible client of this package:

with Events;
with Windows;
package Window_Events is
    Window_Event_Queue : Events.Event_Queue;
       -- All window events are submitted to this queue
       -- (which may of course be redirected)

    type Button_Enum is (None, Left, Middle, Right);

    type Mouse_Event is new Events.Root_Event_Type 
      with record
        Which_Button : Button_Enum;          -- Which button was used
        Which_Window : Windows.Window_Type;  -- Window where event occurred
        X, Y : Integer;              -- Location of mouse within window.
    end record;

    procedure Default_Action(Event : access Mouse_Event);
      -- Override default action

    type Mouse_Up_Event is new Mouse_Event with null;
    type Mouse_Down_Event is new Mouse_Event with null;
    type Mouse_Click_Event is new Mouse_Event with null;
    type Mouse_Double_Click_Event is new Mouse_Event with null;

    type Menu_Event is new Events.Root_Event_Type with ...;

    . . .

end Window_Events;

. . .

with Events;
with Window_Events;
with Database_Events;
with Network_Events;
pragma Elaborate(Window_Events, Database_Events, Network_Events);
package body Handler_Pkg is
    Central_Event_Queue : aliased Events.Event_Queue;
      -- The window, database, and network events will be
      -- redirected to this event queue.
    task type Event_Handler_Type;
      -- Type of task to handle events
    Num_Handlers : constant := ...;
      -- How many handlers to have
    Handlers : array(1..Num_Handlers) of Event_Handler_Type;
      -- Array of event handlers

    task body Event_Handler_Type is
      -- Body for an event handler task
        Event : Events.Event_Ptr;
    begin
        loop
          -- loop getting and performing default action for events
            Central_Event_Queue.Await_Event(Event);
            Events.Default_Action(Event);

            Events.Delete_Event(Event);
              -- Delete event before getting the next one
        end loop;
    end Event_Handler_Type;
    
begin
  -- Redirect all event queues to this central queue
    Window_Events.Window_Event_Queue.Redirect(Central_Event_Queue'ACCESS);
    Database_Events.Database_Event_Queue.Redirect(Central_Event_Queue'ACCESS);
    Network_Events.Network_Event_Queue.Redirect(Central_Event_Queue'ACCESS);
end Handler_Pkg;

---------------------------------------------
-Tuck