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