unit DUNDO.Manager;

interface
uses
  generics.collections, sysutils;

const
  IID_IUndoableObject: TGUID = '{9FA74FBE-5558-4D2F-A736-6194EA68C2BC}';
type
  TUndoObjectPathRec = record
    ObjType: integer;
    ObjIndex: integer;
    constructor New(OType: integer; OIndex: integer);
  end;

  TUndoObjectPath = TList<TUndoObjectPathRec>;

  IUndoableObject = interface
    ['{9FA74FBE-5558-4D2F-A736-6194EA68C2BC}']
     function Insert(Obj: TObject; Path: TUndoObjectPath): boolean;
     function Delete(Path: TUndoObjectPathRec): boolean;
     function Move(OldPath, NewPath: TUndoObjectPathRec): boolean;
     function Clone: IUndoableObject;
     function GetPath(Obj: TObject): TUndoObjectPathRec;
     function GetParent: IUndoableObject;
     function GetSelf: TObject;
  end;

  IUndoableHost = interface
     function GetObject(Path: TUndoObjectPath): TObject;
     procedure AddProperty(Obj: IUndoableObject; const PropName: string; Value: Variant);
     procedure AddObjDelete(ParentObj: IUndoableObject; DeletedObj: IUndoableObject);
     procedure AddObjInsert(ParentObj: IUndoableObject; NewLocation: TUndoObjectPathRec);
     procedure AddObjReorder(ParentObj: IUndoableObject; OldLocation, NewLocation: TUndoObjectPathRec);
  end;

  TUndoElement = class
  type
    TUndoChangeType = (uctUnknown, uctPropertyChange, uctAdd, uctDelete, uctMove);
  private
    FPath: TUndoObjectPath;
  protected
    class function GetChangeType: TUndoChangeType; virtual;
    procedure CreatePath(Obj: IUndoableObject);
  public
    constructor Create(Obj: IUndoableObject); virtual;
    destructor Destroy; override;
    function Process(AnObject: TObject): boolean; virtual; abstract;
    property ChangeType: TUndoChangeType read GetChangeType;
    property Path: TUndoObjectPath read FPath;
  end;

  TUndoProperty = class(TUndoElement)
  private
    FPropName: string;
    FValue: Variant;
  protected
    class function GetChangeType: TUndoElement.TUndoChangeType; override;
  public
    function Process(AnObject: TObject): boolean; override;
    property PropName: string read FPropName write FPropName;
    property Value: Variant read FValue write FValue;
  end;

  TUndoAddObject = class(TUndoElement)
  protected
    FLocation: TUndoObjectPathRec;
    class function GetChangeType: TUndoElement.TUndoChangeType; override;
  public
    function Process(AnObject: TObject): boolean; override;
    property Location: TUndoObjectPathRec read FLocation write FLocation;
  end;

  TUndoMoveObject = class(TUndoAddObject)
  private
    FOldLocation: TUndoObjectPathRec;
  protected
    class function GetChangeType: TUndoElement.TUndoChangeType; override;
  public
    function Process(AnObject: TObject): boolean; override;
    property OldLocation: TUndoObjectPathRec read FOldLocation write FOldLocation;
  end;

  TUndoDeleteObject = class(TUndoAddObject)
  private
    FObj: TObject;
    procedure SetObj(const Value: TObject);
  protected
    class function GetChangeType: TUndoElement.TUndoChangeType; override;
  public
    destructor Destroy; override;
    function Process(AnObject: TObject): boolean; override;
    property Obj: TObject read FObj write SetObj;
  end;

  TUndoStack = TObjectStack<TUndoElement>;

  TUndoManager = class
  type
    TCurrentState = (csDoing, csUndoing);
  private
    FUndoStack: TUndoStack;
    FRedoStack: TUndoStack;
    FCurrentState: TCurrentState;
    FHostObject: IUndoableHost;
    function GetCanUndo: boolean;
    function GetRedo: boolean;
    procedure PushElement(UndoElement: TUndoElement);
  public
    constructor Create(Host: IUndoableHost); virtual;
    destructor Destroy; override;
    procedure AddProperty(Obj: IUndoableObject; const PropName: string; Value: Variant);
    procedure AddObjDelete(ParentObj: IUndoableObject; DeletedObj: IUndoableObject);
    procedure AddObjInsert(ParentObj: IUndoableObject; NewLocation: TUndoObjectPathRec);
    procedure AddObjReorder(ParentObj: IUndoableObject; OldLocation, NewLocation: TUndoObjectPathRec);
    function DoUndo: boolean;
    function DoRedo: boolean;
    procedure Clear;
    property CanUndo: boolean read GetCanUndo;
    property CanRedo: boolean read GetRedo;
    property HostObject: IUndoableHost read FHostObject;
  end;

implementation

uses DUNDO.RTTI;

{ TUndoElement }

constructor TUndoElement.Create(Obj: IUndoableObject);
begin
  FPath := TUndoObjectPath.Create;
  CreatePath(Obj);
end;

procedure TUndoElement.CreatePath(Obj: IUndoableObject);
var
  Parent: IUndoableObject;
begin
  Parent := Obj.GetParent;
  while Parent <> nil do
  begin
    FPath.Add(Parent.GetPath(Obj.GetSelf));
    Obj := Parent;
    Parent := Obj.GetParent;
  end;
end;

destructor TUndoElement.Destroy;
begin
  FreeAndNil(FPath);
  inherited;
end;

class function TUndoElement.GetChangeType: TUndoChangeType;
begin
  result := uctUnknown;
end;

{ TUndoProperty }

class function TUndoProperty.GetChangeType: TUndoElement.TUndoChangeType;
begin
  result := uctPropertyChange;
end;

function TUndoProperty.Process(AnObject: TObject): boolean;
begin
  result := SetObjectPropertyValue(AnObject, PropName, Value);
end;

{ TUndoManager }

procedure TUndoManager.AddObjDelete(ParentObj, DeletedObj: IUndoableObject);
var
  UndoElement: TUndoDeleteObject;
begin
  UndoElement := TUndoDeleteObject.Create(ParentObj);
  UndoElement.Obj := DeletedObj.GetSelf;
  PushElement(UndoElement);
end;

procedure TUndoManager.AddObjInsert(ParentObj: IUndoableObject;
  NewLocation: TUndoObjectPathRec);
var
  UndoElement: TUndoAddObject;
begin
  UndoElement := TUndoAddObject.Create(ParentObj);
  UndoElement.Location := NewLocation;
  PushElement(UndoElement);
end;

procedure TUndoManager.AddObjReorder(ParentObj: IUndoableObject; OldLocation,
  NewLocation: TUndoObjectPathRec);
var
  UndoElement: TUndoMoveObject;
begin
  UndoElement := TUndoMoveObject.Create(ParentObj);
  UndoElement.Location := NewLocation;
  UndoElement.OldLocation := OldLocation;
  PushElement(UndoElement);
end;

procedure TUndoManager.AddProperty(Obj: IUndoableObject;
  const PropName: string; Value: Variant);
var
  UndoElement: TUndoProperty;
begin
  UndoElement := TUndoProperty.Create(Obj);
  UndoElement.PropName := PropName;
  UndoElement.Value := Value;
  PushElement(UndoElement);
end;

procedure TUndoManager.Clear;
begin
  FUndoStack.Clear;
  FRedoStack.Clear;
end;

procedure TUndoManager.PushElement(UndoElement: TUndoElement);
begin
  case FCurrentState of
    csDoing:
      FUndoStack.Push(UndoElement);
    csUndoing:
      FRedoStack.Push(UndoElement);
  end;
end;

constructor TUndoManager.Create(Host: IUndoableHost);
begin
  FHostObject := Host;
  FUndoStack := TUndoStack.Create();
  FRedoStack := TUndoStack.Create();
end;

destructor TUndoManager.Destroy;
begin
  FreeAndNil(FUndoStack);
  FreeAndNil(FRedoStack);
  inherited;
end;

function TUndoManager.DoRedo: boolean;
var
  UndoElement: TUndoElement;
  Obj: TObject;
begin
  UndoElement := FRedoStack.Extract;
  try
    Obj := FHostObject.GetObject(UndoElement.Path);
    result := UndoElement.Process(Obj);
  finally
    UndoElement.Free;
  end;
end;

function TUndoManager.DoUndo: boolean;
var
  UndoElement: TUndoElement;
  Obj: TObject;
begin
  FCurrentState := csUndoing;
  try
    UndoElement := FUndoStack.Extract;
    try
      Obj := FHostObject.GetObject(UndoElement.Path);
      result := UndoElement.Process(Obj);
    finally
      UndoElement.Free;
    end;
  finally
    FCurrentState := csDoing;
  end;
end;

function TUndoManager.GetCanUndo: boolean;
begin
  result := FUndoStack.Count > 0;
end;

function TUndoManager.GetRedo: boolean;
begin
  result := FRedoStack.Count > 0;
end;

{ TUndoObject }

destructor TUndoDeleteObject.Destroy;
begin
  if FObj <> nil then
    FreeAndNil(FObj);
  inherited;
end;

class function TUndoDeleteObject.GetChangeType: TUndoElement.TUndoChangeType;
begin
  result := uctDelete;
end;

function TUndoDeleteObject.Process(AnObject: TObject): boolean;
var
  OI: IUndoableObject;
begin
  result := false;
  if AnObject.GetInterface(IID_IUndoableObject, OI) then
    result := OI.Insert(Obj, FPath);
end;


procedure TUndoDeleteObject.SetObj(const Value: TObject);
var
  OI: IUndoableObject;
  Parent: IUndoableObject;
begin
  FObj := Value;
  if Value.GetInterface(IID_IUndoableObject, OI) then
  begin
    Parent := OI.GetParent;
    if Parent <> nil then
      FLocation := Parent.GetPath(Value);
    FObj := Parent.Clone.GetSelf;
  end;
end;

{ TUndoInsertObject }

class function TUndoAddObject.GetChangeType: TUndoElement.TUndoChangeType;
begin
  result := uctAdd;
end;

function TUndoAddObject.Process(AnObject: TObject): boolean;
var
  OI: IUndoableObject;
begin
  result := false;
  if AnObject.GetInterface(IID_IUndoableObject, OI) then
    result := OI.Delete(FLocation);
end;

{ TUndoObjectPathRec }

constructor TUndoObjectPathRec.New(OType, OIndex: integer);
begin
  ObjType := OType;
  ObjIndex := OIndex;
end;

{ TUndoReorderObject }

class function TUndoMoveObject.GetChangeType: TUndoElement.TUndoChangeType;
begin
  result := uctMove;
end;

function TUndoMoveObject.Process(AnObject: TObject): boolean;
var
  OI: IUndoableObject;
begin
  result := false;
  if AnObject.GetInterface(IID_IUndoableObject, OI) then
    result := OI.Move(FLocation, FOldLocation);
end;

end.