utils/uutlObservableGenerics.pas

unit uutlObservableGenerics;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlGenerics;

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

  public
    function RegisterEvent(const aEvent: T): Boolean;
    function UnregisterEvent(const aEvent: T): Boolean;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableCustomList<T> = class(specialize TutlCustomList<T>)
  public type
    TEvent     = procedure(aSender: TObject; const aIndex: Integer; const aItem: T) of object;
    TEventList = specialize TutlEventList<TEvent>;
  private
    fOnAddItem: TEventList;
    fOnRemoveItem: TEventList;
  protected
    procedure InsertIntern(const aIndex: Integer; const aItem: T); override;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override;
  public
    property OnAddItem:    TEventList read fOnAddItem;
    property OnRemoveItem: TEventList read fOnRemoveItem;

    constructor Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableList<T> = class(specialize TutlObservableCustomList<T>)
  public type
    TEqualityComparer = specialize TutlEqualityComparer<T>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableCustomHashSet<T> = class(specialize TutlCustomHashSet<T>)
  public type
    TEvent     = procedure(aSender: TObject; const aItem: T) of object;
    TEventList = specialize TutlEventList<TEvent>;
  private
    fOnAddItem: TEventList;
    fOnRemoveItem: TEventList;
  protected
    procedure InsertIntern(const aIndex: Integer; const aItem: T); override;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override;
  public
    property OnAddItem:    TEventList read fOnAddItem;
    property OnRemoveItem: TEventList read fOnRemoveItem;

    constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableHashSet<T> = class(specialize TutlObservableCustomHashSet<T>)
  public type
    TComparer = specialize TutlComparer<T>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableCustomMap<TKey, TValue> = class(specialize TutlMapBase<TKey, TValue>)
  public type
    TEvent             = procedure(aSender: TObject; const aKey: TKey; const aValue: TValue) of object;
    TEventList         = specialize TutlEventList<TEvent>;
    TObservableHashSet = class(THashSet)
    private
      fOwner: TObject;
      fOnAddItem: TEventList;
      fOnRemoveItem: TEventList;
    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);
    end;

  private
    fHashSetImpl: TObservableHashSet;
    fOnAddItem: TEventList;
    fOnRemoveItem: TEventList;
  public
    property OnAddItem:    TEventList read fOnAddItem;
    property OnRemoveItem: TEventList read fOnRemoveItem;

    constructor Create(const aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlObservableMap<TKey, TValue> = class(specialize TutlObservableCustomMap<TKey, TValue>)
  public type
    TComparer = specialize TutlComparer<TKey>;
  public
    constructor Create(const aOwnsObjects: Boolean = true);
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.TComparer.Compare(const 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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.RegisterEvent(const aEvent: T): Boolean;
var
  i: Integer;
begin
  result := (SearchItem(0, List.Count-1, aEvent, i) < 0);
  if result then
    InsertIntern(i, aEvent);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.UnregisterEvent(const aEvent: T): Boolean;
var
  i, tmp: Integer;
begin
  i := SearchItem(0, List.Count-1, aEvent, tmp);
  result := (i >= 0);
  if result then
    DeleteIntern(i);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableCustomList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomList.InsertIntern(const aIndex: Integer; const aItem: T);
var
  e: TEvent;
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);
var
  e: TEvent;
begin
  if Assigned(fOnRemoveItem) then
    for e in fOnRemoveItem do
      e(self, aIndex, GetItem(aIndex));
  inherited DeleteIntern(aIndex, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aEqualityComparer, aOwnsObjects);
  fOnAddItem    := TEventList.Create;
  fOnRemoveItem := TEventList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlObservableCustomList.Destroy;
begin
  FreeAndNil(fOnRemoveItem);
  FreeAndNil(fOnAddItem);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableList.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TEqualityComparer.Create, aOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableCustomHashSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomHashSet.InsertIntern(const aIndex: Integer; const aItem: T);
var
  e: TEvent;
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);
var
  e: TEvent;
begin
  if Assigned(fOnRemoveItem) then
    for e in fOnRemoveItem do
      e(self, GetItem(aIndex));
  inherited DeleteIntern(aIndex, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableCustomHashSet.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aComparer, aOwnsObjects);
  fOnAddItem    := TEventList.Create;
  fOnRemoveItem := TEventList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlObservableCustomHashSet.Destroy;
begin
  inherited Destroy; // calls clear -> Free EventLists after
  FreeAndNil(fOnAddItem);
  FreeAndNil(fOnRemoveItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableHashSet.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TComparer.Create, aOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableCustomMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomMap.TObservableHashSet.InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair);
var
  e: TEvent;
begin
  inherited InsertIntern(aIndex, aItem);
  if Assigned(fOnAddItem) then begin
    for e in fOnAddItem do
      e(fOwner, aItem.Key, aItem.Value);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomMap.TObservableHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
  e: TEvent;
  tmp: TKeyValuePair;
begin
  if Assigned(fOnRemoveItem) then begin
    tmp := GetItem(aIndex);
    for e in fOnRemoveItem do
      e(fOwner, tmp.Key, tmp.Value);
  end;
  inherited DeleteIntern(aIndex, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableCustomMap.TObservableHashSet.Create(const aOwner: TObject; const aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aComparer, aOwnsObjects);
  fOwner := aOwner;
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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlObservableCustomMap.Destroy;
begin
  inherited Destroy;
  FreeAndNil(fHashSetImpl);
  FreeAndNil(fOnAddItem);
  FreeAndNil(fOnRemoveItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlObservableMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlObservableMap.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(TComparer.Create, aOwnsObjects);
end;

end.