AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Home >
Articles >
Getting Started >
Ada FAQ >
Source Treasury >
Books & Tutorials >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Models That View Themselves (Matthew Heaney)

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;


(c) 1998-2004 All Rights Reserved David Botton