In previous implementations of the Observer pattern, the observer would
query the entire state of the subject during a notification, because it
had no way of knowing which specific attribute had changed.
Here, we vary the pattern so that the observer can observe each subject
attribute individually, so it only has to display the attribute that has
changed.
Implementation
The package Subjects_And_Observers, which provides the infrastructure
for observing, is more or less the same as before. The only change I
made was to make Subject_Type non-abstract, so clients can declare
Subject_Type instances directly.
As before, a digital clock observes a clock timer subject. The model we
use for the Clock_Timer is that it's an object that contains Subject
parts (here, an hour subject, and minute subject, and a second subject).
We need to give the Clock_Timer a way to advertise its subject parts, so
an observer can bind to them (via Attach and Detach).
This wasn't an issue before, because we declared the clock timer as a
public derivation of Subject_Type, and the digital clock observer just
attached itself to the entire subject:
package Clock_Timers is
type Clock_Timer is new Subject_Type with private;
-- the old way
...
end Clock_Timers;
Now, we need to allow an observer to attach itself to just a subject
part, so we provide separate selector functions for each:
package Clock_Timers is
type Clock_Timer is limited private;
-- the new way
...
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Subject_Access;
...
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Subject_Access;
...
function Get_Second_Subject
(Timer : access Clock_Timer)
return Subject_Access;
...
end Clock_Timers;
To observe just the subject's Hour part, an observer attaches itself to
the value returned by the function Get_Hour_Subject, and so on for other
parts.
The clock timer subject notifies an observer only when an individual
attribute has changed value, and so the digital clock observer only has
to query one selector function instead of all of them.
This is much more efficient than before, since a view (observer) has to
refresh only one value. The efficiency gain would be more pronounced if
the view had to monitor tens of attributes (here it's only three).
The clock timer is implemented as a (limited) record containing aliased
subject components:
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 Subject_Type;
Minute : Integer := -1;
Minute_Subject : aliased Subject_Type;
Second : Integer := -1;
Second_Subject : aliased Subject_Type;
end record;
end Clock_Timers;
The subject components need to be aliased because the selector functions
that return subject parts need to take the 'Access of the components.
The hour, min, and sec components are the "old" values that we compare
to the "new" values generated during a tick. The clock timer only
notifies its observer(s) when the state changes value.
The subject selector functions are implemented in the normal way, by
returning the 'Access of the subject component:
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Subject_Access is
begin
return Timer.Hour_Subject'Access;
end;
As before, the notification of observers takes place during Tick. We
update the current time, and then calculate the new values of the hour,
min, and sec:
procedure Tick
(Timer : in out Clock_Timer) is
begin
Timer.Current_Time := Timer.Current_Time + 1;
Do_Tick (Timer);
end Tick;
For each attribute that has changed, we update the internal cache and
then notify observers of that particular attribute:
procedure Do_Tick
(Timer : in out Clock_Timer) is
<calculate new values of hour, min, and sec>
begin
if Timer.Hour /= Hour then
Timer.Hour := Hour;
Notify (Timer.Hour_Subject);
end if;
if Timer.Minute /= Minute then
Timer.Minute := Minute;
Notify (Timer.Minute_Subject);
end if;
if Timer.Second /= Second then
Timer.Second := Second;
Notify (Timer.Second_Subject);
end if;
end Do_Tick;
That about covers the changes to the Clock_Timer subject.
The public part of the Digital_Clock hasn't changed any. It's still
limited private, with an access discriminant designating the Clock_Timer
subject:
package Digital_Clocks is
type Digital_Clock (Timer : access Clock_Timer) is
limited private;
...
end Digital_Clocks;
Observers are implemented, as before, as non-abstract derivations of
Observer_Type that override Update. During a notification, the subject
calls the Update operation of each of its observers.
Before, the full view of Digital_Clock was implemented as a private
derivation from Observer_Type.
Now, however, there are separate observers for each subject part (hour,
min, sec) of the Clock_Timer, so there are three separate derivations:
type H_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access H_Obs_Type);
type M_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access M_Obs_Type);
type S_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access S_Obs_Type);
Each observer component type has an access discriminant designating the
Digital_Clock. This is to get access to its Clock_Timer discriminant,
so it can query the new state.
There's also a control component to automatically attach the observers
to their subjects during object elaboration, and to automatically detach
from the subject when the object goes out of scope.
The full view of the Digital_Clock type is implemented as a (limited)
record with observer and control components:
type Digital_Clock
(Timer : access Clock_Timer) is
limited record
H_Obs : aliased H_Obs_Type (Digital_Clock'Access);
M_Obs : aliased M_Obs_Type (Digital_Clock'Access);
S_Obs : aliased S_Obs_Type (Digital_Clock'Access);
Control : Control_Type (Digital_Clock'Access);
end record;
The observer components are aliased because the Control object needs to
take the 'Access of each component, and pass that to Attach and Detach.
The order of declaration of components here is VERY IMPORTANT!!!
The Control component attaches the observer components to their subjects
during elaboration of the Digital_Clock object, and that means the
observer components must have already been elaborated prior to
elaboration of the Control component (which is when Init is called).
The language guarantees that components are elaborated in the order of
their declaration within the record, and so that's why Control must come
last, to ensure that all the observers have been fully elaborated.
The Update operations are implemented in the normal way. Each one
queries the value of the subject's part, and then displays its new
value:
procedure Update
(Observer : access H_Obs_Type) is
Clock : Digital_Clock renames Observer.Clock.all;
Image : constant String :=
Integer'Image (Get_Hour (Clock.Timer) + 100);
begin
Put_Line ("new hour is " & Image (3 .. Image'Last));
end;
<and so on for min and sec Updates>
Initialize attaches each observer component to its associated subject
part. It gets the subject part by calling the Digital_Clock's selector
function for that part:
procedure Initialize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
begin
Attach
(Observer => Clock.H_Obs'Access,
To => Get_Hour_Subject (Clock.Timer));
Attach
(Observer => Clock.M_Obs'Access,
To => Get_Minute_Subject (Clock.Timer));
Attach
(Observer => Clock.S_Obs'Access,
To => Get_Second_Subject (Clock.Timer));
end Initialize;
Finalize is implemented similarly, except that it calls Detach.
When I run the test program, I get the following output:
(only one observer)
new hour is 01 (first time, print hour)
new min is 59 (first time, print min)
new sec is 56 (first time, print sec)
new sec is 57 (second time, print only sec)
new sec is 58
(two observers)
new sec is 59
new sec is 59
new hour is 02 (each observer prints new value of hour)
new hour is 02
new min is 00 (each observer prints new value of min)
new min is 00
new sec is 00 (each observer prints new value of sec)
new sec is 00
new sec is 01
new sec is 01
(three observers)
new sec is 02
new sec is 02
new sec is 02
new sec is 03
new sec is 03
new sec is 03
new sec is 04
new sec is 04
new sec is 04
(two observers)
new sec is 05
new sec is 05
new sec is 06
new sec is 06
new sec is 07
new sec is 07
(one observer)
new sec is 08
new sec is 09
new sec is 10
(done)
--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;
Notify (Timer.Hour_Subject);
end if;
if Timer.Minute /= Minute then
Timer.Minute := Minute;
Notify (Timer.Minute_Subject);
end if;
if Timer.Second /= Second then
Timer.Second := Second;
Notify (Timer.Second_Subject);
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
(Timer : access Clock_Timer)
return Hour_Number is
begin
return Timer.Hour;
end;
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Subject_Access is
begin
return Timer.Hour_Subject'Access;
end;
function Get_Minute
(Timer : access Clock_Timer)
return Minute_Number is
begin
return Timer.Minute;
end;
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Subject_Access is
begin
return Timer.Minute_Subject'Access;
end;
function Get_Second
(Timer : access Clock_Timer)
return Second_Number is
begin
return Timer.Second;
end;
function Get_Second_Subject
(Timer : access Clock_Timer)
return Subject_Access is
begin
return Timer.Second_Subject'Access;
end;
end Clock_Timers;
with Subjects_And_Observers; use 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;
function Get_Hour
(Timer : access Clock_Timer)
return Hour_Number;
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Subject_Access;
subtype Minute_Number is
Natural range 0 .. 59;
function Get_Minute
(Timer : access Clock_Timer)
return Minute_Number;
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Subject_Access;
subtype Second_Number is
Natural range 0 .. 59;
function Get_Second
(Timer : access Clock_Timer)
return Second_Number;
function Get_Second_Subject
(Timer : access Clock_Timer)
return 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 Subject_Type;
Minute : Integer := -1;
Minute_Subject : aliased Subject_Type;
Second : Integer := -1;
Second_Subject : aliased 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) is
Clock : Digital_Clock renames Observer.Clock.all;
Image : constant String :=
Integer'Image (Get_Hour (Clock.Timer) + 100);
begin
Put_Line ("new hour is " & Image (3 .. Image'Last));
end;
procedure Update
(Observer : access M_Obs_Type) is
Clock : Digital_Clock renames Observer.Clock.all;
Image : constant String :=
Integer'Image (Get_Minute (Clock.Timer) + 100);
begin
Put_Line ("new min is " & Image (3 .. Image'Last));
end;
procedure Update
(Observer : access S_Obs_Type) is
Clock : Digital_Clock renames Observer.Clock.all;
Image : constant String :=
Integer'Image (Get_Second (Clock.Timer) + 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
Attach
(Observer => Clock.H_Obs'Access,
To => Get_Hour_Subject (Clock.Timer));
Attach
(Observer => Clock.M_Obs'Access,
To => Get_Minute_Subject (Clock.Timer));
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
Detach
(Observer => Clock.H_Obs'Access,
From => Get_Hour_Subject (Clock.Timer));
Detach
(Observer => Clock.M_Obs'Access,
From => Get_Minute_Subject (Clock.Timer));
Detach
(Observer => Clock.S_Obs'Access,
From => Get_Second_Subject (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 Subjects_And_Observers;
type H_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access H_Obs_Type);
type M_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access M_Obs_Type);
type S_Obs_Type (Clock : access Digital_Clock) is
new Observer_Type with null record;
procedure Update
(Observer : access S_Obs_Type);
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 (Digital_Clock'Access);
M_Obs : aliased M_Obs_Type (Digital_Clock'Access);
S_Obs : aliased S_Obs_Type (Digital_Clock'Access);
-- 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) is
Observer : Observer_Access := Subject.Head;
begin
while Observer /= null loop
Update (Observer);
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;
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);
type Observer_Type is
abstract tagged limited private;
procedure Update
(Observer : access Observer_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
Do_Ticks;
declare
Another_Clock : Digital_Clock (Timer'Access);
begin
Do_Ticks;
declare
Yet_Another_Clock : Digital_Clock (Timer'Access);
begin
Do_Ticks;
end;
Do_Ticks;
end;
Do_Ticks;
end Test_Observers;
|
