summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--extras/tiopf/mvp/basic_impl.pas298
-rw-r--r--extras/tiopf/mvp/basic_intf.pas114
-rw-r--r--extras/tiopf/mvp/fpgui_intf.pas22
-rw-r--r--extras/tiopf/mvp/gg_mvp.lpk8
-rw-r--r--extras/tiopf/mvp/gg_mvp.pas2
5 files changed, 376 insertions, 68 deletions
diff --git a/extras/tiopf/mvp/basic_impl.pas b/extras/tiopf/mvp/basic_impl.pas
index e855a726..791f16e0 100644
--- a/extras/tiopf/mvp/basic_impl.pas
+++ b/extras/tiopf/mvp/basic_impl.pas
@@ -25,28 +25,6 @@ type
end;
- TListModel = class(TInterfacedObject, IListModel, ISubject)
- private
- fItems: IInterfaceList;
- fSubject: ISubject;
- protected
- property Items: IInterfaceList read fItems;
- // IListModel
- function GetCount: Integer;
- function GetItem(Idx: Integer): IInterface;
- procedure Add(Item: IInterface);
- procedure Clear;
- procedure Insert(Item, Before: IInterface);
- procedure Move(Item, Before: IInterface);
- procedure Remove(Item: IInterface);
- // ISubject
- property Subject: ISubject read FSubject implements ISubject;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- end;
-
-
TString = class(TInterfacedObject, IString, IVisited)
private
fString: string;
@@ -58,13 +36,6 @@ type
end;
- TStringListModel = class(TListModel, IStringListModel)
- private
- // IStringListModel
- function GetItem(Idx: Integer): IString;
- end;
-
-
TStringSelection = class(TInterfacedObject, ISelection, IVisited)
private
fModel: IStringListModel;
@@ -72,6 +43,7 @@ type
// ISelection
procedure AddItem(const Item: IInterface);
procedure Clear;
+ function GetCount: integer;
procedure RemoveItem(const Item: IInterface);
procedure SelectModel;
// IVisited
@@ -81,6 +53,98 @@ type
end;
+ TCommand = class(TInterfacedObject, ICommand, IVisited)
+ private
+ fSelection: ISelection;
+ procedure BindSelection(const Selection: ISelection);
+ protected
+ // IVisited
+ procedure Accept(const Visitor: IVisitor); virtual;
+ // ICommand
+ function Execute: Boolean; virtual; abstract;
+ function GetEnabled: Boolean; virtual; abstract;
+ function GetText: string; virtual; abstract;
+ end;
+
+
+ TCommandSet = class(TInterfacedObject, ICommandSet, IObserver, ISubject, IVisited)
+ private
+ fItems: IInterfaceList;
+ fSubject: ISubject;
+ function GetCount: integer;
+ // IVisited
+ procedure Accept(const Visitor: IVisitor);
+ protected
+ property Count: integer read GetCount;
+ property Items: IInterfaceList read fItems;
+ // IObserver
+ procedure Update(Subject: IInterface);
+ // ISubject
+ property Subject: ISubject read fSubject implements ISubject;
+ public
+ constructor Create; virtual;
+ end;
+
+
+ TMVPModel = class(TInterfacedObject, IMVPModel, ISubject)
+ private
+ fCommandSet: ICommandSet;
+ fCurrentSelection: ISelection;
+ fSubject: ISubject;
+ // IMVPModel
+ function GetCommandSet: ICommandSet;
+ function GetCurrentSelection: ISelection;
+ protected
+ property CommandSet: ICommandSet read GetCommandSet;
+ property CurrentSelection: ISelection read GetCurrentSelection;
+ // 3 methods to be called by the constructor
+ procedure BindSelection; virtual;
+ procedure CreateCommandSet(var ACommandSet: ICommandSet); virtual; abstract;
+ procedure CreateSelection(var ASelection: ISelection); virtual; abstract;
+ // ISubject
+ property Subject: ISubject read fSubject implements ISubject;
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+ end;
+
+
+ TListModel = class(TMVPModel, IListModel)
+ private
+ fItems: IInterfaceList;
+ protected
+ property Items: IInterfaceList read fItems;
+ // IListModel
+ function GetCount: Integer; virtual;
+ function GetItem(Idx: Integer): IInterface; virtual;
+ procedure Add(const Item: IInterface); virtual;
+ procedure Clear; virtual;
+ function IndexOf(const Item: IInterface): Integer; virtual;
+ procedure Insert(const Item, Before: IInterface); virtual;
+ procedure Move(const Item, Before: IInterface); virtual;
+ procedure Remove(const Item: IInterface); virtual;
+ public
+ destructor Destroy; override;
+ end;
+
+
+ TStringListModel = class(TListModel, IStringListModel, IVisited)
+ private
+ // IStringListModel
+ function IStringListModel.GetItem = StringListModelGetItem;
+ function StringListModelGetItem(Idx: Integer): IString;
+ // IVisited
+ procedure Accept(const Visitor: IVisitor); virtual;
+ protected
+ // IMVPModel
+ procedure CreateCommandSet(var ACommandSet: ICommandSet); override;
+ procedure CreateSelection(var ASelection: ISelection); override;
+ public
+ destructor Destroy; override;
+ end;
+
+
+
implementation
@@ -149,50 +213,79 @@ begin
Result := fItems[Idx];
end;
-procedure TListModel.Add(Item: IInterface);
+procedure TListModel.Add(const Item: IInterface);
begin
- fSubject.BeginUpdate;
+ Subject.BeginUpdate;
+ if fItems = nil then
+ fItems := TInterfaceList.Create;
+// fItems.Add(Item as IInterface);
fItems.Add(Item);
- fSubject.EndUpdate;
+ Subject.EndUpdate;
end;
procedure TListModel.Clear;
begin
- fSubject.BeginUpdate;
+ Subject.BeginUpdate;
fItems.Clear;
- fSubject.EndUpdate;
+ Subject.EndUpdate;
end;
-procedure TListModel.Insert(Item, Before: IInterface);
+function TListModel.IndexOf(const Item: IInterface): Integer;
begin
- fSubject.BeginUpdate;
- fItems.Insert(fItems.IndexOf(Before), Item);
- fSubject.EndUpdate;
+ if fItems <> nil then
+// Result := fItems.IndexOf(Item as IInterface)
+ Result := fItems.IndexOf(Item)
+ else
+ Result := -1;
end;
-procedure TListModel.Move(Item, Before: IInterface);
+procedure TListModel.Insert(const Item, Before: IInterface);
var
- IndexOfBefore: integer;
+ InsertIdx: integer;
begin
- fSubject.BeginUpdate;
- IndexOfBefore := fItems.IndexOf(Before);
- if IndexOfBefore < 0 then
- IndexOfBefore := 0;
- fItems.Delete(fItems.IndexOf(Item));
- fItems.Insert(IndexOfBefore, Item);
- fSubject.EndUpdate;
+ if fItems = nil then
+ fItems := TInterfaceList.Create;
+ if fItems.IndexOf(Item) < 0 then
+ begin
+ Subject.BeginUpdate;
+ InsertIdx := fItems.IndexOf(Before);
+ if InsertIdx < 0 then
+ InsertIdx := 0;
+ fItems.Insert(InsertIdx, Item);
+ Subject.EndUpdate;
+ end;
end;
-procedure TListModel.Remove(Item: IInterface);
+procedure TListModel.Move(const Item, Before: IInterface);
+var
+ IdxItem: integer;
+ IdxBefore: integer;
+ MoveItem: IInterface;
begin
- fSubject.BeginUpdate;
- fItems.Delete(fItems.IndexOf(Item));
- fSubject.EndUpdate;
+ if fItems <> nil then
+ begin
+ IdxItem := fItems.IndexOf(Item);
+ if IdxItem >= 0 then
+ begin
+ Subject.BeginUpdate;
+ MoveItem := fItems[IdxItem];
+ fItems.Delete(IdxItem);
+ IdxBefore := fItems.IndexOf(Before);
+ if IdxBefore >0 then
+ fItems.Insert(IdxBefore, MoveItem);
+ Subject.EndUpdate;
+ end;
+ end; { if }
end;
-constructor TListModel.Create;
+procedure TListModel.Remove(const Item: IInterface);
begin
- inherited Create;
+ if fItems <> nil then
+ begin
+ Subject.BeginUpdate;
+ fItems.Remove(Item);
+ Subject.EndUpdate;
+ end;
end;
destructor TListModel.Destroy;
@@ -219,11 +312,31 @@ end;
{ TStringListModel }
-function TStringListModel.GetItem(Idx: Integer): IString;
+function TStringListModel.StringListModelGetItem(Idx: Integer): IString;
begin
Result := Items[Idx] as IString;
end;
+procedure TStringListModel.Accept(const Visitor: IVisitor);
+begin
+
+end;
+
+procedure TStringListModel.CreateCommandSet(var ACommandSet: ICommandSet);
+begin
+
+end;
+
+procedure TStringListModel.CreateSelection(var ASelection: ISelection);
+begin
+
+end;
+
+destructor TStringListModel.Destroy;
+begin
+ inherited Destroy;
+end;
+
{ TStringSelection }
procedure TStringSelection.AddItem(const Item: IInterface);
@@ -239,6 +352,11 @@ begin
end;
+function TStringSelection.GetCount: integer;
+begin
+ Result := fItems.Count;
+end;
+
procedure TStringSelection.RemoveItem(const Item: IInterface);
begin
if fItems <> nil then
@@ -272,5 +390,77 @@ begin
fModel := Model;
end;
+{ TCommand }
+
+procedure TCommand.BindSelection(const Selection: ISelection);
+begin
+ fSelection := Selection;
+end;
+
+procedure TCommand.Accept(const Visitor: IVisitor);
+begin
+ (Visitor as ICommandVisitor).VisitComand(self);
+end;
+
+{ TCommandSet }
+
+function TCommandSet.GetCount: integer;
+begin
+ if fItems <> nil then
+ Result := fItems.Count
+ else
+ Result := 0;
+end;
+
+procedure TCommandSet.Accept(const Visitor: IVisitor);
+var
+ i: integer;
+begin
+ for i := 0 to fItems.Count-1 do
+ (fItems[i] as IVisited).Accept(Visitor);
+end;
+
+procedure TCommandSet.Update(Subject: IInterface);
+begin
+ // do nothing yet
+end;
+
+constructor TCommandSet.Create;
+begin
+ inherited Create;
+ fItems := TInterfaceList.Create;
+end;
+
+{ TMVPModel }
+
+function TMVPModel.GetCommandSet: ICommandSet;
+begin
+ Result := fCommandSet;
+end;
+
+function TMVPModel.GetCurrentSelection: ISelection;
+begin
+ Result := fCurrentSelection;
+end;
+
+procedure TMVPModel.BindSelection;
+begin
+ (fCurrentSelection as ISubject).Attach(fCommandSet as IObserver);
+end;
+
+constructor TMVPModel.Create;
+begin
+ inherited Create;
+ fSubject := TSubject.Create(self);
+ CreateSelection(fCurrentSelection);
+ CreateCommandSet(fCommandSet);
+ BindSelection;
+end;
+
+destructor TMVPModel.Destroy;
+begin
+ inherited Destroy;
+end;
+
end.
diff --git a/extras/tiopf/mvp/basic_intf.pas b/extras/tiopf/mvp/basic_intf.pas
index efe58d4a..1d1aad80 100644
--- a/extras/tiopf/mvp/basic_intf.pas
+++ b/extras/tiopf/mvp/basic_intf.pas
@@ -7,6 +7,13 @@ interface
type
// forward declarations
ISubject = interface;
+ IMVPView = interface;
+ ICommandMenuItem = interface;
+ IString = interface;
+
+
+ // event types
+ TSelectStringEvent = procedure(const AString: IString) of object;
IObserver = interface(IInterface)
@@ -34,23 +41,23 @@ type
['{7CF62F51-9412-445C-9E8C-DE94F2B1E280}']
procedure Accept(const Visitor: IVisitor);
end;
-
IListModel = interface(IInterface)
['{1A772375-1263-4790-8827-F7BEA358674A}']
function GetCount: Integer;
function GetItem(Idx: Integer): IInterface;
- procedure Add(Item: IInterface);
+ procedure Add(const Item: IInterface);
procedure Clear;
- procedure Insert(Item, Before: IInterface);
- procedure Move(Item, Before: IInterface);
- procedure Remove(Item: IInterface);
+ function IndexOf(const Item: IInterface): Integer;
+ procedure Insert(const Item, Before: IInterface);
+ procedure Move(const Item, Before: IInterface);
+ procedure Remove(const Item: IInterface);
property Count: Integer read GetCount;
property Item[Idx: Integer]: IInterface read GetItem;
end;
-{
-
+
+(*
IController = interface(IInterface)
['{4A99C01A-D025-4562-8E94-3A0C873CE894}']
function GetModel: IModel;
@@ -60,7 +67,7 @@ type
property Model: IModel read GetModel write SetModel;
property View: IView read GetView write SetView;
end;
-}
+*)
IString = interface(IInterface)
['{E76984A4-1287-4353-8370-A7332B9FB1CB}']
@@ -70,9 +77,9 @@ type
end;
- IStringListModel = interface(IInterface)
+ IStringListModel = interface(IListModel)
['{769804CD-89E4-43C7-B8EF-783BFE27214E}']
- function GetItem(Idx: Integer): IString;
+ function GetItem(Idx: Integer): IString; overload;
property Item[Idx: Integer]: IString read GetItem;
end;
@@ -81,8 +88,9 @@ type
['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}']
procedure AddItem(const Item: IInterface);
procedure Clear;
+ function GetCount: integer;
procedure RemoveItem(const Item: IInterface);
- procedure SelectModel;
+ property Count: integer read GetCount;
end;
@@ -90,7 +98,9 @@ type
['{B333C7E1-B124-4D08-A640-DC02F36264C7}']
procedure BindSelection(const Selection: ISelection);
function Execute: Boolean;
+ function GetEnabled: Boolean;
function GetText: string;
+ property Enabled: Boolean read GetEnabled;
property Text: string read GetText;
end;
@@ -100,6 +110,88 @@ type
// empty interface
end;
+
+ ICommandVisitor = interface(IVisitor)
+ ['{628B3A4A-30D1-48D3-8B46-090F08AD2AC8}']
+ procedure VisitComand(const Command: ICommand);
+ end;
+
+
+ ICommandMenu = interface(IInterface)
+ ['{3C666D8F-6BED-454B-8BFE-28422943B300}']
+ function AddItem(const Caption: string; Enabled: Boolean): ICommandMenuItem;
+ end;
+
+
+ ICommandMenuItem = interface(IInterface)
+ ['{7DFCF2BD-70DA-4DAC-B8D5-C6FB882267CF}']
+ function GetCaption: string;
+ function GetChecked: Boolean;
+ function GetCommand: ICommand;
+ procedure SetCaption(const AValue: string);
+ procedure SetChecked(const AValue: Boolean);
+ procedure SetCommand(const AValue: ICommand);
+ property Caption: string read GetCaption write SetCaption;
+ property Checked: Boolean read GetChecked write SetChecked;
+ property Command: ICommand read GetCommand write SetCommand;
+ end;
+
+
+ IStringVisitor = interface(IVisitor)
+ ['{DA12355F-0727-41B3-9080-DDAF20797FC5}']
+ procedure VisitString(const Str: IString);
+ end;
+
+
+ IMVPModel = interface(IInterface)
+ ['{85223140-B263-4413-89E3-BFA37E9D3112}']
+ function GetCommandSet: ICommandSet;
+ function GetCurrentSelection: ISelection;
+ property CommandSet: ICommandSet read GetCommandSet;
+ property CurrentSelection: ISelection read GetCurrentSelection;
+ end;
+
+
+ IMVPPresenter = interface(IInterface)
+ ['{5B8477DA-A006-4DE1-B304-9512BFAD7507}']
+ function GetCommandMenu: ICommandMenu;
+ function GetModel: IMVPModel;
+ function GetView: IMVPView;
+ procedure SetCommandMenu(const AValue: ICommandMenu);
+ procedure SetModel(const AValue: IMVPModel);
+ procedure SetView(const AValue: IMVPView);
+ property CommandMenu: ICommandMenu read GetCommandMenu write SetCommandMenu;
+ property Model: IMVPModel read GetModel write SetModel;
+ property View: IMVPView read GetView write SetView;
+ end;
+
+
+ IMVPView = interface(IInterface)
+ ['{2C575FE7-BACD-46EC-9D72-AEDA44836B20}']
+ procedure AdoptCommandMenu(const Value: ICommandMenu);
+ procedure OrphanCommandMenu(const Value: ICommandMenu);
+ end;
+
+
+ IStringListView = interface(IMVPView)
+ ['{D834710A-9C1A-42D1-A29B-7F9F8FB46426}']
+ function GetOnSelectString: TSelectStringEvent;
+ procedure SetOnSelectString(const AValue: TSelectStringEvent);
+ property OnSelectString: TSelectStringEvent read GetOnSelectString write SetOnSelectString;
+ end;
+
+
+ IStringMoveVisitor = interface(IStringVisitor)
+ ['{DB89C96F-DA90-43ED-A621-51B70E6C600E}']
+ function GetCanDemote: Boolean;
+ function GetCanPromote: Boolean;
+ property CanDemote: Boolean read GetCanDemote;
+ property CanPromote: Boolean read GetCanPromote;
+ end;
+
+
+
+
implementation
diff --git a/extras/tiopf/mvp/fpgui_intf.pas b/extras/tiopf/mvp/fpgui_intf.pas
new file mode 100644
index 00000000..f6e9e4ca
--- /dev/null
+++ b/extras/tiopf/mvp/fpgui_intf.pas
@@ -0,0 +1,22 @@
+unit fpgui_intf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ gui_menu, basic_intf;
+
+type
+
+ IPopupCommandMenu = interface(IInterface)
+ ['{812C1940-A8BD-4BB4-AE8D-37A912D44A6D}']
+ function GetMenu: TfpgPopupMenu;
+ procedure SetMenu(const AValue: TfpgPopupMenu);
+ property Menu: TfpgPopupMenu read GetMenu write SetMenu;
+ end;
+
+implementation
+
+end.
+
diff --git a/extras/tiopf/mvp/gg_mvp.lpk b/extras/tiopf/mvp/gg_mvp.lpk
index 74080b5c..3c335171 100644
--- a/extras/tiopf/mvp/gg_mvp.lpk
+++ b/extras/tiopf/mvp/gg_mvp.lpk
@@ -5,7 +5,7 @@
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
- <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+ <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
@@ -14,7 +14,7 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
- <Files Count="3">
+ <Files Count="4">
<Item1>
<Filename Value="basic_intf.pas"/>
<UnitName Value="basic_intf"/>
@@ -27,6 +27,10 @@
<Filename Value="view_impl.pas"/>
<UnitName Value="view_impl"/>
</Item3>
+ <Item4>
+ <Filename Value="fpgui_intf.pas"/>
+ <UnitName Value="fpgui_intf"/>
+ </Item4>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
diff --git a/extras/tiopf/mvp/gg_mvp.pas b/extras/tiopf/mvp/gg_mvp.pas
index 8a19fe85..c8981b1a 100644
--- a/extras/tiopf/mvp/gg_mvp.pas
+++ b/extras/tiopf/mvp/gg_mvp.pas
@@ -7,7 +7,7 @@ unit gg_mvp;
interface
uses
- basic_intf, basic_impl, view_impl, LazarusPackageIntf;
+ basic_intf, basic_impl, view_impl, fpgui_intf, LazarusPackageIntf;
implementation
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 13:01:39 +0000