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