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(aSender: TObject; aEventArgs: IutlEventArgs);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventHandler = procedure (aSender: TObject; aEventArgs: IutlEventArgs) of object;
  TutlEventArgs = class(TutlInterfacedObject, IutlEventArgs)
  public
    constructor Create;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  IutlObservable = interface(IUnknown)
    ['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
    procedure RegisterEventListener  (aListener: IutlEventListener);
    procedure UnregisterEventListener(aListener: IutlEventListener);
  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>;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListenerList = class(
    specialize TutlEventList<TutlEventHandler>
    , IutlEventListener)

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

  public
    constructor Create;
  end;

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

  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(aSender: TObject; aEventArgs: IutlEventArgs);

  public { IutlObservable }
    procedure RegisterEventListener  (aListener: IutlEventListener);
    procedure UnregisterEventListener(aListener: IutlEventListener);

  public
    constructor Create; reintroduce;
  end;

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

  private
    fHandler: TutlEventHandler;

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

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

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

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

  private
    fEventLock: TCriticalSection;
    fEvents: TEventQueue;
    fListener: IutlEventListener;

    function PopEventPair(out aPair: TEventPair): Boolean;

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

  public
    procedure DispatchEvents;

    constructor Create(const aListener: IutlEventListener);
    destructor  Destroy; override;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventArgs.Create;
begin
  inherited Create;
  AutoFree := true;
end;

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

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerList.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
var
  e: TutlEventHandler;
begin
  for e in self do
    e(aSender, aEventArgs);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventListenerList.Create;
begin
  inherited Create;
  AutoFree := 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(aSender: TObject; aEventArgs: IutlEventArgs);
var
  e: IutlEventListener;
begin
  for e in self do
    e.DispatchEvent(aSender, aEventArgs);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerSet.RegisterEventListener(aListener: IutlEventListener);
begin
  Add(aListener);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerSet.UnregisterEventListener(aListener: IutlEventListener);
begin
  Remove(aListener);
end;

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

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerCallback//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerCallback.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
begin
  fHandler(aSender, aEventArgs);
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.TEventQueue.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.Dequeue
      else FillByte(aPair, SizeOf(aPair), 0);
  finally
    fEventLock.Leave;
  end;
end;

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

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

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventListenerAsync.Create(const aListener: IutlEventListener);
begin
  if not Assigned(aListener) then
    raise EArgumentNilException.Create('aListener');
  inherited Create;
  fEventLock := TCriticalSection.Create;
  fEvents    := TEventQueue.Create(true);
  fListener  := aListener;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlEventListenerAsync.Destroy;
begin
  fEventLock.Enter;
  try
    FreeAndNil(fEvents);
    fListener := nil;
  finally
    fEventLock.Leave;
  end;
  FreeAndNil(fEventLock);
  inherited Destroy;
end;

end.