From 835a25787019e28b1db585f6625c8554ad981028 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Fri, 10 Jun 2016 15:02:26 +0200 Subject: [PATCH] * implemented uutlEvent --- uutlEvent.pas | 291 +++++++++++++++++++++++++++++++++++++ uutlObservableGenerics.pas | 99 +++++++++---- uutlSyncObjs.pas | 35 +++++ 3 files changed, 396 insertions(+), 29 deletions(-) create mode 100644 uutlEvent.pas diff --git a/uutlEvent.pas b/uutlEvent.pas new file mode 100644 index 0000000..b5f1b77 --- /dev/null +++ b/uutlEvent.pas @@ -0,0 +1,291 @@ +unit uutlEvent; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, syncobjs, + uutlCommon, uutlGenerics; + +type +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventType = byte; + TutlEventTypes = set of TutlEventType; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + IutlEvent = interface(IUnknown) + ['{FC7AA96D-9C2C-42AD-A680-DE55341F2B35}'] + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventList = class(specialize TutlSimpleList) + public + constructor Create; reintroduce; + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEvent = class(TInterfacedObject, IutlEvent) + private + fEventType: TutlEventType; + fTimestamp: Single; + + public + property EventType: TutlEventType read fEventType; + property Timestamp: Single read fTimestamp; + + constructor Create(const aEventType: TutlEventType); + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + IutlEventListener = interface(IUnknown) + ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}'] + procedure DispatchEvent(const aEvent: IutlEvent); + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventListenerSet = class(specialize TutlHashSetBase) + private type + TComparer = class(TInterfacedObject, IComparer) + function Compare(const i1, i2: IutlEventListener): Integer; + end; + + function GetEmpty: Boolean; + public + property Empty: Boolean read GetEmpty; + + procedure DispatchEvent(const aEvent: IutlEvent); + + function RegisterListener(const aListener: IutlEventListener): Boolean; + function UnregisterListener(const aListener: IutlEventListener): Boolean; + + constructor Create; + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventListenerCallback = class(TInterfacedObject, IutlEventListener) + public type + TCallback = procedure(const aEvent: IutlEvent) of object; + private + fCallback: TCallback; + private { IEventListener } + procedure DispatchEvent(const aEvent: IutlEvent); + public + constructor Create(const aCallback: TCallback); + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventListenerAsync = class(TutlInterfaceNoRefCount, IutlEventListener) + private + fEventLock: TCriticalSection; + fListenerLock: TCriticalSection; + fEvents: TutlEventList; + fListener: TutlEventListenerSet; + + function PopEvent: IutlEvent; + + private { IEventListener } + procedure DispatchEvent(const aEvent: IutlEvent); + + public + function RegisterListener(const aListener: IutlEventListener): Boolean; + function UnregisterListener(const aListener: IutlEventListener): Boolean; + + procedure DispatchEvents; + + constructor Create; + destructor Destroy; override; + end; + +implementation + +uses + uutlTiming; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventList.Create; +begin + inherited Create(true); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEvent.Create(const aEventType: TutlEventType); +begin + inherited Create; + fTimestamp := GetMicroTime / 1000000; + fEventType := aEventType; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventListenerSet.TComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerSet.TComparer.Compare(const i1, i2: IutlEventListener): Integer; +begin + if (Pointer(i1) < Pointer(i2)) then + result := -1 + else if (Pointer(i1) > Pointer(i2)) then + result := 1 + else + result := 0; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventListenerSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerSet.GetEmpty: Boolean; +begin + result := (GetCount = 0); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventListenerSet.DispatchEvent(const aEvent: IutlEvent); +var + l: IutlEventListener; +begin + for l in self do + l.DispatchEvent(aEvent); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerSet.RegisterListener(const aListener: IutlEventListener): Boolean; +var + i: Integer; +begin + result := (SearchItem(0, List.Count-1, aListener, i) < 0); + if result then + InsertIntern(i, aListener); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerSet.UnregisterListener(const aListener: IutlEventListener): Boolean; +var + i, tmp: Integer; +begin + i := SearchItem(0, List.Count-1, aListener, tmp); + result := (i >= 0); + if result then + DeleteIntern(i); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventListenerSet.Create; +begin + inherited Create(TComparer.Create, true); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventListenerCallback////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventListenerCallback.DispatchEvent(const aEvent: IutlEvent); +begin + fCallback(aEvent); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventListenerCallback.Create(const aCallback: TCallback); +begin + inherited Create; + if not Assigned(aCallback) then + raise EArgumentException.Create('aCallback is not assigned'); + fCallback := aCallback; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventListenerAsync///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerAsync.PopEvent: IutlEvent; +begin + fEventLock.Enter; + try + if (fEvents.Count > 0) + then result := fEvents.PopFirst(false) + else result := nil; + finally + fEventLock.Leave; + end; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventListenerAsync.DispatchEvent(const aEvent: IutlEvent); +begin + fEventLock.Enter; + try + fEvents.Add(aEvent); + finally + fEventLock.Leave; + end; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerAsync.RegisterListener(const aListener: IutlEventListener): Boolean; +begin + fListenerLock.Enter; + try + result := fListener.RegisterListener(aListener); + finally + fListenerLock.Leave; + end; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListenerAsync.UnregisterListener(const aListener: IutlEventListener): Boolean; +begin + fListenerLock.Enter; + try + result := fListener.UnregisterListener(aListener); + finally + fListenerLock.Leave; + end; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventListenerAsync.DispatchEvents; +var + e: IutlEvent; +begin + repeat + e := PopEvent; + if Assigned(e) then begin + fListenerLock.Enter; + try + fListener.DispatchEvent(e); + finally + fListenerLock.Leave; + end; + end; + until not Assigned(e); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventListenerAsync.Create; +begin + inherited Create; + fEventLock := TCriticalSection.Create; + fListenerLock := TCriticalSection.Create; + fEvents := TutlEventList.Create; + fListener := TutlEventListenerSet.Create; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlEventListenerAsync.Destroy; +begin + fEventLock.Enter; + fListenerLock.Enter; + try + FreeAndNil(fEvents); + FreeAndNil(fListener); + finally + fListenerLock.Leave; + fEventLock.Leave; + end; + FreeAndNil(fEventLock); + FreeAndNil(fListenerLock); + inherited Destroy; +end; + +end. + diff --git a/uutlObservableGenerics.pas b/uutlObservableGenerics.pas index ac35d02..c4ad489 100644 --- a/uutlObservableGenerics.pas +++ b/uutlObservableGenerics.pas @@ -35,6 +35,9 @@ type protected procedure InsertIntern(const aIndex: Integer; const aItem: T); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; + + procedure DoAddItem(const aIndex: Integer; const aItem: T); virtual; + procedure DoRemoveItem(const aIndex: Integer; const aItem: T); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; @@ -61,6 +64,9 @@ type protected procedure InsertIntern(const aIndex: Integer; const aItem: T); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; + + procedure DoAddItem(const aItem: T); virtual; + procedure DoRemoveItem(const aItem: T); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; @@ -83,22 +89,21 @@ type TEventList = specialize TutlEventList; TObservableHashSet = class(THashSet) private - fOwner: TObject; - fOnAddItem: TEventList; - fOnRemoveItem: TEventList; + fOwner: TutlObservableCustomMap; protected procedure InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; public - property OnAddItem: TEventList read fOnAddItem write fOnAddItem; - property OnRemoveItem: TEventList read fOnRemoveItem write fOnRemoveItem; - constructor Create(const aOwner: TObject; const aComparer: IComparer; const aOwnsObjects: Boolean = true); + constructor Create(const aOwner: TutlObservableCustomMap; const aComparer: IComparer; const aOwnsObjects: Boolean = true); end; private fHashSetImpl: TObservableHashSet; fOnAddItem: TEventList; fOnRemoveItem: TEventList; + protected + procedure DoAddItem(const aKey: TKey; const aValue: TValue); virtual; + procedure DoRemoveItem(const aKey: TKey; const aValue: TValue); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; @@ -169,24 +174,36 @@ end; //TutlObservableCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.InsertIntern(const aIndex: Integer; const aItem: T); +begin + inherited InsertIntern(aIndex, aItem); + DoAddItem(aIndex, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +begin + DoRemoveItem(aIndex, aIndex); + inherited DeleteIntern(aIndex, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DoAddItem(const aIndex: Integer; const aItem: T); var e: TItemEvent; begin - inherited InsertIntern(aIndex, aItem); if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aIndex, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlObservableCustomList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +procedure TutlObservableCustomList.DoRemoveItem(const aIndex: Integer; const aItem: T); var e: TItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do e(self, aIndex, GetItem(aIndex)); - inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -217,24 +234,36 @@ end; //TutlObservableCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.InsertIntern(const aIndex: Integer; const aItem: T); +begin + inherited InsertIntern(aIndex, aItem); + DoAddItem(aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +begin + DoRemoveItem(GetItem(aIndex)); + inherited DeleteIntern(aIndex, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomHashSet.DoAddItem(const aItem: T); var e: THashItemEvent; begin - inherited InsertIntern(aIndex, aItem); if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlObservableCustomHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +procedure TutlObservableCustomHashSet.DoRemoveItem(const aItem: T); var e: THashItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do - e(self, GetItem(aIndex)); - inherited DeleteIntern(aIndex, aFreeItem); + e(self, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -265,45 +294,57 @@ end; //TutlObservableCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.TObservableHashSet.InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair); -var - e: TKeyValuePairEvent; begin inherited InsertIntern(aIndex, aItem); - if Assigned(fOnAddItem) then begin - for e in fOnAddItem do - e(fOwner, aItem.Key, aItem.Value); - end; + fOwner.DoAddItem(aItem.Key, aItem.Value); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.TObservableHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var - e: TKeyValuePairEvent; - tmp: TKeyValuePair; + kvp: TKeyValuePair; begin - if Assigned(fOnRemoveItem) then begin - tmp := GetItem(aIndex); - for e in fOnRemoveItem do - e(fOwner, tmp.Key, tmp.Value); - end; + kvp := GetItem(aIndex); + fOwner.DoRemoveItem(kvp.Key, kvp.Value); inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlObservableCustomMap.TObservableHashSet.Create(const aOwner: TObject; const aComparer: IComparer; const aOwnsObjects: Boolean); +constructor TutlObservableCustomMap.TObservableHashSet.Create( + const aOwner: TutlObservableCustomMap; const aComparer: IComparer; const aOwnsObjects: Boolean); begin inherited Create(aComparer, aOwnsObjects); fOwner := aOwner; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomMap.DoAddItem(const aKey: TKey; const aValue: TValue); +var + e: TKeyValuePairEvent; +begin + if not Assigned(fOnAddItem) then + exit; + for e in fOnAddItem do + e(self, aKey, aValue); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomMap.DoRemoveItem(const aKey: TKey; const aValue: TValue); +var + e: TKeyValuePairEvent; +begin + if not Assigned(fOnRemoveItem) then + exit; + for e in fOnRemoveItem do + e(self, aKey, aValue); +end; + //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomMap.Create(const aComparer: IComparer; const aOwnsObjects: Boolean); begin fOnAddItem := TEventList.Create; fOnRemoveItem := TEventList.Create; fHashSetImpl := TObservableHashSet.Create(self, TKeyValuePairComparer.Create(aComparer), aOwnsObjects); - fHashSetImpl.OnAddItem := fOnAddItem; - fHashSetImpl.OnRemoveItem := fOnRemoveItem; inherited Create(fHashSetImpl); end; diff --git a/uutlSyncObjs.pas b/uutlSyncObjs.pas index ab4c24b..a4ab98d 100644 --- a/uutlSyncObjs.pas +++ b/uutlSyncObjs.pas @@ -26,6 +26,20 @@ type procedure Leave; end; + generic IutlLock = interface(IUnknown) + function LockedObject: T; + end; + + generic TutlLock = class(TInterfacedObject, specialize IutlLock) + private + fLock: TCriticalSection; + fObject: T; + public + function LockedObject: T; + constructor Create(const aLock: TCriticalSection; const aObject: T); + destructor Destroy; override; + end; + implementation { TAutoResetEvent } @@ -81,5 +95,26 @@ begin end; end; +function TutlLock.LockedObject: T; +begin + result := fObject; +end; + +constructor TutlLock.Create(const aLock: TCriticalSection; const aObject: T); +begin + inherited Create; + if not Assigned(aLock) then + raise EArgumentNilException.Create('aLock'); + fLock := aLock; + fLock.Enter; + fObject := aObject; +end; + +destructor TutlLock.Destroy; +begin + fLock.Leave; + inherited Destroy; +end; + end.