AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Home >
Articles >
Getting Started >
Ada FAQ >
Source Treasury >
Books & Tutorials >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Including Subject State In The Callback (Matthew Heaney)

We've seen how to observe multiple subject attributes a couple of ways.
The subject notifies its observer either by calling a primitive
operation in the observer class, or by calling a (non-primitive)
callback procedure.

Traditionally, when the observer is modified, it queries the subject to
get the new state.  Most recently, we've shown how to pass the state
directly back to the observer, as a parameter of the primitive Update
operation.

Here, we show how to pass state data back to the observer using the
callback technique.

Implementation

When using the callback notification technique, the observer is
implemented like this:

   type Digital_Clock
     (Timer : access Clock_Timer) is
      new Subjects_And_Observers.Observer_Type with record
         Control : Control_Type (Digital_Clock'Access);
      end record;


The full view of the type is implemented as a private derivation from
Observer_Type.

There's a different notification callback for each subject attribute
being observed, and here, each one takes a different type of state
parameter.  A typical callback looks like this:

   procedure Update_Hour
     (Observer : in out Observer_Type'Class;
      Hour     : in     Hour_Number) is ... end Update_Hour;


Therefore, we need at least the subject to be generic, because the state
data is different for each attribute subject.

In a previous implementation, the entire Subjects_And_Observers package
was generic, because both the observer and subject types had to be
parameterized by the type of state.

However, that approach won't work here, because there's only one
observer type -- the parent type used to derive our Digital_Clock above.

What we do is declare one observer type, for use as the parent in
observer derivations, but declare a nested generic, so that only the
subject is parameterized.

Subjects_And_Observers now looks like this:

  package Subjects_And_Observers is

     type Observer_Type is
        tagged limited null record;


     generic

        type State_Type (<>) is limited private;

     package Subjects is

        type Subject_Type is
           tagged limited private;

         type Subject_Access is
            access all Subject_Type'Class;

         procedure Notify
           (Subject : in out Subject_Type'Class;
            State   : in     State_Type);

         type Update_Type is
            access procedure (Observer : in out Observer_Type'Class;
                              State    : in     State_Type);

         procedure Attach
           (Observer : access Observer_Type'Class;
            Update   : in     Update_Type;
            To       : access Subject_Type'Class);

         procedure Detach
           (Observer : access Observer_Type'Class;
            From     : access Subject_Type'Class);

     private

         ...

     end Subjects;


  end Subjects_And_Observers;



This looks similar to the earlier callback implementation, except that
the subject type and related operations are now declared in a nested
generic.  This is so because the Notify operation takes an additional
state parameter, as do update callbacks (note the declaration of
Update_Type).

The body of Subjects_And_Observers is also much the same, except that
Notify now passes the state to the update callback:

  package body Subjects_And_Observers is

     package body Subjects is

        procedure Notify
          (Subject : in out Subject_Type'Class;
           State   : in     State_Type) is               <--!!!

           Node : Node_Access := Subject.Head;

        begin

           while Node /= null loop
              Node.Update (Node.Observer.all, State);     <--!!!
              Node := Node.Next;
           end loop;

        end Notify;

        ...

     end Subjects;

  end Subjects_And_Observers;


For each attribute subject, the Clock_Timer instantiates the generic
subject package.  Here's the public part of the spec:

  package Clock_Timers is

     type Clock_Timer is limited private;

     procedure Tick
       (Timer : in out Clock_Timer);


     subtype Hour_Number is
       Natural range 0 .. 23;

     package Hour_Subjects is                                   <--!!!
       new Subjects_And_Observers.Subjects (Hour_Number);

     function Get_Hour_Subject
       (Timer : access Clock_Timer)
        return Hour_Subjects.Subject_Access;



     subtype Minute_Number is
       Natural range 0 .. 59;

     package Minute_Subjects is                                 <--!!!
       new Subjects_And_Observers.Subjects (Minute_Number);

     function Get_Minute_Subject
       (Timer : access Clock_Timer)
       return Minute_Subjects.Subject_Access;



     subtype Second_Number is
       Natural range 0 .. 59;

     package Second_Subjects is                                 <--!!!
        new Subjects_And_Observers.Subjects (Second_Number);

     function Get_Second_Subject
       (Timer : access Clock_Timer)
        return Second_Subjects.Subject_Access;


  private

     ...

  end Clock_Timers;



The interesting thing here are the instantiations:

     package Hour_Subjects is
       new Subjects_And_Observers.Subjects (Hour_Number);


Each instantiation provides a different subject type, used exclusively
for that attribute.  In this example, there are three subjects (one for
each observable attribute), each one having a different type:

  package Clock_Timers is

     ...

  private

     function Get_Default_Time return Natural;

     type Clock_Timer is
       limited record
          Current_Time   : Natural := Get_Default_Time;
          Hour           : Integer := -1;
          Hour_Subject   : aliased Hour_Subjects.Subject_Type;    <--!!!
          Minute         : Integer := -1;
          Minute_Subject : aliased Minute_Subjects.Subject_Type;  <--!!!
          Second         : Integer := -1;
          Second_Subject : aliased Second_Subjects.Subject_Type;  <--!!!
       end record;

  end Clock_Timers;


Note that expanded name notation is required here to unambiguously
identify the subject type.

We've already seen above how the Digital_Clock observer is implemented,
as a private derivation from the observer type declared in the
non-generic part of Subjects_And_Observers.

The profile of a notification callback is specified this way:

   type Update_Type is
      access procedure (Observer : in out Observer_Type'Class;
                        State    : in     State_Type);

That is, a callback is a procedure that takes two arguments, one a
parameter of type Observer_Type'Class, and the other of type State_Type.

So a typical callback will look like this:

   procedure Update_Hour
     (Observer : in out Observer_Type'Class;
      Hour     : in     Hour_Number) is

      Image : constant String :=
        Integer'Image (Hour + 100);
   begin
      Put_Line ("new hour is " & Image (3 .. Image'Last));
   end;


In this particular example, we don't need to look at the Observer, since
we have the data we need directly.  If you need access to data declared
locally, in the observer, then simply downcast the Observer parameter to
the appropriate type.

There are different Attach and Detach operations for each instantiation
of the generic Subjects.  Here, in Initialize (and Finalize), we use
expanded name notation to make it clear where the operations are coming
from:

   procedure Initialize (Control : in out Control_Type) is
   begin

      Hour_Subjects.Attach                                      <--!!!
        (Observer => Control.Clock,
         Update   => Update_Hour'Access,
         To       => Get_Hour_Subject (Control.Clock.Timer));

      Minute_Subjects.Attach                                    <--!!!
        (Observer => Control.Clock,
         Update   => Update_Minute'Access,
         To       => Get_Minute_Subject (Control.Clock.Timer));

      Second_Subjects.Attach                                    <--!!!
        (Observer => Control.Clock,
         Update   => Update_Second'Access,
         To       => Get_Second_Subject (Control.Clock.Timer));

   end Initialize;



Concluding Comments

The callback technique is a less heavy alternative to making a separate
observer derivation for each observable attribute of a subject.

Passing the new state along with the notification obviates the need to
query the subject for the state.  This may make reasoning about control
flow easier, especially in the presence of concurrency.

--STX
package body Clock_Timers is

   function Get_Default_Time return Natural is
   begin
      return 1 * 3600 + 59 * 60 + 54;
   end;


   procedure Do_Tick
     (Timer : in out Clock_Timer) is

      Hour : constant Hour_Number :=
        Timer.Current_Time / 3600;

      Minute : constant Minute_Number :=
        (Timer.Current_Time - 3600 * Hour) / 60;

      Second : constant Second_Number :=
        Timer.Current_Time -
        3600 * Hour -
        60 * Minute;

   begin

      if Timer.Hour /= Hour then
         Timer.Hour := Hour;
         Hour_Subjects.Notify (Timer.Hour_Subject, Hour);
      end if;


      if Timer.Minute /= Minute then
         Timer.Minute := Minute;
         Minute_Subjects.Notify (Timer.Minute_Subject, Minute);
      end if;


      if Timer.Second /= Second then
         Timer.Second := Second;
         Second_Subjects.Notify (Timer.Second_Subject, Second);
      end if;

   end Do_Tick;


   procedure Tick
     (Timer : in out Clock_Timer) is
   begin

      Timer.Current_Time := Timer.Current_Time + 1;

      Do_Tick (Timer);

   end Tick;



   function Get_Hour_Subject
     (Timer : access Clock_Timer)
      return Hour_Subjects.Subject_Access is
   begin
      return Timer.Hour_Subject'Access;
   end;



   function Get_Minute_Subject
     (Timer : access Clock_Timer)
      return Minute_Subjects.Subject_Access is
   begin
      return Timer.Minute_Subject'Access;
   end;



   function Get_Second_Subject
     (Timer : access Clock_Timer)
      return Second_Subjects.Subject_Access is
   begin
      return Timer.Second_Subject'Access;
   end;


end Clock_Timers;
with Subjects_And_Observers;

package Clock_Timers is

   pragma Preelaborate;


   type Clock_Timer is limited private;

   procedure Tick
     (Timer : in out Clock_Timer);


   subtype Hour_Number is
     Natural range 0 .. 23;

   package Hour_Subjects is
     new Subjects_And_Observers.Subjects (Hour_Number);

   function Get_Hour_Subject
     (Timer : access Clock_Timer)
      return Hour_Subjects.Subject_Access;



   subtype Minute_Number is
     Natural range 0 .. 59;

   package Minute_Subjects is
     new Subjects_And_Observers.Subjects (Minute_Number);

   function Get_Minute_Subject
     (Timer : access Clock_Timer)
     return Minute_Subjects.Subject_Access;



   subtype Second_Number is
     Natural range 0 .. 59;

   package Second_Subjects is
      new Subjects_And_Observers.Subjects (Second_Number);

   function Get_Second_Subject
     (Timer : access Clock_Timer)
      return Second_Subjects.Subject_Access;


private

   function Get_Default_Time return Natural;

   type Clock_Timer is
     limited record
        Current_Time   : Natural := Get_Default_Time;
        Hour           : Integer := -1;
        Hour_Subject   : aliased Hour_Subjects.Subject_Type;
        Minute         : Integer := -1;
        Minute_Subject : aliased Minute_Subjects.Subject_Type;
        Second         : Integer := -1;
        Second_Subject : aliased Second_Subjects.Subject_Type;
     end record;

end Clock_Timers;
with Ada.Text_IO;  use Ada.Text_IO;

package body Digital_Clocks is

   use Subjects_And_Observers;

   procedure Update_Hour
     (Observer : in out Observer_Type'Class;
      Hour     : in     Hour_Number) is

      Image : constant String :=
        Integer'Image (Hour + 100);
   begin
      Put_Line ("new hour is " & Image (3 .. Image'Last));
   end;


   procedure Update_Minute
     (Observer : in out Observer_Type'Class;
      Minute   : in     Minute_Number) is

      Image : constant String :=
        Integer'Image (Minute + 100);
   begin
      Put_Line ("new min is " & Image (3 .. Image'Last));
   end;



   procedure Update_Second
     (Observer : in out Observer_Type'Class;
      Second   : in     Second_Number) is

      Image : constant String :=
        Integer'Image (Second + 100);
   begin
      Put_Line ("new sec is " & Image (3 .. Image'Last));
   end;



   procedure Initialize (Control : in out Control_Type) is
   begin

      Hour_Subjects.Attach
        (Observer => Control.Clock,
         Update   => Update_Hour'Access,
         To       => Get_Hour_Subject (Control.Clock.Timer));

      Minute_Subjects.Attach
        (Observer => Control.Clock,
         Update   => Update_Minute'Access,
         To       => Get_Minute_Subject (Control.Clock.Timer));

      Second_Subjects.Attach
        (Observer => Control.Clock,
         Update   => Update_Second'Access,
         To       => Get_Second_Subject (Control.Clock.Timer));

   end Initialize;



   procedure Finalize (Control : in out Control_Type) is
   begin

      Hour_Subjects.Detach
        (Observer => Control.Clock,
         From     => Get_Hour_Subject (Control.Clock.Timer));

      Minute_Subjects.Detach
        (Observer => Control.Clock,
         From     => Get_Minute_Subject (Control.Clock.Timer));

      Second_Subjects.Detach
        (Observer => Control.Clock,
         From     => Get_Second_Subject (Control.Clock.Timer));

   end Finalize;



end Digital_Clocks;






with Clock_Timers;           use Clock_Timers;
with Subjects_And_Observers;
with Ada.Finalization;

package Digital_Clocks is

   pragma Elaborate_Body;


   type Digital_Clock (Timer : access Clock_Timer) is
      limited private;

private

   use Ada.Finalization;

   type Control_Type (Clock : access Digital_Clock) is
     new Limited_Controlled with null record;

   procedure Initialize (Control : in out Control_Type);

   procedure Finalize (Control : in out Control_Type);


   type Digital_Clock
     (Timer : access Clock_Timer) is
      new Subjects_And_Observers.Observer_Type with record
         Control : Control_Type (Digital_Clock'Access);
      end record;

end Digital_Clocks;






with Ada.Unchecked_Deallocation;

package body Subjects_And_Observers is

   package body Subjects is

      procedure Free is
        new Ada.Unchecked_Deallocation
        (Node_Type,
         Node_Access);

      procedure Notify
        (Subject : in out Subject_Type'Class;
         State   : in     State_Type) is

         Node : Node_Access := Subject.Head;

      begin

         while Node /= null loop
            Node.Update (Node.Observer.all, State);
            Node := Node.Next;
         end loop;

      end Notify;


      procedure Attach
        (Observer : access Observer_Type'Class;
         Update   : in     Update_Type;
         To       : access Subject_Type'Class) is

         Node : constant Node_Access :=
          new Node_Type;
      begin
         Node.Observer := Observer.all'Unchecked_Access;
         Node.Update := Update;
         Node.Next := To.Head;

         To.Head := Node;
      end Attach;


      procedure Detach
        (Observer : access Observer_Type'Class;
         From     : access Subject_Type'Class) is

         OA : constant Observer_Access :=
           Observer.all'Unchecked_Access;

         Prev  : Node_Access := From.Head;
         Index : Node_Access;

      begin

         if Prev.Observer = OA then

            From.Head := From.Head.Next;
            Free (Prev);

         else

            Index := From.Head.Next;

            while Index.Observer /= OA loop
               Prev := Index;
               Index := Index.Next;
            end loop;

            Prev.Next := Index.Next;
            Free (Index);

         end if;

      end Detach;

   end Subjects;


end Subjects_And_Observers;
package Subjects_And_Observers is

   pragma Preelaborate;


   type Observer_Type is
      tagged limited null record;


   generic

      type State_Type (<>) is limited private;

   package Subjects is

      type Subject_Type is
         tagged limited private;

       type Subject_Access is
          access all Subject_Type'Class;

       procedure Notify
         (Subject : in out Subject_Type'Class;
          State   : in     State_Type);

       type Update_Type is
          access procedure (Observer : in out Observer_Type'Class;
                            State    : in     State_Type);

       procedure Attach
         (Observer : access Observer_Type'Class;
          Update   : in     Update_Type;
          To       : access Subject_Type'Class);

       procedure Detach
         (Observer : access Observer_Type'Class;
          From     : access Subject_Type'Class);

   private

      type Observer_Access is access all Observer_Type'Class;
      pragma Suppress (Access_Check, On => Observer_Access);

      type Node_Type;
      type Node_Access is access Node_Type;

      type Node_Type is
         limited record
            Observer : Observer_Access;
            Update   : Update_Type;
            Next     : Node_Access;
         end record;

      type Subject_Type is
         tagged limited record
            Head : Node_Access;
         end record;

   end Subjects;


end Subjects_And_Observers;
with Ada.Text_IO;     use Ada.Text_IO;
with Clock_Timers;    use Clock_Timers;
with Digital_Clocks;  use Digital_Clocks;

procedure Test_Observers is

   Timer : aliased Clock_Timer;

   Clock : Digital_Clock (Timer'Access);

   procedure Do_Ticks is
   begin
      Tick (Timer);
      Tick (Timer);
      Tick (Timer);

      New_Line;
   end Do_Ticks;

begin

   Put_Line ("(one observer)");
   Do_Ticks;

   declare
      Another_Clock : Digital_Clock (Timer'Access);
   begin
      Put_Line ("(two observers)");
      Do_Ticks;

      declare
         Yet_Another_Clock : Digital_Clock (Timer'Access);
      begin
         Put_Line ("(three observers)");
         Do_Ticks;
      end;

      Put_Line ("(two observers)");
      Do_Ticks;
   end;

   Put_Line ("(one observer)");
   Do_Ticks;

end Test_Observers;


(c) 1998-2004 All Rights Reserved David Botton