diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-04-10 21:51:37 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-04-10 21:51:37 +0000 |
commit | 2d5b6397c7f583fcaad81bf98c6af5623e759592 (patch) | |
tree | fbcd3bdaa81d8c83ab16964577cf4ffa5ded1f9d /extras | |
parent | 705e7f97da51551ca26986526ebd8f1ed265075e (diff) | |
download | fpGUI-2d5b6397c7f583fcaad81bf98c6af5623e759592.tar.xz |
* The start of a MVP implementation for tiOPF and fpGUI.
Diffstat (limited to 'extras')
-rw-r--r-- | extras/tiopf/mvp/basic_impl.pas | 276 | ||||
-rw-r--r-- | extras/tiopf/mvp/basic_intf.pas | 110 | ||||
-rw-r--r-- | extras/tiopf/mvp/gg_mvp.lpk | 49 | ||||
-rw-r--r-- | extras/tiopf/mvp/gg_mvp.pas | 20 | ||||
-rw-r--r-- | extras/tiopf/mvp/readme.txt | 11 | ||||
-rw-r--r-- | extras/tiopf/mvp/view_impl.pas | 66 |
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. + |