Observers Of Multiple Subjects

In this variation of the Observer pattern, an observer can observe
multiple subjects.

In the original example, a digital clock observed only a clock timer.
When a tick happened, the clock timer subject would notify the digital
clock observer, who would display the time.

We now introduce another subject, a battery, that notifies its observer
when it is drained or charged.  The digital clock simultaneously
observes both a timer and a battery, displaying a message as it is
notified by each.

Implementation

The clock timer subject is unchanged from the original example.

The battery subject features operations to charge and drain the battery,
and a selector to query whether the battery is low on power:

  package Batteries is

     type Battery_Type is new Root_Subject_Type with private;

     procedure Charge (Battery : in out Battery_Type);

     procedure Drain (Battery : in out Battery_Type);

     function Is_Low (Battery : in Battery_Type) return Boolean;
     ...
  end Batteries;


The Charge and Drain operations are analogous to Tick for the clock
timer.  When you charge (or drain) the battery, it sets its internal
state, then notifies its observers:

   procedure Charge (Battery : in out Battery_Type) is
   begin
      Battery.State := 1;
      Notify (Battery);    <--
   end;


The digital clock observer has been modified so that it can observe both
a clock timer and a battery.  Per our idiom for observers, it is
declared as a limited private type with an access discriminant for each
subject:

   type Digital_Clock
     (Timer   : access Clock_Timer'Class;
      Battery : access Battery_Type'Class) is limited private;


The full view of the type has also been changed.  Recall that in the
earlier implementation, Digital_Clock type privately derived from
Root_Observer_Type, extending it with a component to automatically bind
the clock observer to the timer subject.

Instead of privately deriving from Root_Observer_Type, the digital clock
type is now implemented as a (limited) record with two observer
components:

   type Digital_Clock
     (Timer   : access Clock_Timer'Class;
      Battery : access Battery_Type'Class) is
     limited record
        Timer_Obs   : aliased Timer_Obs_Type (Digital_Clock'Access);
        Battery_Obs : aliased Battery_Obs_Type (Digital_Clock'Access);
        ...
        Control     : Control_Type (Digital_Clock'Access);
     end record;

Note that the order of declaration of record components is crucial.  The
Control component is going to attach the observer components to the
respective subject during the elaboration of a digital clock object.
This requires that the observer components be elaborated prior to
elaboration of the Control component.

The language specifies that components are elaborated in the order of
their declaration in the component list.  Therefore, to ensure that the
observer components are elaborated prior to the Control component, we
declare them earlier in the list.

We also declare the full view of the Digital_Clock type as limited,
which allows us to use T'Access to designate the "current instance" of
the type.  This is how we bind the observer components (and the Control
component) to their containing instance.

The observer types extend the root observer type with an access
discriminant designating the clock:

   type Timer_Obs_Type
     (Clock : access Digital_Clock) is
     new Root_Observer_Type with null record;

   procedure Update (Observer : access Timer_Obs_Type);


   type Battery_Obs_Type
     (Clock : access Digital_Clock) is
     new Root_Observer_Type with null record;

   procedure Update (Observer : access Battery_Obs_Type);


The Update for the Timer observer is the same as before.  When signalled
by the timer, the observer queries the timer for the current time:

   procedure Update (Observer : access Timer_Obs_Type) is

      Clock : Digital_Clock renames Observer.Clock.all;

      Timer : Clock_Timer'Class renames Clock.Timer.all;

      <get timer time and display it>

   end Update;


The Update for the battery observer queries the battery to determine
whether the charge is low, and prints out a message:

   procedure Update (Observer : access Battery_Obs_Type) is

      Clock : Digital_Clock renames Observer.Clock.all;

      Battery : Battery_Type'Class renames Clock.Battery.all;
      ...
   begin
      if Is_Low (Battery) then
        <print message>
      ...
   end Update;


The Control_Type derives from Limited_Controlled and overrides
Initialize to attach both observer components to their subjects:

   procedure Initialize (Control : in out Control_Type) is

      Clock : Digital_Clock renames Control.Clock.all;
   begin
      Attach (Observer => Clock.Timer_Obs'Access,
              To       => Clock.Timer);

      Attach (Observer => Clock.Battery_Obs'Access,
              To       => Clock.Battery);
   end Initialize;


Finalize is implemented similarly.

Note that the observer is an access parameter in Attach (and Detach), so
this requires we take the 'Access of the observer component of the
clock.  In order to do so, the component must be declared aliased.

The following code is ready for GNAT Chop:

--STX
package body Batteries is

   procedure Charge (Battery : in out Battery_Type) is
   begin
      Battery.State := 1;
      Notify (Battery);
   end;

   procedure Drain (Battery : in out Battery_Type) is
   begin
      Battery.State := Battery.State + 1;
      Notify (Battery);
   end;

   function Is_Low (Battery : in Battery_Type) return Boolean is
   begin
      return Battery.State > 3;
   end;

end Batteries;



with Subjects_And_Observers; use Subjects_And_Observers;

package Batteries is

   type Battery_Type is new Root_Subject_Type with private;

   procedure Charge (Battery : in out Battery_Type);

   procedure Drain (Battery : in out Battery_Type);

   function Is_Low (Battery : in Battery_Type) return Boolean;

private

   type Battery_Type is
     new Root_Subject_Type with record
        State : Positive := 1;
     end record;

end Batteries;



with Ada.Calendar;  use Ada.Calendar;

package body Clock_Timers is

   procedure Tick (Timer : in out Clock_Timer) is

      Current_Time : constant Time := Clock;

      Current_Seconds : constant Natural :=
        Natural (Seconds (Current_Time));

   begin

      Timer.Hour := Current_Seconds / 3600;

      Timer.Minute := (Current_Seconds - 3600 * Timer.Hour) / 60;

      Timer.Second :=
        Current_Seconds -
        3600 * Timer.Hour -
        60 * Timer.Minute;

      Notify (Timer);

   end Tick;


   function Get_Hour (Timer : Clock_Timer) return Hour_Number is
   begin
      return Timer.Hour;
   end;


   function Get_Minute (Timer : Clock_Timer) return Minute_Number is
   begin
      return Timer.Minute;
   end;


   function Get_Second (Timer : Clock_Timer) return Second_Number is
   begin
      return Timer.Second;
   end;

end Clock_Timers;





with Subjects_And_Observers;  use Subjects_And_Observers;

package Clock_Timers is

   type Clock_Timer is new Root_Subject_Type with private;

   procedure Tick (Timer : in out Clock_Timer);


   subtype Hour_Number is Natural range 0 .. 23;

   function Get_Hour (Timer : Clock_Timer) return Hour_Number;


   subtype Minute_Number is Natural range 0 .. 59;

   function Get_Minute (Timer : Clock_Timer) return Minute_Number;


   subtype Second_Number is Natural range 0 .. 59;

   function Get_Second (Timer : Clock_Timer) return Second_Number;

private

   type Clock_Timer is
     new Root_Subject_Type with record
        Hour   : Hour_Number;
        Minute : Minute_Number;
        Second : Second_Number;
     end record;

end Clock_Timers;





with Ada.Text_IO;  use Ada.Text_IO;

package body Digital_Clocks is

   procedure Set_Name
     (Clock : in out Digital_Clock;
      Name  : in     String) is
   begin
      Clock.Name (1 .. Name'Length) := Name;
      Clock.Name_Length := Name'Length;
   end;



   procedure Update (Observer : access Timer_Obs_Type) is

      Clock : Digital_Clock renames Observer.Clock.all;

      Timer : Clock_Timer'Class renames Clock.Timer.all;

      Hour_Image : constant String :=
        Integer'Image (Get_Hour (Timer) + 100);

      Minute_Image : constant String :=
        Integer'Image (Get_Minute (Timer) + 100);

      Second_Image : constant String :=
        Integer'Image (Get_Second (Timer) + 100);

      Clock_Image : constant String :=
        Hour_Image (3 .. Hour_Image'Last) & ":" &
        Minute_Image (3 .. Minute_Image'Last) & ":" &
        Second_Image (3 .. Second_Image'Last);

      Name : String renames
        Clock.Name (1 .. Clock.Name_Length);

   begin

      Put_Line ("Clock named '" & Name & "' shows time " & Clock_Image);

   end Update;


   procedure Update (Observer : access Battery_Obs_Type) is

      Clock : Digital_Clock renames Observer.Clock.all;

      Battery : Battery_Type'Class renames Clock.Battery.all;

      Name : String renames
        Clock.Name (1 .. Clock.Name_Length);

   begin
      if Is_Low (Battery) then

         Put_Line
           ("Battery charge is getting low for clock named '" &
            Name &
            "'");
      else

         Put_Line
           ("Battery is charged for clock named '" &
            Name &
            "'");

      end if;
   end Update;


   procedure Initialize (Control : in out Control_Type) is

      Clock : Digital_Clock renames Control.Clock.all;
   begin
      Attach (Observer => Clock.Timer_Obs'Access,
              To       => Clock.Timer);

      Attach (Observer => Clock.Battery_Obs'Access,
              To       => Clock.Battery);
   end Initialize;


   procedure Finalize (Control : in out Control_Type) is

      Clock : Digital_Clock renames Control.Clock.all;
   begin
      Detach (Observer => Clock.Timer_Obs'Access,
              From     => Clock.Timer);

      Detach (Observer => Clock.Battery_Obs'Access,
              From     => Clock.Battery);
   end Finalize;


end Digital_Clocks;






with Clock_Timers;            use Clock_Timers;
with Batteries;               use Batteries;

with Subjects_And_Observers;
with Ada.Finalization;

package Digital_Clocks is

   pragma Elaborate_Body;

   type Digital_Clock
     (Timer   : access Clock_Timer'Class;
      Battery : access Battery_Type'Class) is limited private;

   procedure Set_Name
     (Clock : in out Digital_Clock;
      Name  : in     String);

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


   use Subjects_And_Observers;

   type Timer_Obs_Type
     (Clock : access Digital_Clock) is
     new Root_Observer_Type with null record;

   procedure Update (Observer : access Timer_Obs_Type);


   type Battery_Obs_Type
     (Clock   : access Digital_Clock) is
     new Root_Observer_Type with null record;

   procedure Update (Observer : access Battery_Obs_Type);


   type Digital_Clock
     (Timer   : access Clock_Timer'Class;
      Battery : access Battery_Type'Class) is
     limited record
        Timer_Obs   : aliased Timer_Obs_Type (Digital_Clock'Access);
        Battery_Obs : aliased Battery_Obs_Type (Digital_Clock'Access);
        Name        : String (1 .. 50);
        Name_Length : Natural := 0;
        Control     : Control_Type (Digital_Clock'Access);
     end record;

end Digital_Clocks;
package body Subjects_And_Observers is

   procedure Notify (Subject : in out Root_Subject_Type'Class) is
      Observer : Observer_Access := Subject.Head;
   begin
      while Observer /= null loop
         Update (Observer);
         Observer := Observer.Next;
      end loop;
   end Notify;


   procedure Attach
     (Observer : access Root_Observer_Type'Class;
      To       : access Root_Subject_Type'Class) is
   begin
      Observer.Next := To.Head;
      To.Head := Observer.all'Unchecked_Access;
   end;


   procedure Detach
     (Observer : access Root_Observer_Type'Class;
      From     : access Root_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;
package Subjects_And_Observers is

   pragma Preelaborate;


   type Root_Subject_Type is
     abstract tagged limited private;

   procedure Notify (Subject : in out Root_Subject_Type'Class);


   type Root_Observer_Type is
     abstract new Root_Subject_Type with private;

   procedure Update (Observer : access Root_Observer_Type) is abstract;


   procedure Attach
     (Observer : access Root_Observer_Type'Class;
      To       : access Root_Subject_Type'Class);

   procedure Detach
     (Observer : access Root_Observer_Type'Class;
      From     : access Root_Subject_Type'Class);

private

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

   type Root_Subject_Type is
     abstract tagged limited record
        Head : Observer_Access;
     end record;

   type Root_Observer_Type is
     abstract new Root_Subject_Type with record
        Next : Observer_Access;
     end record;

end Subjects_And_Observers;
with Clock_Timers;    use Clock_Timers;
with Batteries;       use Batteries;
with Digital_Clocks;  use Digital_Clocks;

with Ada.Text_IO;     use Ada.Text_IO;

procedure Test_Observers is

   Timer   : aliased Clock_Timer;
   Battery : aliased Battery_Type;


   procedure Do_Ticks is
   begin
      delay 1.0;
      Tick (Timer);
      Drain (Battery);

      delay 2.0;
      Tick (Timer);
      Drain (Battery);

      delay 3.0;
      Tick (Timer);
      Drain (Battery);

      New_Line;
      Charge (Battery);
      New_Line;
   end Do_Ticks;

   Clock : Digital_Clock (Timer'Access, Battery'Access);

begin

   Set_Name (Clock, Name => "London");
   Do_Ticks;

   declare
      Another_Clock : Digital_Clock (Timer'Access, Battery'Access);
   begin
      Set_Name (Another_Clock, Name => "Los Angeles");
      Do_Ticks;
   end;

   Do_Ticks;

end Test_Observers;