One criticism of the canonical Observer pattern is that the subject has
to provide a lot of selector functions exclusively for the benefit of
observers.
By making the relationship between subject and observer more intimate,
we can clean up the interface of the subject, and simplify the
implementation of the observer.
Implementation
We declare the observer as a (public) child of the subject, which gives
the observer direct access to all the subject's state.
Knowing that the observer is a child means the subject can get rid of
its selector functions, because they were only there to allow the
observer to get the state it can now get directly:
package Clock_Timers is
type Clock_Timer is limited private;
procedure Tick
(Timer : in out Clock_Timer);
private
...
end Clock_Timers;
The clock timer subject is otherwise unchanged.
The digital clock is now a child of the clock timer package:
package Clock_Timers.Digital_Clocks is
type Digital_Clock (Timer : access Clock_Timer) is
limited private;
private
...
end Clock_Timers.Digital_Clocks;
The spec of the Digital_Clock is otherwise unchanged. In the body, the
observer just refers to the subject's state directly, instead of
invoking the subject's selector function:
procedure Update
(Observer : access H_Obs_Type) is
Clock : Digital_Clock renames Observer.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
Image : constant String :=
Integer'Image (Timer.Hour + 100); <--!!!
^^^^^^^^^^
begin
Put_Line ("new hour is " & Image (3 .. Image'Last));
end;
procedure Initialize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
begin
Attach
(Observer => Clock.H_Obs'Access,
To => Timer.Hour_Subject'Access); <--!!!
^^^^^^^^^^^^^^^^^^
Attach
(Observer => Clock.M_Obs'Access,
To => Timer.Minute_Subject'Access); <--!!!
^^^^^^^^^^^^^^^^^^^^
Attach
(Observer => Clock.S_Obs'Access,
To => Timer.Second_Subject'Access); <--!!!
^^^^^^^^^^^^^^^^^^^^
end Initialize;
You should be concerned when anyone argues that "the model should
display itself," since you want to separate the application modeling
from the user interface processing as much as possible.
However, making the view a child of the model is a nice compromise,
because it gives the view easier access to the model's state, and still
cleanly separates the view processing from the model.
The model now includes the view as part of its own subsystem, so it is
in this sense that we can say "the model displays itself."
--STX
with Ada.Text_IO; use Ada.Text_IO;
package body Clock_Timers.Digital_Clocks is
procedure Update
(Observer : access H_Obs_Type) is
Clock : Digital_Clock renames Observer.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
Image : constant String :=
Integer'Image (Timer.Hour + 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;
Timer : Clock_Timer renames Clock.Timer.all;
Image : constant String :=
Integer'Image (Timer.Minute + 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;
Timer : Clock_Timer renames Clock.Timer.all;
Image : constant String :=
Integer'Image (Timer.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;
Timer : Clock_Timer renames Clock.Timer.all;
begin
Attach
(Observer => Clock.H_Obs'Access,
To => Timer.Hour_Subject'Access);
Attach
(Observer => Clock.M_Obs'Access,
To => Timer.Minute_Subject'Access);
Attach
(Observer => Clock.S_Obs'Access,
To => Timer.Second_Subject'Access);
end Initialize;
procedure Finalize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
Timer : Clock_Timer renames Clock.Timer.all;
begin
Detach
(Observer => Clock.H_Obs'Access,
From => Timer.Hour_Subject'Access);
Detach
(Observer => Clock.M_Obs'Access,
From => Timer.Minute_Subject'Access);
Detach
(Observer => Clock.S_Obs'Access,
From => Timer.Second_Subject'Access);
end Finalize;
end Clock_Timers.Digital_Clocks;
with Subjects_And_Observers;
with Ada.Finalization;
package Clock_Timers.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 Clock_Timers.Digital_Clocks;
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
subtype Hour_Number is
Natural range 0 .. 23;
Hour : constant Hour_Number :=
Timer.Current_Time / 3600;
subtype Minute_Number is
Natural range 0 .. 59;
Minute : constant Minute_Number :=
(Timer.Current_Time - 3600 * Hour) / 60;
subtype Second_Number is
Natural range 0 .. 59;
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;
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);
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;
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.Digital_Clocks; use Clock_Timers,
Clock_Timers.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;
|