summaryrefslogtreecommitdiff
path: root/extras/tiopf
diff options
context:
space:
mode:
Diffstat (limited to 'extras/tiopf')
-rw-r--r--extras/tiopf/mvp/basic_impl.pas276
-rw-r--r--extras/tiopf/mvp/basic_intf.pas110
-rw-r--r--extras/tiopf/mvp/gg_mvp.lpk49
-rw-r--r--extras/tiopf/mvp/gg_mvp.pas20
-rw-r--r--extras/tiopf/mvp/readme.txt11
-rw-r--r--extras/tiopf/mvp/view_impl.pas66
6 files changed, 532 insertions, 0 deletions
diff --git a/extras/tiopf/mvp/basic_impl.pas b/extras/tiopf/mvp/basic_impl.pas
new file mode 100644
index 00000000..e855a726
--- /dev/null
+++ b/extras/tiopf/mvp/basic_impl.pas
@@ -0,0 +1,276 @@
+unit basic_impl;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, basic_intf;
+
+type
+
+ TSubject = class(TInterfacedObject, ISubject)
+ private
+ fController: Pointer;
+ fObservers: IInterfaceList;
+ fUpdateCount: integer;
+ function GetController: IInterface;
+ procedure Attach(Observer: IObserver);
+ procedure Detach(Observer: IObserver);
+ procedure Notify;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ public
+ constructor Create(const Controller: IInterface);
+ 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;
+ // IString
+ function GetAsString: string;
+ procedure SetAsString(const AValue: string);
+ // IVisited
+ procedure Accept(const Visitor: IVisitor);
+ end;
+
+
+ TStringListModel = class(TListModel, IStringListModel)
+ private
+ // IStringListModel
+ function GetItem(Idx: Integer): IString;
+ end;
+
+
+ TStringSelection = class(TInterfacedObject, ISelection, IVisited)
+ private
+ fModel: IStringListModel;
+ fItems: IInterfaceList;
+ // ISelection
+ procedure AddItem(const Item: IInterface);
+ procedure Clear;
+ procedure RemoveItem(const Item: IInterface);
+ procedure SelectModel;
+ // IVisited
+ procedure Accept(const Visitor: IVisitor);
+ public
+ constructor Create(const Model: IStringListModel); virtual;
+ end;
+
+
+
+implementation
+
+{ TSubject }
+
+function TSubject.GetController: IInterface;
+begin
+ Result := IInterface(fController);
+end;
+
+procedure TSubject.Attach(Observer: IObserver);
+begin
+ if fObservers = nil then
+ fObservers := TInterfaceList.Create;
+ if fObservers.IndexOf(Observer) < 0 then
+ fObservers.Add(Observer);
+end;
+
+procedure TSubject.Detach(Observer: IObserver);
+begin
+ if fObservers <> nil then
+ begin
+ if fObservers.IndexOf(Observer) >= 0 then
+ fObservers.Remove(Observer);
+ if fObservers.Count = 0 then
+ fObservers := nil;
+ end;
+end;
+
+procedure TSubject.Notify;
+var
+ i: integer;
+begin
+ if fObservers <> nil then
+ for i := 0 to fObservers.Count-1 do
+ (fObservers[i] as IObserver).Update(GetController);
+end;
+
+procedure TSubject.BeginUpdate;
+begin
+ Inc(fUpdateCount);
+end;
+
+procedure TSubject.EndUpdate;
+begin
+ Dec(fUpdateCount);
+ if fUpdateCount = 0 then
+ Notify;
+end;
+
+constructor TSubject.Create(const Controller: IInterface);
+begin
+ inherited Create;
+ fController := Pointer(Controller);
+end;
+
+{ TListModel }
+
+function TListModel.GetCount: Integer;
+begin
+ Result := fItems.Count;
+end;
+
+function TListModel.GetItem(Idx: Integer): IInterface;
+begin
+ Result := fItems[Idx];
+end;
+
+procedure TListModel.Add(Item: IInterface);
+begin
+ fSubject.BeginUpdate;
+ fItems.Add(Item);
+ fSubject.EndUpdate;
+end;
+
+procedure TListModel.Clear;
+begin
+ fSubject.BeginUpdate;
+ fItems.Clear;
+ fSubject.EndUpdate;
+end;
+
+procedure TListModel.Insert(Item, Before: IInterface);
+begin
+ fSubject.BeginUpdate;
+ fItems.Insert(fItems.IndexOf(Before), Item);
+ fSubject.EndUpdate;
+end;
+
+procedure TListModel.Move(Item, Before: IInterface);
+var
+ IndexOfBefore: 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;
+end;
+
+procedure TListModel.Remove(Item: IInterface);
+begin
+ fSubject.BeginUpdate;
+ fItems.Delete(fItems.IndexOf(Item));
+ fSubject.EndUpdate;
+end;
+
+constructor TListModel.Create;
+begin
+ inherited Create;
+end;
+
+destructor TListModel.Destroy;
+begin
+ inherited Destroy;
+end;
+
+{ TString }
+
+function TString.GetAsString: string;
+begin
+
+end;
+
+procedure TString.SetAsString(const AValue: string);
+begin
+
+end;
+
+procedure TString.Accept(const Visitor: IVisitor);
+begin
+
+end;
+
+{ TStringListModel }
+
+function TStringListModel.GetItem(Idx: Integer): IString;
+begin
+ Result := Items[Idx] as IString;
+end;
+
+{ TStringSelection }
+
+procedure TStringSelection.AddItem(const Item: IInterface);
+begin
+ if fItems = nil then
+ fItems := TInterfaceList.Create;
+ if fItems.IndexOf(Item) < 0 then
+ fItems.Add(Item);
+end;
+
+procedure TStringSelection.Clear;
+begin
+
+end;
+
+procedure TStringSelection.RemoveItem(const Item: IInterface);
+begin
+ if fItems <> nil then
+ begin
+ if fItems.IndexOf(Item) >= 0 then
+ fItems.Remove(Item);
+ if fItems.Count = 0 then
+ fItems := nil;
+ end;
+end;
+
+procedure TStringSelection.SelectModel;
+var
+ i: integer;
+begin
+ for i := 0 to (fModel as IListModel).Count-1 do
+ fItems.Add(fModel.Item[i]);
+end;
+
+procedure TStringSelection.Accept(const Visitor: IVisitor);
+var
+ i: integer;
+begin
+ for i := 0 to fItems.Count-1 do
+ (fItems[i] as IVisited).Accept(Visitor);
+end;
+
+constructor TStringSelection.Create(const Model: IStringListModel);
+begin
+ inherited Create;
+ fModel := Model;
+end;
+
+end.
+
diff --git a/extras/tiopf/mvp/basic_intf.pas b/extras/tiopf/mvp/basic_intf.pas
new file mode 100644
index 00000000..efe58d4a
--- /dev/null
+++ b/extras/tiopf/mvp/basic_intf.pas
@@ -0,0 +1,110 @@
+unit basic_intf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+ // forward declarations
+ ISubject = interface;
+
+
+ IObserver = interface(IInterface)
+ ['{16CD208B-5F37-41FC-82A4-BFDD16DB3203}']
+ procedure Update(Subject: IInterface);
+ end;
+
+
+ ISubject = interface(IInterface)
+ ['{004B3299-C221-4A44-87A7-7657D90B6493}']
+ procedure Attach(Observer: IObserver);
+ procedure Detach(Observer: IObserver);
+ procedure Notify;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ end;
+
+
+ IVisitor = interface(IInterface)
+ ['{35E154D2-6573-42DA-9854-156F3B19C95F}']
+ // empty interface
+ end;
+
+ IVisited = interface(IInterface)
+ ['{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 Clear;
+ procedure Insert(Item, Before: IInterface);
+ procedure Move(Item, Before: IInterface);
+ procedure Remove(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;
+ function GetView: IView;
+ procedure SetModel(const AValue: IModel);
+ procedure SetView(const AValue: IView);
+ property Model: IModel read GetModel write SetModel;
+ property View: IView read GetView write SetView;
+ end;
+}
+
+ IString = interface(IInterface)
+ ['{E76984A4-1287-4353-8370-A7332B9FB1CB}']
+ function GetAsString: string;
+ procedure SetAsString(const AValue: string);
+ property AsString: string read GetAsString write SetAsString;
+ end;
+
+
+ IStringListModel = interface(IInterface)
+ ['{769804CD-89E4-43C7-B8EF-783BFE27214E}']
+ function GetItem(Idx: Integer): IString;
+ property Item[Idx: Integer]: IString read GetItem;
+ end;
+
+
+ ISelection = interface(IInterface)
+ ['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}']
+ procedure AddItem(const Item: IInterface);
+ procedure Clear;
+ procedure RemoveItem(const Item: IInterface);
+ procedure SelectModel;
+ end;
+
+
+ ICommand = interface(IInterface)
+ ['{B333C7E1-B124-4D08-A640-DC02F36264C7}']
+ procedure BindSelection(const Selection: ISelection);
+ function Execute: Boolean;
+ function GetText: string;
+ property Text: string read GetText;
+ end;
+
+
+ ICommandSet = interface(IInterface)
+ ['{1622FF69-3104-47EA-8741-9C1B05ADA30B}']
+ // empty interface
+ end;
+
+
+implementation
+
+
+
+
+end.
+
diff --git a/extras/tiopf/mvp/gg_mvp.lpk b/extras/tiopf/mvp/gg_mvp.lpk
new file mode 100644
index 00000000..74080b5c
--- /dev/null
+++ b/extras/tiopf/mvp/gg_mvp.lpk
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <Package Version="3">
+ <Name Value="gg_mvp"/>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <SearchPaths>
+ <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+ </SearchPaths>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+ <Files Count="3">
+ <Item1>
+ <Filename Value="basic_intf.pas"/>
+ <UnitName Value="basic_intf"/>
+ </Item1>
+ <Item2>
+ <Filename Value="basic_impl.pas"/>
+ <UnitName Value="basic_impl"/>
+ </Item2>
+ <Item3>
+ <Filename Value="view_impl.pas"/>
+ <UnitName Value="view_impl"/>
+ </Item3>
+ </Files>
+ <Type Value="RunAndDesignTime"/>
+ <RequiredPkgs Count="2">
+ <Item1>
+ <PackageName Value="fpgui_package"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="FCL"/>
+ <MinVersion Major="1" Valid="True"/>
+ </Item2>
+ </RequiredPkgs>
+ <UsageOptions>
+ <UnitPath Value="$(PkgOutDir)"/>
+ </UsageOptions>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ </PublishOptions>
+ </Package>
+</CONFIG>
diff --git a/extras/tiopf/mvp/gg_mvp.pas b/extras/tiopf/mvp/gg_mvp.pas
new file mode 100644
index 00000000..8a19fe85
--- /dev/null
+++ b/extras/tiopf/mvp/gg_mvp.pas
@@ -0,0 +1,20 @@
+{ This file was automatically created by Lazarus. Do not edit!
+This source is only used to compile and install the package.
+ }
+
+unit gg_mvp;
+
+interface
+
+uses
+ basic_intf, basic_impl, view_impl, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('gg_mvp', @Register);
+end.
diff --git a/extras/tiopf/mvp/readme.txt b/extras/tiopf/mvp/readme.txt
new file mode 100644
index 00000000..d4f097cd
--- /dev/null
+++ b/extras/tiopf/mvp/readme.txt
@@ -0,0 +1,11 @@
+
+ Model-View-Presenter (MVP) implementation for tiOPF and fpGUI
+ -------------------------------------------------------------
+
+ This is very early stages, so the code is still unusable.
+
+
+ Regards,
+ - Graeme -
+
+ \ No newline at end of file
diff --git a/extras/tiopf/mvp/view_impl.pas b/extras/tiopf/mvp/view_impl.pas
new file mode 100644
index 00000000..272da1dc
--- /dev/null
+++ b/extras/tiopf/mvp/view_impl.pas
@@ -0,0 +1,66 @@
+unit view_impl;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, gui_listbox, gui_combobox, basic_intf;
+
+type
+
+ TListBoxView = class(TfpgListBox, IObserver)
+ private
+ procedure IObserver.Update = ObserverUpdate;
+ procedure ObserverUpdate(Subject: IInterface);
+ end;
+
+
+ TComboBoxView = class(TfpgComboBox, IObserver)
+ private
+ procedure IObserver.Update = ObserverUpdate;
+ procedure ObserverUpdate(Subject: IInterface);
+ end;
+
+
+implementation
+
+{ TListBoxView }
+
+procedure TListBoxView.ObserverUpdate(Subject: IInterface);
+var
+ Obj: IListModel;
+ i: integer;
+begin
+ Subject.QueryInterface(IListModel, Obj);
+ if Obj <> nil then
+ begin
+ Items.BeginUpdate;
+ Items.Clear;
+// for i := 0 to Obj.Count-1 do
+// Items.Add(Obj.Item[i]);
+ Items.EndUpdate;
+ end;
+end;
+
+{ TComboBoxView }
+
+procedure TComboBoxView.ObserverUpdate(Subject: IInterface);
+var
+ Obj: IListModel;
+ i: integer;
+begin
+ Subject.QueryInterface(IListModel, Obj);
+ if Obj <> nil then
+ begin
+ Items.BeginUpdate;
+ Items.Clear;
+// for i := 0 to Obj.Count-1 do
+// Items.Add(Obj.Item[i]);
+ FocusItem := 1;
+ Items.EndUpdate;
+ end;
+end;
+
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-28 06:40:44 +0000