Sunday, November 8, 2009

The Observer Design Pattern in Delphi – Pull

As mentioned in the previous article The Observer Design Pattern in Delphi – Push I intended to do a “Pull” article to show, what I think is, a significant “feature” of this pattern and one that I thought was underplayed in the Head First Design Patterns book that I’m learning from.

I wrote code for this article a couple of times and in the end simply refactored the code from the previous article for simplicity and consistency.  The primary reason I was looking at different code is that I find the Weather Station metaphor a bit weak, as it doesn’t show the significant difference between Push and Pull to advantage.  Push, Pull who cares ... it’s a handful of simple data types and an observer pattern is just an observer pattern.  Sorry, not quite my perspective on it.  As it is, with just the refactored code, observers are being notified who don’t need to be but I’ll leave that concept to you to develop on your own.

So, to the code.  I’ve actually changed quite a bit of it although the actual concept change is not complicated and is, in fact, quite easy to understand.  What we had was an Information Provider that shoved all of it’s data at the consumers in one massive hunk and did that every time any one specific item changed.  It was left to the consumer to decide what was of use, and discard the remainder.  Now we have modified the Provider to send a flag telling the consumers, not only that there has been a change, but what has changed.  Now it is up to the consumer, using a stored reference to the provider, to fetch any information it might be interested in.  The consumers still use the same methods to let the provider know that it is, or is not, interested in receiving information.  For the sake of the provided code, the extent to which we have broken down the tasks is sufficient.  As I’ve mentioned, telling only the consumers that need to know about a specific change in data, would be the next step in improving what we have.

The uObservable Unit

I’ve combined the two original primary object class files into one.  Personal Lesson Learned: Don’t be so damn anal about having every class/concept squirreled away in it’s own unit.  The Observable and Observer root classes are very closely related, they don’t really have much in the way of secrets from each other, and they fit into a single unit quite nicely.  Circular reference ... be gone!  The specific changes in this unit are as follows:
  • added an enumerator to work as a flag specific to what has been changed,
  • modified the TObservable root class method NotifyObservers to include a flag indicating what to notify Observers of,
  • modified the TBaseObserver root class method UpDate removing all the data it was sending and reducing it to a flag indicating what changed.
unit uObservable;

interface

type
  TUpdateType = (utTemperature, utHumidity, utPressure);

  TBaseObserver = class;
  TDisplayObserver = class;

  TObservable = class(TObject)
    procedure NotifyObservers(UpdateType: TUpdateType); virtual; abstract;
    procedure RegisterObserver(Observer: TBaseObserver); virtual; abstract;
    procedure RemoveObserver(Observer: TBaseObserver); virtual; abstract;
  end;

  TBaseObserver = class(TObject)
  public
    procedure UpDate(UpdateType: TUpdateType); virtual; abstract;
  end;

  TDisplayObserver = class(TBaseObserver)
  public
    procedure Display; virtual; abstract;
  end;

implementation

end.

The WeatherStation Unit

This unit has changed quite a bit but most of the new code is in initializing and monitoring the measurement data.  The base concept has been changed from pushing information at the observers to leaving it up to them to pull what they need.  Now it just sends out a notice to each observer that a piece of data has changed, so the observers can retrieve the changed data if it wants it.  The specific changes in this unit are as follows:
  • added getters to the three measured data properties – all getters and setters are private,
  • refactored the SetMeasurements method to InitialiseMeasurements and added a call to the object’s Create event,
  • nuked the MeasurementsChanged method [it did very little] and replaced it with CheckCurConditions to simulate continuous monitoring,
  • coded the new measured data [Temperature, Pressure and Humidity] value setters to store data received and start the notification process,
  • wrapped all user input code in a big Try-Except to keep the code simple and not check each input value.
unit WeatherStation;

interface

uses
  SysUtils,
  Classes,
  uObservable;

type
  TWeatherStation = class(TObservable)
  private
    FHumidity: Single;
    FPressure: Single;
    FTemperature: Single;
    Observers: TList;
    function GetHumidity: Single;
    function GetPressure: Single;
    function GetTemperature: Single;
    procedure NotifyObservers(UpdateType: TUpdateType); override;
    procedure SetHumidity(const Value: Single);
    procedure SetPressure(const Value: Single);
    procedure SetTemperature(const Value: Single);
  public
    constructor Create;
    destructor Destroy; override;
    procedure CheckCurConditions;
    procedure InitialiseMeasurements;
    procedure RegisterObserver(Observer: TBaseObserver); override;
    procedure RemoveObserver(Observer: TBaseObserver); override;
    property Humidity: Single read GetHumidity write SetHumidity;
    property Pressure: Single read GetPressure write SetPressure;
    property Temperature: Single read GetTemperature write SetTemperature;
  end;

implementation

constructor TWeatherStation.Create;
begin
  inherited;
  Observers := TList.Create;
  Writeln('The Weather Station is up and running.');
  Writeln;
  InitialiseMeasurements;
end;

destructor TWeatherStation.Destroy;
begin
  Observers.Free;
  inherited;
end;

procedure TWeatherStation.CheckCurConditions;
var
  Finished: Boolean;
  MonitorUnit: string;
  MonitorVal: Single;
begin
  {CheckCurConditions loops through all the monitoring units
   and checks for changes. User input is used in this case.}
  Finished := False;
  repeat
    MonitorUnit := '';
    MonitorVal := 0;
    Writeln;
    write('Enter [T]emperature, [P]ressure, [H]umdity or [Q]uit. ');
    Readln(MonitorUnit);
    MonitorUnit := lowercase(Trim(MonitorUnit));
    try
      if MonitorUnit = 't' then
        begin
          write('Enter the Current Temperature   [F]: ');
          Readln(MonitorVal);
          Temperature := MonitorVal;
        end
      else if MonitorUnit = 'p' then
        begin
          write('Enter the Current Pressure:  [" Hg]: ');
          Readln(MonitorVal);
          Pressure := MonitorVal;
        end
      else if MonitorUnit = 'h' then
        begin
          write('Enter the current Humidity      [%]: ');
          Readln(MonitorVal);
          Humidity := MonitorVal;
        end
      else if MonitorUnit = 'q' then
        Finished := True
      else
        Writeln('That input is not valid. Please try again.');
    except
      begin
        Writeln;
        Writeln('That didn'' work out so well ... please try again.');
      end;
    end;
  until Finished;
end;

function TWeatherStation.GetHumidity: Single;
begin
  Result := FHumidity;
end;

function TWeatherStation.GetPressure: Single;
begin
  Result := FPressure;
end;

function TWeatherStation.GetTemperature: Single;
begin
  Result := FTemperature;
end;

procedure TWeatherStation.InitialiseMeasurements;
begin
  try
    Writeln('Enter the values as prompted and press Enter after each one.');
    write('Current Temperature   [F]: ');
    Readln(FTemperature);
    write('Current Humidity      [%]: ');
    Readln(FHumidity);
    write('Current Pressure:  [" Hg]: ');
    Readln(FPressure);
    Writeln;
  except
    begin
      Writeln;
      Writeln('That didn'' work out so well ... I''ve done it for you.');
      FTemperature := 70.5;
      FHumidity := 68.25;
      FPressure := 29.65;
      Writeln('Tenperature is 70.5, Humidity is 68.25% and Pressure is 29.65');
    end;
  end;
end;

procedure TWeatherStation.NotifyObservers(UpdateType: TUpdateType);
var
  i: Integer;
begin
  if Assigned(Observers) then
    begin
      for i := 0 to Observers.Count - 1 do
        TBaseObserver(Observers[i]).Update(UpdateType);
    end;
end;

procedure TWeatherStation.RegisterObserver(Observer: TBaseObserver);
begin
  if Observer is TBaseObserver then
    Observers.Add(Observer);
end;

procedure TWeatherStation.RemoveObserver(Observer: TBaseObserver);
begin
  if (Observer is TBaseObserver) and (Observers.IndexOf(Observer) <> -1) then
    Observers.Remove(Observer);
end;

procedure TWeatherStation.SetHumidity(const Value: Single);
begin
  FHumidity := Value;
  NotifyObservers(utHumidity);
end;

procedure TWeatherStation.SetPressure(const Value: Single);
begin
  FPressure := Value;
  NotifyObservers(utPressure);
end;

procedure TWeatherStation.SetTemperature(const Value: Single);
begin
  FTemperature := Value;
  NotifyObservers(utTemperature);
end;

end.

The Display Observers

All the display device units, having given them some work to do, received pretty much exactly the same refactoring.
  • added a strict private reference to the Information Source which gets set during construction,
  • the constructor has quite a bit of new code to initialize the display with current data from the Weather Station when it is created,
  • the UpDate method has quite a bit of new code with the transfer of the responsibility of retrieving any required data from the Weather Station to the device,
  • the constructor and UpDate method code, in all Display units, is each wrapped in one big Try-Except providing a bit of a safety net for the local provider reference,
  • added a destructor to unregister the display when it gets freed,
  • a minor change moving the Display method to the private section.

Current Conditions Display

unit CurCondDisplay;

interface

uses
  SysUtils,
  uObservable,
  WeatherStation;

type
  TCurrentConditions = class(TDisplayObserver)
  strict private
    FDataSource: TWeatherStation;
  private
    Temperature: single;
    Humidity: single;
    Pressure: single;
    destructor Destroy; override;
    procedure Display; override;
  public
    constructor Create(Source: TWeatherStation);
    procedure Update(UpdateType: TUpdateType); override;
  end;

implementation

constructor TCurrentConditions.Create(Source: TWeatherStation);
begin
  inherited Create;
  try
    FDataSource := Source;
    FDataSource.RegisterObserver(Self);
    Temperature := FDataSource.Temperature;
    Pressure := FDataSource.Pressure;
    Humidity := FDataSource.Humidity;
    Writeln('Current Conditions Display is initialized, up and running.');
    Display;
  except
    Writeln('Something went wrong in the Current Conditions Display Creation.');
  end;
end;

destructor TCurrentConditions.Destroy;
begin
  FDataSource.RemoveObserver(Self);
  inherited;
end;

procedure TCurrentConditions.Display;
begin
  Writeln;
  Writeln('***** Current Weather Conditions *****');
  Writeln('The Temperature is ' + Format('%1.5g', [Temperature]) + ' Degrees F,');
  Writeln('Humidity is at ' + Format('%1.5g', [Humidity]) + '% and');
  Writeln('the Pressure is currently ' + Format('%1.5g', [Pressure]) + '" Hg.');
  Writeln('*********** End of Report ************');
  Writeln;
end;

procedure TCurrentConditions.Update(UpdateType: TUpdateType);
var
  OutNotice, ValStr: string;
begin
  OutNotice := 'Current Conditions Display has received new %s notification.';
  try
    case UpdateType of
      utTemperature:
        begin
          Temperature := FDataSource.Temperature;
          ValStr := 'Temperature';
        end;
      utHumidity:
        begin
          Humidity := FDataSource.Humidity;
          ValStr := 'Humidity';
        end;
      utPressure:
        begin
          Pressure := FDataSource.Pressure;
          ValStr := 'Pressure';
        end;
    end;
  except
    Writeln('Something went wrong in the Current Conditions Display UpDate.');
  end;

  Writeln;
  Writeln(Format(OutNotice, [ValStr]));

  case UpdateType of
    utTemperature, utHumidity, utPressure: Display;
  end;
end;

end.

Forecast Display

unit ForecastDisplay;

interface

uses
  SysUtils,
  uObservable,
  WeatherStation;

type
  TForecastConditions = class(TDisplayObserver)
  strict private
    FDataSource: TWeatherStation;
  private
    CurPressure: single;
    LastPressure: single;
    destructor Destroy; override;
    procedure Display; override;
  public
    constructor Create(Source: TWeatherStation);
    procedure Update(UpdateType: TUpdateType); override;
  end;

implementation

constructor TForecastConditions.Create(Source: TWeatherStation);
begin
  try
    inherited Create;
    FDataSource := Source;
    FDataSource.RegisterObserver(Self);
    CurPressure := 29.92;
    LastPressure := CurPressure;
    Writeln('Forecast Display is initialized, up and running.');
    Display;
  except
    Writeln('Something went wrong in the Current Conditions Display Creation.');
  end;
end;

destructor TForecastConditions.Destroy;
begin
  FDataSource.RemoveObserver(Self);
  inherited;
end;

procedure TForecastConditions.Display;
begin
  Writeln;
  Writeln('***** Current Weather Forecast *****');
  if CurPressure = LastPressure then
    Writeln('More of the same.')
  else if CurPressure > LastPressure then
    Writeln('Improving weather on the way!')
  else
    Writeln('Watch out for cooler, rainy weather.');
  Writeln('*********** End of Report ************');
  Writeln;
end;

procedure TForecastConditions.Update(UpdateType: TUpdateType);
var
  OutNotice, ValStr: string;
begin
  OutNotice := 'Forecast Display has received new %s notification.';
  try
    case UpdateType of
      utTemperature, utHumidity: ValStr := 'irrelevant';
      utPressure:
        begin
          CurPressure := FDataSource.Pressure;
          ValStr := 'Pressure';
        end;
    end;
  except
    Writeln('Something went wrong in the Forecast Display UpDate.');
  end;

  Writeln;
  Writeln(Format(OutNotice, [ValStr]));

  case UpdateType of
    utPressure: Display;
  end;
end;

end.

Heat Index Display

unit HeatIndexDisplay;

interface

uses
  SysUtils,
  uObservable,
  WeatherStation;

type
  THeatIndex = class(TDisplayObserver)
  strict private
    FDataSource: TWeatherStation;
    destructor Destroy; override;
  private
    Temp: single;
    RelHum: single;
    procedure Display; override;
  public
    constructor Create(Source: TWeatherStation);
    procedure Update(UpdateType: TUpdateType); override;
  end;

implementation

constructor THeatIndex.Create(Source: TWeatherStation);
begin
  try
    inherited Create;
    FDataSource := Source;
    FDataSource.RegisterObserver(Self);
    Temp := FDataSource.Temperature;
    RelHum := FDataSource.Humidity;
    Writeln('Heat Index Display is initialized, up and running.');
    Display;
  except
    Writeln('Something went wrong in the Current Conditions Display Creation.');
  end;
end;

destructor THeatIndex.Destroy;
begin
  FDataSource.RemoveObserver(Self);
  inherited;
end;

procedure THeatIndex.Display;
var
  HeatIndex: single;
begin
  if Temp >= 70 then
    HeatIndex := 16.922999999999998 + 0.185212 * Temp + 5.37941 * RelHum -
      (0.100254 * Temp * RelHum) + 0.00941695 * Temp * Temp + 0.00728898 *
      RelHum * RelHum + 0.000345372 * Temp * Temp * RelHum -
      (0.000814971 * Temp * RelHum * RelHum)
      + 1.02102E-005 * Temp * Temp * RelHum * RelHum -
      (3.8646E-005 * Temp * Temp * Temp) + 2.91583E-005 * RelHum * RelHum *
      RelHum + 1.42721E-006 * Temp * Temp * Temp * RelHum + 1.97483E-007 *
      Temp * RelHum * RelHum * RelHum -
      (2.18429E-008 * Temp * Temp * Temp * RelHum * RelHum)
      + 8.43296E-010 * Temp * Temp * RelHum * RelHum * RelHum -
      (4.81975E-011 * Temp * Temp * Temp * RelHum * RelHum * RelHum)
  else
    HeatIndex := 0;

  Writeln;
  Writeln('********* Current Heat Index *********');

  if HeatIndex > 0 then
    Writeln('The Heat Index is ' + Format('%f', [HeatIndex]) + ' Degrees F.')
  else
    Writeln('Temp is less than 70F, the Heat Index is irrelevant.');

  Writeln('*********** End of Report ************');
  Writeln;
end;

procedure THeatIndex.Update(UpdateType: TUpdateType);
var
  OutNotice, ValStr: string;
begin
  OutNotice := 'Heat Index Display has received new %s notification.';
  try
    case UpdateType of
      utTemperature:
        begin
          Temp := FDataSource.Temperature;
          ValStr := 'Temperature';
        end;
      utHumidity:
        begin
          RelHum := FDataSource.Humidity;
          ValStr := 'RelHum';
        end;
      utPressure: ValStr := 'irrelevant';
    end;
  except
    Writeln('Something went wrong in the Heat Index Display UpDate.');
  end;

  Writeln;
  Writeln(Format(OutNotice, [ValStr]));

  case UpdateType of
    utTemperature, utHumidity: Display;
  end;
end;

end.

The PullWeather Test Unit

program PullWeather;
{$APPTYPE CONSOLE}

uses
  SysUtils,
  uObservable in 'uObservable.pas',
  WeatherStation in 'WeatherStation.pas',
  CurCondDisplay in 'CurCondDisplay.pas',
  ForecastDisplay in 'ForecastDisplay.pas',
  HeatIndexDisplay in 'HeatIndexDisplay.pas';

var
  MyStation: TWeatherStation;
  CurCondDisp: TCurrentConditions;
  ForecastDisp: TForecastConditions;
  HeatIndexDisp: THeatIndex;

begin
  ReportMemoryLeaksOnShutdown := DebugHook <> 0;

  try
    // Create and initialize the station.
    MyStation := TWeatherStation.Create;
    // Create the consumers.
    CurCondDisp := TCurrentConditions.Create(MyStation);
    ForecastDisp := TForecastConditions.Create(MyStation);
    HeatIndexDisp := THeatIndex.Create(MyStation);
    //Run the Station Conditions Monitoring code.
    MyStation.CheckCurConditions;
  finally
    HeatIndexDisp.Free;
    ForecastDisp.Free;
    CurCondDisp.Free;
    MyStation.Free;
  end;

end.

JD-GUI - Java Browsing Tool

The freeware JD-GUI a standalone graphical utility that displays Java source codes of “.class” files has been a great help to me for having a formatted peek into the book related Java files that are available from the HFDP site at Head First Labs.  If you are looking for something along this line, I highly recommend it.

Using Classes instead of Interfaces

There was a bit of discussion with the Strategy Pattern post that I did on my use of Interfaces.  Now, because a pattern is a pattern is a pattern and should be applicable whatever code structure you decide to use, I am using and will stick to classes alone for as long as it is possible.  My only concern with this decision is that what I am producing is not a direct translation of the Java code, which is still my sole intent but if you can live with my choice ... so can I.

In Closing ...

The above is summary and [my rendition of] the Delphi code taken from the second chapter of the book, Head First Design Patterns from O’Reilly.
As I mentioned in the first post in this series, I’m studying Design Patterns using the Head First Design Patterns book from O’Reilly.   As part of this learning process I’m working through the existing examples written in Java and recreating them in Delphi.  This is the forth post in the series and the third that actually deals with one of the design patterns.  The first post in the series also provides a list of additional resources on Design Patterns in Delphi that I’ve managed to track down.  I must mention again that I don’t plan on teaching you design patterns, as that would be quite presumptuous of me considering that I’m just a student of them myself.  I do intend to provide simply an overview of what I’ve learned and the resulting code I produced in the process.
Thanks for stopping by ...
Dave

2 comments:

  1. Actually, this is very much how the whole notification mechanism with TDataSet, TDataSource and data aware controls works in Delphi, with one big difference: you send a context that not only includes that there is a change, but also what is changed.

    The context is invaluable!

    --jeroen

    ReplyDelete
  2. Jeroen, many thanks for your comment. I will look into the components you have pointed out to have a look at the pattern in a real world application. In the example I used, I wanted to pass as little information as possible to highlight the fact that the Observers had to pull the information they wanted.

    Thanks again,
    -- Dave

    ReplyDelete