Virtual Proxy Pattern

In this article I discuss how to implement the virtual proxy pattern in
Ada95.

Discussion

We'd like to optimize the amount of time it takes to open an image-rich
document.  The problem now is that every image in the file is getting
streamed in from disk and converted to its in-memory representation, and
this processing takes too long.

We can save start-up time by postponing initialization of an image until
it comes time to actually render it.  This technique is probably
familiar to those of you who have done X Windows programming.  Creating
every single dialog in the application up front can take a while, so you
wait until the user issues a pop-up request and just create the dialog
on-the-fly.

We perform this optimization by inserting image proxies in our document
instead of images.  An image proxy caches the information necessary to
initialize the image, but delays actual initialization until it receives
a request that can only be handled by the image itself.

Implementation

The example here closely follows the C++ example in the GoF book.  There
are two types, Image_Type and Image_Proxy, and both derive from the root
of the type hierarchy, Root_Graphic_Type.

In our implementation, the root type is declared in package Graphics,
the root of the subsystem:

package Graphics is

  type Root_Graphic_Type (<>) is abstract tagged limited private;
...
   procedure Draw
     (Graphic : access Root_Graphic_Type;
      Point   : in     Point_Type) is abstract;

   


   type Graphic_Handle is private;

   type Root_Graphic_Access is access all Root_Graphic_Type'Class;

   function "+" (Handle : Graphic_Handle) return Root_Graphic_Access;
...
end Graphics;


If you've been following my recent posts, you will recognize certain
idioms.  The tagged type is limited and indefinite to control how
instances are created, and there's a handle type for automatic memory
management.  The primitive operations take access parameters so that
dereferencing of access objects is done implicitly.

Following standard convention, the derived types are declared in
children of the package containing the declaration of the parent type.
Package Image_Proxies thus looks like this:

package Graphics.Image_Proxies is

   type Image_Proxy is new Root_Graphic_Type with private;

   

   function New_Image_Proxy (File : String) return Graphic_Handle;
...
end Graphics.Image_Proxies;


An image proxy has a pointer to an image, and a buffer for the image
data file name.  When asked to perform an operation requiring an actual
image, the image proxy will construct the image on-the-fly, passing the
file name to the image constructor.  The representation of the image
proxy therefore looks like this:

   type Image_Proxy is
     new Root_Graphic_Type with record
        Image  : Graphic_Handle;
        Name   : Unbounded_String;
        Extent : Point_Type;
     end record;


Proxy operations are implemented by creating the image if it doesn't
already exist, and then forwarding the same request to the image.
Here's a typical implementation:

   procedure Draw
     (Proxy : access Image_Proxy;
      Point : in     Point_Type) is
   begin
      ...
      Draw (Get_Image (Proxy), Point);
   end;


Get_Image is a local utility function that creates the image.  If the
image doesn't exist, then it calls the image constructor, passing it the
image data file name (that the proxy received during its own
construction):

   function Get_Image
     (Proxy : access Image_Proxy) return Root_Graphic_Access is

      use Images;
   begin

      if Proxy.Image = Null_Handle then
         Proxy.Image := New_Image (To_String (Proxy.Name));
      end if;

      return +Proxy.Image;

   end Get_Image;


Get_Image sets the image pointer of the proxy as a side-effect of the
call.  (This is possible because Image_Proxy is an access parameter.)
The last thing it does is to "dereference" the handle returned by the
image constructor, and return that as the result of the function.  That
value in turn is used by the caller as the argument to an image
operation.

The only other interesting operation is Free, which places the object
back into storage.  We need to finalize any resources being used by the
object prior to finalization of the object itself.  Free for the image
proxy looks like this:

   procedure Free (Proxy : access Image_Proxy) is

      use Proxy_Storage;
   begin

      Proxy.Name := Null_Unbounded_String;

      Proxy.Image := Null_Handle;

      Do_Free (Proxy);

   end Free;


Free finalizes the image by assigning the value null to the image
pointer.  Image reclamation is done automatically as a side-effect of
the assignment, because the image is designated by a smart pointer.

Matt



The files below are in a format suitable for use with gnatchop.

--STX
with Graphics.Images;
with Graphics.Storage;

with Ada.Text_IO; use Ada.Text_IO;

package body Graphics.Image_Proxies is

   package Proxy_Storage is
     new Graphics.Storage.Generic_Graphic (Image_Proxy);


   function Get_Image
     (Proxy : access Image_Proxy) return Root_Graphic_Access is

      use Images;

   begin

      if Proxy.Image = Null_Handle then
         Proxy.Image := New_Image (To_String (Proxy.Name));
      end if;

      return +Proxy.Image;

   end Get_Image;


   procedure Draw
     (Proxy : access Image_Proxy;
      Point : in     Point_Type) is
   begin
      Put_Line ("drawing image by way of proxy");
      Draw (Get_Image (Proxy), Point);
   end;


   procedure Handle_Mouse
     (Proxy : access Image_Proxy;
      Event : in     Event_Type) is
   begin
      Put_Line ("handling mouse by way of proxy");
      Handle_Mouse (Get_Image (Proxy), Event);
   end;


   function Get_Extent
     (Proxy : access Image_Proxy) return Point_Type is
   begin
      Put_Line ("getting extent by way of proxy");

      if Proxy.Extent = Zero_Point then
         Proxy.Extent := Get_Extent (Get_Image (Proxy));
      end if;

      return Proxy.Extent;
   end;


   function New_Image_Proxy (File : String) return Graphic_Handle is

      use Proxy_Storage;

      Handle : constant Graphic_Handle := New_Graphic;

      Proxy : constant Graphic_Access := Ref (Handle);

   begin

      Proxy.Name := To_Unbounded_String (File);

      Proxy.Extent := Zero_Point;

      return Handle;

   end New_Image_Proxy;


   procedure Free (Proxy : access Image_Proxy) is

      use Proxy_Storage;

   begin

      Proxy.Name := Null_Unbounded_String;

      Proxy.Image := Null_Handle;

      Do_Free (Proxy);

   end Free;

end Graphics.Image_Proxies;
with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;

package Graphics.Image_Proxies is

   type Image_Proxy is new Root_Graphic_Type with private;

   procedure Draw
     (Proxy : access Image_Proxy;
      Point : in     Point_Type);

   procedure Handle_Mouse
     (Proxy : access Image_Proxy;
      Event : in     Event_Type);

   function Get_Extent
     (Proxy : access Image_Proxy) return Point_Type;


   function New_Image_Proxy (File : String) return Graphic_Handle;

private

   type Image_Proxy is
     new Root_Graphic_Type with record
        Image  : Graphic_Handle;
        Name   : Unbounded_String;
        Extent : Point_Type;
     end record;

   procedure Free (Proxy : access Image_Proxy);

end Graphics.Image_Proxies;
with Graphics.Storage;
with Ada.Text_IO;      use Ada.Text_IO;

package body Graphics.Images is

   package Image_Storage is
     new Storage.Generic_Graphic (Image_Type);

   use Image_Storage;


   procedure Draw (Image : access Image_Type;
                   Point : in     Point_Type) is
   begin
      Put_Line ("drawing image with name '" &
                To_String (Image.Name) &
                "' at point " &
                Get_Image (Point));
   end Draw;


   procedure Handle_Mouse (Image : access Image_Type;
                           Event : in     Event_Type) is
   begin
      Put_Line ("image with name '" &
                To_String (Image.Name) &
                "' is handling mouse with event " &
                Event_Type'Image (Event));
   end Handle_Mouse;


   function Get_Extent
     (Image : access Image_Type) return Point_Type is
   begin
      return Image.Extent;
   end;


   function New_Image (File : String) return Graphic_Handle is

      Handle : constant Graphic_Handle := New_Graphic;

      Image : constant Graphic_Access := Ref (Handle);

   begin

      Image.Name := To_Unbounded_String (File);

      Image.Extent := Point_Type'(X => 80, Y => 132);

      return Handle;

   end New_Image;


   procedure Free (Image : access Image_Type) is
   begin
      Image.Name := Null_Unbounded_String;
      Do_Free (Image);
   end;

end Graphics.Images;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Graphics.Images is

   type Image_Type is new Root_Graphic_Type with private;

   procedure Draw (Image : access Image_Type;
                   Point : in     Point_Type);

   procedure Handle_Mouse (Image : access Image_Type;
                           Event : in     Event_Type);

   function Get_Extent
     (Image : access Image_Type) return Point_Type;


   function New_Image (File : String) return Graphic_Handle;

private

   type Image_Type is
     new Root_Graphic_Type with record
        Name   : Unbounded_String;
        Extent : Point_Type;
     end record;

   procedure Free (Image : access Image_Type);

end Graphics.Images;




package body Graphics.Storage is

   package body Generic_Graphic is

      Free_List : Root_Graphic_Access;


      function New_Graphic return Root_Graphic_Access is
      begin

         if Free_List = null then

            declare
               Graphic : constant Graphic_Access :=
                 Graphic_Access'(new Graphic_Type);
            begin
               return Root_Graphic_Access (Graphic);
            end;

         else

            declare
               Graphic : constant Root_Graphic_Access :=
                 Free_List;
            begin
               Free_List := Free_List.Next;
               Graphic.Next := null;

               return Graphic;
            end;

         end if;

      end New_Graphic;


      function New_Graphic return Graphic_Handle is

         Graphic : constant Root_Graphic_Access := New_Graphic;

         Handle : Graphic_Handle;

      begin

         Handle.Graphic := Graphic;

         Handle.Graphic.Count := 1;

         return Handle;

      end New_Graphic;


      function Ref (Handle : Graphic_Handle) return Graphic_Access is
      begin
         return Graphic_Access (Handle.Graphic);
      end;


      procedure Do_Free (Graphic : access Graphic_Type) is
      begin
         Graphic.Next := Free_List;
         Free_List := Root_Graphic_Access (Graphic);
      end;

   end Generic_Graphic;

end Graphics.Storage;


private package Graphics.Storage is

   generic
      type Graphic_Type is new Root_Graphic_Type with private;
   package Generic_Graphic is

      type Graphic_Access is access all Graphic_Type;

      function New_Graphic return Graphic_Handle;

      function Ref (Handle : Graphic_Handle) return Graphic_Access;


      procedure Do_Free (Graphic : access Graphic_Type);

   end Generic_Graphic;

end Graphics.Storage;


package body Graphics is

   function Get_Image (Point : Point_Type) return String is

      X : constant String := Integer'Image (Point.X);
      Y : constant String := Integer'Image (Point.Y);
   begin
      return "(" & X (2 .. X'Last) & "," & Y & ")";
   end;



   function "+" (Handle : Graphic_Handle) return Root_Graphic_Access is
   begin
      return Handle.Graphic;
   end;


   procedure Free (Graphic : access Root_Graphic_Type) is
   begin
      null;
   end;


   procedure Adjust (Handle : in out Graphic_Handle) is
   begin
      if Handle.Graphic /= null then

         Handle.Graphic.Count := Handle.Graphic.Count + 1;

      end if;
   end Adjust;


   procedure Finalize (Handle : in out Graphic_Handle) is
   begin
      if Handle.Graphic /= null then

         Handle.Graphic.Count := Handle.Graphic.Count - 1;

         if Handle.Graphic.Count = 0 then
            Free (Handle.Graphic);
         end if;

      end if;
   end Finalize;


end Graphics;



with Ada.Finalization; use Ada.Finalization;

package Graphics is

   type Root_Graphic_Type (<>) is abstract tagged limited private;

   type Root_Graphic_Access is access all Root_Graphic_Type'Class;


   type Point_Type is
      record
         X, Y : Integer;
      end record;

   Zero_Point : constant Point_Type := (X => 0, Y => 0);

   function Get_Image (Point : Point_Type) return String;

   type Event_Type is (Mouse_Up, Mouse_Down, Button_Press);


   procedure Draw
     (Graphic : access Root_Graphic_Type;
      Point   : in     Point_Type) is abstract;

   procedure Handle_Mouse
     (Graphic : access Root_Graphic_Type;
      Event   : in     Event_Type) is abstract;

   function Get_Extent
     (Graphic : access Root_Graphic_Type) return Point_Type is abstract;


   type Graphic_Handle is private;

   Null_Handle : constant Graphic_Handle;

   function "+" (Handle : Graphic_Handle) return Root_Graphic_Access;

private

   type Root_Graphic_Type is
     abstract tagged limited record
        Count : Natural;
        Next  : Root_Graphic_Access;
     end record;

   procedure Free (Graphic : access Root_Graphic_Type);


   type Graphic_Handle is
     new Controlled with record
        Graphic : Root_Graphic_Access;
     end record;

   procedure Adjust (Handle : in out Graphic_Handle);

   procedure Finalize (Handle : in out Graphic_Handle);

   Null_Handle : constant Graphic_Handle :=
     (Controlled with Graphic => null);

end Graphics;



with Graphics;                use Graphics;
with Graphics.Images;         use Graphics.Images;
with Graphics.Image_Proxies;  use Graphics.Image_Proxies;

with Ada.Text_IO; use Ada.Text_IO;

procedure Test_Proxy is

   procedure Do_Stuff_To
     (Graphic : access Root_Graphic_Type'Class) is
   begin

      Draw (Graphic, Point_Type'(3, 4));
      New_Line;

      Handle_Mouse (Graphic, Mouse_Up);
      New_Line;

      declare
         Extent : constant Point_Type := Get_Extent (Graphic);
      begin
         Put_Line ("extent is " & Get_Image (Extent));
         New_Line;
      end;

   end Do_Stuff_To;


   Image : constant Graphic_Handle :=
     New_Image ("myimage.dat");

   Proxy : constant Graphic_Handle :=
     New_Image_Proxy ("myimageproxy.dat");

begin

   Put_Line ("do stuff to image:");
   New_Line;
   Do_Stuff_To (+Image);

   New_Line;
   Put_Line ("do stuff to proxy:");
   New_Line;
   Do_Stuff_To (+Proxy);

end Test_Proxy;