(******************************************
*  Wzorzec Projektowy Command (polecenie) *
*  demonstrujący Eliminację Gaussa        *
*  www.algorytm.org                       *
*  Kontakt                                *
*  borucki_andrzej (małpka) wp.pl         *
*  Opracował Andrzej Borucki na podstawie *
*  opisu Arivalda na pl.comp.lang.delphi  *
******************************************)
unit CommandGaussFrm;

interface

uses
   Windows, Forms, Dialogs, StdCtrls, Classes, Controls, SysUtils;

type
   TForm1 = class(TForm)
     Memo1: TMemo;
     InitButton: TButton;
     NextButton: TButton;
     PriorButton: TButton;
     CalculateButton: TButton;
     StartButton: TButton;
     procedure InitButtonClick(Sender: TObject);
     procedure CalculateButtonClick(Sender: TObject);
     procedure PriorButtonClick(Sender: TObject);
     procedure NextButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
   private
     procedure EnableDisableButtons;
   public
     procedure print();
   end;

   TModel = class;

   TCommand = class
   private
     Fmodel: TModel;
   public
     constructor Create(m: TModel);
     function _Do(): Boolean ; virtual; abstract;
     function Undo(): Boolean; virtual; abstract;
     function Describe(): string; virtual; abstract;
   end;

   TCommandProcessor = class
   private
     Fmodel: TModel;
     Fcommands: TList;
     FcurrentCommand: integer;
   public
     constructor Create(m: TModel);
     destructor Destroy(); override;
     function Execute(c: TCommand): Boolean;
     function CanUndo(): Boolean;
     function CanRedo(): Boolean;
     function Undo(): Boolean;
     function Redo(): Boolean;
     procedure RemoveRedo();
   end;

   TModel = class
   public
     FA: array[0..2, 0..2] of Double;
     Fb: array[0..2] of Double;
   private
     FCommandProcessor: TCommandProcessor;
   public
     constructor Create();
     destructor Destroy(); override;
     property CommandProcessor: TCommandProcessor read FCommandProcessor;
   end;

var
  Form1: TForm1;

implementation
{$R *.DFM}
uses
  Math;

const
  DIM = 3;

constructor TCommand.Create(m: TModel);
begin
  Fmodel := m;
end;

function TCommandProcessor.CanRedo: Boolean;
begin
  Result := FcurrentCommand < Fcommands.Count - 1;
end;

function TCommandProcessor.CanUndo: Boolean;
begin
  Result := FcurrentCommand >= 0;
end;

constructor TCommandProcessor.Create(m: TModel);
begin
  Fmodel := m;
  Fcommands := TList.Create();
  FcurrentCommand := -1;
end;

destructor TCommandProcessor.Destroy();
begin
  inherited;
  FcurrentCommand := -1;
  RemoveRedo();
  Fcommands.Free();
end;

function TCommandProcessor.Execute(c: TCommand): Boolean;
begin
  Result := c._Do();
  if Result then
  begin
    //remove all "redo" data, because it will be not needed anymore
    if FcurrentCommand < Fcommands.Count - 1 then RemoveRedo();
    Assert(Fcommands.Count - 1 = FcurrentCommand);
    Fcommands.Add(c);
    inc(FcurrentCommand);
  end
  else //fail
  begin
    c.Free();
    raise Exception.Create('cammand fail');
  end;
end;

function TCommandProcessor.Undo(): Boolean;
begin
  Assert(FcurrentCommand >= 0);
  Result := TCommand(Fcommands[FcurrentCommand]).Undo();
  if Result then Dec(FcurrentCommand);
end;

function TCommandProcessor.Redo(): Boolean;
begin
  Assert(FcurrentCommand < Fcommands.Count - 1);
  Result := TCommand(Fcommands[FcurrentCommand + 1])._Do();
  if Result then inc(FcurrentCommand);
end;

procedure TCommandProcessor.RemoveRedo();
var
  i: integer;
begin
  for i := Fcommands.Count - 1 downto FcurrentCommand + 1 do
  try
    TCommand(Fcommands[i]).Free();
  except
    Application.HandleException(Self);
  end;
  Fcommands.Count := FcurrentCommand + 1;
end;

constructor TModel.Create();
begin
  FCommandProcessor := TCommandProcessor.Create(Self);
end;

destructor TModel.Destroy();
begin
  FCommandProcessor.Free;
  inherited;
end;

//commands

type
   TSetA = class(TCommand)
   private
     Fx, Fy: integer;
     FnewValue, FoldValue: Double;
   public
     constructor Create(m: TModel; x, y: integer; Value: Double);
     function _Do(): Boolean; override;
     function Undo(): Boolean; override;
     function Describe(): string; override;
   end;

   TSetB = class(TCommand)
   private
     Fidx: integer;
     FnewValue, FoldValue: Double;
   public
     constructor Create(m: TModel; idx: integer; Value: Double);
     function _Do(): Boolean; override;
     function Undo(): Boolean; override;
     function Describe(): string; override;
   end;


constructor TSetA.Create(m: TModel; x, y: integer; Value: Double);
begin
    inherited Create(m);
    Fx := x;
    Fy := y;
    FoldValue := NAN;//not disturb that FoldValue has no old value, it will set in _Do()
    FnewValue := Value;
end;

function TSetA._Do(): Boolean;
begin
   FoldValue := Fmodel.FA[Fx, Fy];
   Fmodel.FA[Fx, Fy] := FnewValue;
   Result := True;
end;

function TSetA.Undo(): Boolean;
begin
   FnewValue := Fmodel.FA[Fx, Fy];
   Fmodel.FA[Fx, Fy] := FoldValue;
   Result := True;
end;

function TSetA.Describe(): string;
begin
   Result := Format('Set A[%d,%d] to %.4f (was %.4f)', [Fx, fy,
FnewValue, FoldValue]);
end;

constructor TSetB.Create(m: TModel; idx: integer; Value: Double);
begin
    inherited Create(m);
    Fidx := idx;
    FoldValue := NAN;
    FnewValue := Value;
end;

function TSetB._Do(): Boolean;
begin
   FoldValue := Fmodel.Fb[Fidx];
   Fmodel.Fb[Fidx] := FnewValue;
   Result := True;
end;

function TSetB.Undo(): Boolean;
begin
   FnewValue := Fmodel.Fb[Fidx];
   Fmodel.Fb[Fidx] := FoldValue;
   Result := True;
end;

function TSetB.Describe(): string;
begin
   Result := Format('Set B[%d] to %.4f (was %.4f)', [Fidx, FnewValue, FoldValue]);
end;


var
   model: TModel = nil;

procedure TForm1.print();
var
   s: string;
   i: integer;
begin
   Memo1.Clear();
   if not Assigned(model) then Exit;
   if model.CommandProcessor.Fcommands.Count > 0 then s := '(initial state)';
   if (model.CommandProcessor.Fcommands.Count > 0) and
      (model.CommandProcessor.FcurrentCommand >= 0) then
     s := TCommand( model.CommandProcessor.Fcommands[
                    model.CommandProcessor.FcurrentCommand]).Describe();
   Memo1.Lines.Add(Format('command: %d / %d; %s',
                   [model.CommandProcessor.FcurrentCommand +1,
                    model.CommandProcessor.Fcommands.Count, s]));
   Memo1.Lines.Add(Format('A:%sb:', [StringOfChar(' ', 61)]));
   Memo1.Lines.Add(Format('+%s+', [StringOfChar('-', 61)]));
   for i := 0 to DIM-1 do
     Memo1.Lines.Add(Format('| %12.4f | %12.4f | %12.4f || %12.4f |',
                           [model.FA[i, 0], model.FA[i, 1], model.FA[i, 2], model.FB[i]]));
   Memo1.Lines.Add(Format('+%s+', [StringOfChar('-', 61)]));
end;

procedure TForm1.EnableDisableButtons;
begin
   PriorButton.Enabled := model.CommandProcessor.CanUndo;
   NextButton.Enabled := model.CommandProcessor.CanRedo;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  model.Free;
end;

procedure TForm1.InitButtonClick(Sender: TObject);
begin
   model.Free;
   model := TModel.Create();

   model.FA[0, 0] := 2;
   model.FA[0, 1] := 1;
   model.FA[0, 2] := -1;

   model.FA[1, 0] := -3;
   model.FA[1, 1] := -1;
   model.FA[1, 2] := 2;

   model.FA[2, 0] := -2;
   model.FA[2, 1] := 1;
   model.FA[2, 2] := 2;

   model.Fb[0] := 8;
   model.Fb[1] := -11;
   model.Fb[2] := 3;

   print();
   CalculateButton.Enabled := True;
end;

procedure TForm1.CalculateButtonClick(Sender: TObject);
var
  start: integer;
  i,j: integer;
  l: Double;
begin
   print();
   for start:=0 to DIM-2 do
   begin
     for i:=start+1 to DIM-1 do
     begin
       l:=model.FA[i,start]/model.FA[start,start];
       for j:=start to DIM-1 do
       begin
         //model.FA[i,j]:=model.FA[i,j]-l*model.FA[start,j];
         model.CommandProcessor.Execute(TSetA.Create(model, i, j, model.FA[i,j]-l*model.FA[start,j]));
       end;
       //model.Fb[i]:=model.Fb[i]-l*model.Fb[start];
       model.CommandProcessor.Execute(TSetB.Create(model, i, model.Fb[i]-l*model.Fb[start]));
     end;
   end;
   print();
   EnableDisableButtons;
   StartButton.Enabled := True;
end;

procedure TForm1.PriorButtonClick(Sender: TObject);
begin
   model.CommandProcessor.Undo();
   print();
   EnableDisableButtons;
end;

procedure TForm1.StartButtonClick(Sender: TObject);
begin
   with model.CommandProcessor do
     while CanUndo do Undo();
   print();
   EnableDisableButtons;
end;

procedure TForm1.NextButtonClick(Sender: TObject);
begin
   model.CommandProcessor.Redo();
   print();
   EnableDisableButtons;
end;

end.