* implemented uutlEvent

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

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

uutlSyncObjs.pas

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