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
Passing Back Data From Subject To Observer (Matthew Heaney)

In the examples we've already seen, when the subject notifies its
observer(s) about a state change, the observer queries the subject for
the actual value.

What we do here is pass the data to the observer directly, instead of
the observer having to call back the subject to get it.

Implementation

The nature of the data the subject passes back to the observer depends
on the abstraction, so clearly a generic is called for.

During a notification, the subject passes the state to Notify, which
just passes it in turn to each of the observers in the Update.

The spec of Subjects_And_Observers now looks like this:

  generic

     type State_Type (<>) is limited private;         <--!!!

  package Subjects_And_Observers 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 Observer_Type is
       abstract tagged limited private;

     procedure Update
       (Observer : access Observer_Type;
        State    : in     State_Type) is abstract;    <--!!!


     procedure Attach (...);

     procedure Detach (...);

  private

     ...

  end Subjects_And_Observers;



The generic formal type is limited and indefinite, since here it's just
being passed as a subprogram argument.  The data isn't copied, nor are
instances declared.

Notify and Update now take an additional argument, the new value of the
state.

Notify is implemented as before, by traversing the observer list and
Update'ing each observer.  The only difference is that it passes the
state to Update.


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

      Observer : Observer_Access := Subject.Head;

   begin

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

   end Notify;


That about covers the salient changes to Subjects_And_Observers.

Our Clock_Timer subject has three attributes that get observed.  That
means there will be three separate instantiations of the generic
version of Subjects_And_Observers.

The public part of the spec looks like this:


  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 (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 (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 (Second_Number);

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


  private

      ...

  end Clock_Timers;



There are a few things to notice about this spec:

1) There are three different instantiations of Subjects_And_Observers,
   one each for Hour_Number, Minute_Number, and Second_Number.

2) The selector functions that return a subject (e.g. Get_Hour_Subject)
   return the subject type provided by the respective instantiation.

3) There are no selector functions to query the Clock_Timer's state,
   since the state is passed directly from the subject to the observer,
   during the state change notification.



The private part of the spec now looks like this:

  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;


This implementation is much like we've seen before, except that each
subject attribute is a different subject type, one for each
instantiation of Subjects_And_Observers.

Since there are now three different subject types, there are now three
different Notify procedures.  In the implementation of Tick, we use
expanded name notation to make this clear:

   procedure Do_Tick
     (Timer : in out Clock_Timer) is

     <calculate new hour, min, and sec>

   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;


When the subject notifies its observers of a state change, it passes the
new state value as an argument of Notify.

That about covers the changes to the Clock_Timer subject.  Next up are
the changes to the Digital_Clock observer.

There are three different subjects to observe, that means there will be
three different observer derivations, each one from a different observer
type.

The spec of Digital_Clocks now looks like this:


  package Digital_Clocks is

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

  private

     type H_Obs_Type is
       new Hour_Subjects.Observer_Type with null record;

     procedure Update
       (Observer : access H_Obs_Type;
        Hour     : in     Hour_Number);


     type M_Obs_Type is
       new Minute_Subjects.Observer_Type with null record;

     procedure Update
       (Observer : access M_Obs_Type;
        Minute   : in     Minute_Number);


     type S_Obs_Type is
       new Second_Subjects.Observer_Type with null record;

     procedure Update
       (Observer : access S_Obs_Type;
        Second   : in     Second_Number);


     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
        limited record
           H_Obs   : aliased H_Obs_Type;
           M_Obs   : aliased M_Obs_Type;
           S_Obs   : aliased S_Obs_Type;

           -- The Control component MUST be declared LAST!!!
           Control : Control_Type (Digital_Clock'Access);
        end record;

  end Digital_Clocks;


There are a few things to make note of:

1) Previous observers needed an access discriminant designating the
   enclosing record, in order to get access to its discriminant, which
   designated the subject.

   The observer doesn't need to query the subject anymore, so
   discriminant is no longer necessary.  (The data needed by an observer
   is passed as part of the Update call.)

   Of course, in some other application, the observer may need access to
   the enclosing record for some other reason, perhaps because there's
   some local state it needs.  In that case, just do as we've done
   before, and extend the observer parent type with an access
   discriminant.

2) Each (non-abstract) observer derives from a different observer parent
   type, the one provided by the respective instantiation of
   Subjects_And_Observers.  Expanded name notation is needed here to
   unambiguously name the parent type.

3) The Update procedure overridden by each observer each takes an
   additional parameter, for the new state value.  This is why the
   observer doesn't need to call back the subject anymore, because it's
   given the data directly.

4) Per the idiom, there is a Control component to attach the observers
   to their subjects during elaboration, and detach them at end of
   scope.

   I have said it before, and I'll say it again: the Control component
   MUST be declared as the LAST component of the record, in order to
   ensure that the observer components have already been elaborated.



The Update procedure now receives the state directly, and so it doesn't
have to query the subject for it.  The observer just displays the state
in the normal way:

   procedure Update
     (Observer : access H_Obs_Type;
      Hour     : in     Hour_Number) is

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


There are now different Attach (and Detach) operations, one for each
different instantiation of Subjects_And_Observers.

In the implementation of the Initialize (and Finalize) operation, we use
expanded name notation to make this clear:

   procedure Initialize (Control : in out Control_Type) is

      Clock : Digital_Clock renames Control.Clock.all;

   begin

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

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

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

   end Initialize;


That's it!  This variation may simplify your life if the sequence of
notifications and queries gets unwieldy, especially when there are
concurrency issues to deal with.


--STX

package body Clock_Timers is


   function Get_Default_Time return Natural is
   begin
      return 1 * 3600 + 59 * 60 + 55;
   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;
pragma Elaborate (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 (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 (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 (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

   procedure Update
     (Observer : access H_Obs_Type;
      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
     (Observer : access M_Obs_Type;
      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
     (Observer : access S_Obs_Type;
      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

      Clock : Digital_Clock renames Control.Clock.all;

   begin

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

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

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

   end Initialize;



   procedure Finalize (Control : in out Control_Type) is

      Clock : Digital_Clock renames Control.Clock.all;

   begin

      Hour_Subjects.Detach
        (Observer => Clock.H_Obs'Access,
         From     => Get_Hour_Subject (Clock.Timer));

      Minute_Subjects.Detach
        (Observer => Clock.M_Obs'Access,
         From     => Get_Minute_Subject (Clock.Timer));

      Second_Subjects.Detach
        (Observer => Clock.S_Obs'Access,
         From     => Get_Second_Subject (Clock.Timer));

   end Finalize;



end Digital_Clocks;






with Clock_Timers;           use Clock_Timers;
with Ada.Finalization;

package Digital_Clocks is

   pragma Elaborate_Body;


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

private

   type H_Obs_Type is
     new Hour_Subjects.Observer_Type with null record;

   procedure Update
     (Observer : access H_Obs_Type;
      Hour     : in     Hour_Number);


   type M_Obs_Type is
     new Minute_Subjects.Observer_Type with null record;

   procedure Update
     (Observer : access M_Obs_Type;
      Minute   : in     Minute_Number);


   type S_Obs_Type is
     new Second_Subjects.Observer_Type with null record;

   procedure Update
     (Observer : access S_Obs_Type;
      Second   : in     Second_Number);


   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
      limited record
         H_Obs   : aliased H_Obs_Type;
         M_Obs   : aliased M_Obs_Type;
         S_Obs   : aliased S_Obs_Type;

         -- The Control component MUST be declared LAST!!!
         Control : Control_Type (Digital_Clock'Access);
      end record;

end Digital_Clocks;






package body Subjects_And_Observers is


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

      Observer : Observer_Access := Subject.Head;
   begin

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

   end Notify;



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

      OA : constant Observer_Access :=
        Observer.all'Unchecked_Access;
   begin
      OA.Next := To.Head;
      To.Head := OA;
   end Attach;


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

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

      Prev  : Observer_Access;
      Index : Observer_Access;
   begin
      if From.Head = OA then
         From.Head := From.Head.Next;
      else
         Prev := From.Head;
         Index := From.Head.Next;

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

         Prev.Next := Index.Next;
      end if;
   end Detach;



end Subjects_And_Observers;
generic

   type State_Type (<>) is limited private;

package Subjects_And_Observers is

   pragma Preelaborate;


   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 Observer_Type is
     abstract tagged limited private;

   procedure Update
     (Observer : access Observer_Type;
      State    : in     State_Type) is abstract;


   procedure Attach
     (Observer : access Observer_Type'Class;
      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 Subject_Type is
     tagged limited record
        Head : Observer_Access;
     end record;

   type Observer_Type is
     abstract tagged limited record
        Next : Observer_Access;
     end record;

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