A memento is an alternate representation of another object, often in a
format suitable for transmission across an external interface.
This is especially useful for "type-ifying" a state machine package, or
for converting a limited value to a non-limited representation, so you
can copy the data or write it to disk.
Ada programmers should already be familiar with this pattern, because
it's used by the random number library (RM95 A.5.2) to save and restore
the state of a generator:
type Generator is limited private;
...
type State is private;
procedure Save (Gen : Generator; To_State : out State);
procedure Reset (Gen : Generator; From_State : State);
You can even convert the state to a string, allowing you to write the
state to an ordinary text file, or transmit it across an interface:
function Image (Of_State : State) return String;
function Value (Coded_State : String) return State;
The constraint solver abstraction in the example is a singleton
(implemented here as a state machine package) with operations to get and
set its state:
package Constraint_Solver is
procedure Solve;
...
type State_Type is private;
function Get_State return State_Type;
procedure Set_State (State : in State_Type);
...
end Constraint_Solver;
During its execution, the move command uses a memento to cache the value
of the constraint solver prior to invoking state-changing operations:
procedure Execute (Command : in out Move_Command_Type) is
begin
Command.State := Constraint_Solver.Get_State; <--
Move (+Command.Target, Point => Command.Diff);
Constraint_Solver.Solve;
end;
This allows the command to implement undo, by restoring the constraint
solver to its state prior to executing the command:
procedure Unexecute (Command : in out Move_Command_Type) is
begin
Move (+Command.Target, Point => -Command.Diff);
Constraint_Solver.Set_State (Command.State); <--
Constraint_Solver.Solve;
end;
--STX
with Graphics; use Graphics;
package Constraint_Solver is
procedure Solve;
procedure Add_Constraint
(Start_Connection : in Graphic_Handle;
End_Connection : in Graphic_Handle);
procedure Remove_Constraint
(Start_Connection : in Graphic_Handle;
End_Connection : in Graphic_Handle);
type State_Type is private;
function Get_State return State_Type;
procedure Set_State (State : in State_Type);
private
type State_Type is
record
I : Integer;
end record;
end Constraint_Solver;
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 "-" (Point : Point_Type) return Point_Type;
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 Move
(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;
package body Move_Commands is
function To_Move_Command
(Target : Graphic_Handle;
Diff : Point_Type) return Move_Command_Type is
Command : Move_Command_Type;
begin
Command.Diff := Diff;
Command.Target := Target;
return Command;
end;
procedure Execute (Command : in out Move_Command_Type) is
begin
Command.State := Constraint_Solver.Get_State;
Move (+Command.Target, Point => Command.Diff);
Constraint_Solver.Solve;
end;
procedure Unexecute (Command : in out Move_Command_Type) is
begin
Move (+Command.Target, Point => -Command.Diff);
Constraint_Solver.Set_State (Command.State);
Constraint_Solver.Solve;
end;
end Move_Commands;
with Constraint_Solver;
with Graphics; use Graphics;
package Move_Commands is
type Move_Command_Type is private;
function To_Move_Command
(Target : Graphic_Handle;
Diff : Point_Type) return Move_Command_Type;
procedure Execute (Command : in out Move_Command_Type);
procedure Unexecute (Command : in out Move_Command_Type);
private
type Move_Command_Type is
record
State : Constraint_Solver.State_Type;
Diff : Point_Type;
Target : Graphic_Handle;
end record;
end Move_Commands;
|
