utils/uutlEvent.pas

unit uutlEvent;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, syncobjs,
  uutlTypes, uutlCommon, uutlGenerics, uutlInterfaces;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  IutlEventArgs = interface(IUnknown)
  ['{FC7AA96D-9C2C-42AD-A680-DE55341F2B35}']
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  IutlEventListener = interface(IUnknown)
  ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
    procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventHandler = procedure (constref aSender: TObject; constref aEvent: IutlEventArgs) of object;
  TutlEventArgs = class(TInterfacedObject, IutlEventArgs);

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic IutlObservable<T> = interface(specialize {$IFDEF UTL_ADVANCED_ENUMERATORS}IutlEnumerable{$ELSE}IEnumerable{$ENDIF}<T>)
    ['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
    procedure RegisterEventHandler  (const aHandler: TutlEventHandler);
    procedure UnregisterEventHandler(const aHandler: TutlEventHandler);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlEventList<T> = class(specialize TutlCustomHashSet<T>)
  private type
    TComparer = class(TInterfacedObject, IComparer)
    public
      function EqualityCompare(constref i1, i2: T): Boolean;
      function Compare        (constref i1, i2: T): Integer;
    end;

  public
    constructor Create;
  end;
  TutlNotifyEventList = specialize TutlEventList<TNotifyEvent>;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListenerSet = class(
    specialize TutlCustomHashSet<IutlEventListener>
    , IutlEventListener)

  private type
    TComparer = class(TInterfacedObject, IComparer)
    public
      function EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
      function Compare        (constref i1, i2: IutlEventListener): Integer;
    end;

  public { IutlEventListener }
    procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);

  public
    constructor Create; reintroduce;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListenerCallback = class(
    TInterfacedObject
    , IutlEventListener)

  private
    fHandler: TutlEventHandler;

  public { IEventListener }
    procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);

  public
    constructor Create(const aHandler: TutlEventHandler);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListenerAsync = class(
    TutlInterfaceNoRefCount
    , IutlEventListener)

  private type
    TEventPair = specialize TutlPair<TObject, IutlEventArgs>;
    TEventList = class(specialize TutlSimpleList<TEventPair>)
    protected
      procedure Release(var aItem: TEventPair; const aFreeItem: Boolean); override;
    end;

  private
    fEventLock:     TCriticalSection;
    fListenerLock:  TCriticalSection;
    fEvents:        TEventList;
    fListener:      TutlEventListenerSet;

    function PopEventPair(out aPair: TEventPair): Boolean;

  public { IEventListener }
    procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);

  public
    function  RegisterListener  (const aListener: IutlEventListener): Boolean;
    function  UnregisterListener(const aListener: IutlEventListener): Boolean;

    procedure DispatchEvents;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.TComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
  result := (TMethod(i1).Data = TMethod(i2).Data)
        and (TMethod(i1).Code = TMethod(i2).Code);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.TComparer.Compare(constref i1, i2: T): Integer;
var
  m1, m2: TMethod;
begin
  m1 := TMethod(i1);
  m2 := TMethod(i2);
  if (m1.Data < m2.Data) then
    result := -1
  else if (m1.Data > m2.Data) then
    result := 1
  else if (m1.Code < m2.Code) then
    result := -1
  else if (m1.Code > m2.Code) then
    result := 1
  else
    result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventList.Create;
begin
  inherited Create(TComparer.Create, true);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListenerSet.TComparer.EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
begin
  result := (i1 = i2);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListenerSet.TComparer.Compare(constref 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///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerSet.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
var
  l: IutlEventListener;
begin
  for l in self do
    l.DispatchEvent(aSender, aEvent);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventListenerSet.Create;
begin
  inherited Create(TComparer.Create, true);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerCallback//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerCallback.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
begin
  fHandler(aSender, aEvent);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventListenerCallback.Create(const aHandler: TutlEventHandler);
begin
  inherited Create;
  if not Assigned(aHandler) then
    raise EArgumentNilException.Create('aHandler is not assigned');
  fHandler := aHandler;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerAsync.TEventList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerAsync.TEventList.Release(var aItem: TEventPair; const aFreeItem: Boolean);
begin
  aItem.first  := nil;
  aItem.second := nil;
  inherited Release(aItem, aFreeItem);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerAsync/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListenerAsync.PopEventPair(out aPair: TEventPair): Boolean;
begin
  fEventLock.Enter;
  try
    result := not fEvents.IsEmpty;
    if result
      then aPair := fEvents.PopFirst(false)
      else FillByte(aPair, SizeOf(aPair), 0);
  finally
    fEventLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerAsync.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
var
  p: TEventPair;
begin
  p.first  := aSender;
  p.second := aEvent;
  fEventLock.Enter;
  try
    fEvents.Add(p);
  finally
    fEventLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListenerAsync.RegisterListener(const aListener: IutlEventListener): Boolean;
begin
  fListenerLock.Enter;
  try
    result := fListener.Add(aListener);
  finally
    fListenerLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListenerAsync.UnregisterListener(const aListener: IutlEventListener): Boolean;
begin
  fListenerLock.Enter;
  try
    result := fListener.Remove(aListener);
  finally
    fListenerLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerAsync.DispatchEvents;
var
  p: TEventPair;
begin
  while PopEventPair(p) do begin
    fListenerLock.Enter;
    try
      fListener.DispatchEvent(p.first, p.second);
    finally
      fListenerLock.Leave;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventListenerAsync.Create;
begin
  inherited Create;
  fEventLock    := TCriticalSection.Create;
  fListenerLock := TCriticalSection.Create;
  fEvents       := TEventList.Create(true);
  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.