utils/uutlEvent.pas

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
    fSender: TObject;
    fEventType: TutlEventType;
    fTimestamp: Single;

  public
    property Sender:    TObject       read fSender;
    property EventType: TutlEventType read fEventType;
    property Timestamp: Single        read fTimestamp;

    constructor Create(const aSender: TObject; const aEventType: TutlEventType);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  IutlEventListener = interface(IUnknown)
  ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
    procedure DispatchEvent(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(aEvent: IutlEvent); virtual;

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

    constructor Create;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListenerCallback = class(TInterfacedObject, IutlEventListener)
  public type
    TCallback = procedure(aEvent: IutlEvent) of object;
  private
    fCallback: TCallback;
  private { IEventListener }
    procedure DispatchEvent(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(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
{$IFDEF LOG_DEBUG}
  uutlLogger,
{$ENDIF}
  uutlTiming;

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

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEvent.Create(const aSender: TObject; const aEventType: TutlEventType);
begin
  inherited Create;
  fSender    := aSender;
  fEventType := aEventType;
  fTimestamp := GetMicroTime / 1000000;
{$IFDEF LOG_DEBUG}
  utlLogger.Debug(self, 'dispatch event (Sender=%s[%p]; EventType=%0.10d; Timestamp=%10.5f)', [ fSender.ClassName, Pointer(fSender), fEventType, fTimestamp ]);
{$ENDIF}
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(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(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(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.