* The start of a MVP implementation for tiOPF and fpGUI.

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.
+