Memento Pattern

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;