freepascal
/
utils
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Browse Source

* implemented uutlEvent

master
Bergmann89 8 years ago
parent
307544c0cf
commit
835a257870
3 changed files with 396 additions and 29 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +291
    -0
      uutlEvent.pas
  2. +70
    -29
      uutlObservableGenerics.pas
  3. +35
    -0
      uutlSyncObjs.pas

+ 291
- 0
uutlEvent.pas View File

@@ -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<IutlEvent>)
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<IutlEventListener>)
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.


+ 70
- 29
uutlObservableGenerics.pas View File

@@ -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<TKeyValuePairEvent>;
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;



+ 35
- 0
uutlSyncObjs.pas View File

@@ -26,6 +26,20 @@ type
procedure Leave;
end;

generic IutlLock<T> = interface(IUnknown)
function LockedObject: T;
end;

generic TutlLock<T> = class(TInterfacedObject, specialize IutlLock<T>)
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.


Write Preview
Loading…
Cancel
Save