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