utils/uutlGenerics.pas

unit uutlGenerics;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit implementiert allgemein nützliche ausschließlich-generische Klassen }

{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}

interface

uses
  Classes, SysUtils, typinfo, uutlSyncObjs;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic IutlEqualityComparer<T> = interface
    function EqualityCompare(const i1, i2: T): Boolean;
  end;

  generic TutlEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
  public
    function EqualityCompare(const i1, i2: T): Boolean;
  end;

  generic TutlEventEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
  public type
    TEqualityEvent  = function(const i1, i2: T): Boolean;
    TEqualityEventO = function(const i1, i2: T): Boolean of object;
    TEqualityEventN = function(const i1, i2: T): Boolean is nested;
  private type
    TEqualityEventType = (eetNormal, eetObject, eetNested);
  private
    fEvent: TEqualityEvent;
    fEventO: TEqualityEventO;
    fEventN: TEqualityEventN;
    fEventType: TEqualityEventType;
  public
    function EqualityCompare(const i1, i2: T): Boolean;
    constructor Create(const aEvent: TEqualityEvent); overload;
    constructor Create(const aEvent: TEqualityEventO); overload;
    constructor Create(const aEvent: TEqualityEventN); overload;
    { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic IutlComparer<T> = interface
    function Compare(const i1, i2: T): Integer;
  end;

  generic TutlComparer<T> = class(TInterfacedObject, specialize IutlComparer<T>)
  public
    function Compare(const i1, i2: T): Integer;
  end;

  generic TutlEventComparer<T> = class(TInterfacedObject, specialize IutlComparer<T>)
  public type
    TEvent  = function(const i1, i2: T): Integer;
    TEventO = function(const i1, i2: T): Integer of object;
    TEventN = function(const i1, i2: T): Integer is nested;
  private type
    TEventType = (etNormal, etObject, etNested);
  private
    fEvent: TEvent;
    fEventO: TEventO;
    fEventN: TEventN;
    fEventType: TEventType;
  public
    function Compare(const i1, i2: T): Integer;
    constructor Create(const aEvent: TEvent); overload;
    constructor Create(const aEvent: TEventO); overload;
    constructor Create(const aEvent: TEventN); overload;
    { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlListBase<T> = class(TObject)
  private type
    TListItem = packed record
      data: T;
    end;
    PListItem = ^TListItem;

  public type
    TEnumerator = class(TObject)
    private
      fReverse: Boolean;
      fList: TFPList;
      fPosition: Integer;
      function GetCurrent: T;
    public
      property Current: T read GetCurrent;
      function GetEnumerator: TEnumerator;
      function MoveNext: Boolean;
      constructor Create(const aList: TFPList; const aReverse: Boolean = false);
    end;

  private
    fList: TFPList;
    fOwnsObjects: Boolean;

  protected
    property List: TFPList read fList;

    function GetCount: Integer;
    function GetItem(const aIndex: Integer): T;
    procedure SetCount(const aValue: Integer);
    procedure SetItem(const aIndex: Integer; const aItem: T);

    function CreateItem: PListItem; virtual;
    procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); virtual;
    procedure InsertIntern(const aIndex: Integer; const aItem: T); virtual;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); virtual;

  public
    property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects;

    function GetEnumerator: TEnumerator;
    function GetReverseEnumerator: TEnumerator;
    procedure Clear;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  { a simple list without the ability to compare objects (e.g. for IndexOf, Remove, Extract) }
  generic TutlSimpleList<T> = class(specialize TutlListBase<T>)
  public type
    IComparer      = specialize IutlComparer<T>;
    TSortDirection = (sdAscending, sdDescending);
  private
    function Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
    procedure QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
  public
    property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
    property Count: Integer read GetCount write SetCount;

    function Add(const aItem: T): Integer;
    procedure Insert(const aIndex: Integer; const aItem: T);

    procedure Exchange(const aIndex1, aIndex2: Integer);
    procedure Move(const aCurIndex, aNewIndex: Integer);
    procedure Sort(aComparer: IComparer; const aDirection: TSortDirection = sdAscending);

    procedure Delete(const aIndex: Integer);

    function First: T;
    procedure PushFirst(const aItem: T);
    function PopFirst(const aFreeItem: Boolean = false): T;

    function Last: T;
    procedure PushLast(const aItem: T);
    function PopLast(const aFreeItem: Boolean = false): T;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomList<T> = class(specialize TutlSimpleList<T>)
  public type
    IEqualityComparer = specialize IutlEqualityComparer<T>;
  private
    fEqualityComparer: IEqualityComparer;
  public
    function IndexOf(const aItem: T): Integer;
    function Extract(const aItem: T; const aDefault: T): T;
    function Remove(const aItem: T): Integer;

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlHashSetBase<T> = class(specialize TutlListBase<T>)
  public type
    IComparer = specialize IutlComparer<T>;
  private
    fComparer: IComparer;
  protected
    function SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
  public
    constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomHashSet<T> = class(specialize TutlHashSetBase<T>)
  public
    property Items[const aIndex: Integer]: T read GetItem; default;
    property Count: Integer read GetCount;

    function Add(const aItem: T): Boolean;
    function Contains(const aItem: T): Boolean;
    function IndexOf(const aItem: T): Integer;
    function Remove(const aItem: T): Boolean;
    procedure Delete(const aIndex: Integer);
  end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  EutlMap = class(Exception);
  EutlMapKeyNotFound = class(EutlMap)
  public
    constructor Create;
  end;
  EutlMapKeyAlreadyExists = class(EutlMap)
  public
    constructor Create;
  end;

  generic TutlMapBase<TKey, TValue> = class(TObject)
  public type
    IComparer = specialize IutlComparer<TKey>;
    TKeyValuePair = packed record
      Key: TKey;
      Value: TValue;
    end;

    THashSet = class(specialize TutlCustomHashSet<TKeyValuePair>)
    protected
      procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); override;
    public
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem write SetItem; default;
    end;

    TKeyValuePairComparer = class(TInterfacedObject, THashSet.IComparer)
    private
      fComparer: IComparer;
    public
      function Compare(const i1, i2: TKeyValuePair): Integer;
      constructor Create(aComparer: IComparer);
      destructor Destroy; override;
    end;

    TValueEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TValue;
    public
      property Current: TValue read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TKey;
    public
      property Current: TKey read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyValuePairEnumerator = class(TObject)
    private
      fHashSet: THashSet;
      fPos: Integer;
      function GetCurrent: TKeyValuePair;
    public
      property Current: TKeyValuePair read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyWrapper = class(TObject)
    private
      fHashSet: THashSet;
      function GetItem(const aIndex: Integer): TKey;
      function GetCount: Integer;
    public
      property Items[const aIndex: Integer]: TKey read GetItem; default;
      property Count: Integer read GetCount;
      function GetEnumerator: TKeyEnumerator;
      constructor Create(const aHashSet: THashSet);
    end;

    TKeyValuePairWrapper = class(TObject)
    private
      fHashSet: THashSet;
      function GetItem(const aIndex: Integer): TKeyValuePair;
      function GetCount: Integer;
    public
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;
      property Count: Integer read GetCount;
      function GetEnumerator: TKeyValuePairEnumerator;
      constructor Create(const aHashSet: THashSet);
    end;

  private
    fHashSetRef: THashSet;
    fKeyWrapper: TKeyWrapper;
    fKeyValuePairWrapper: TKeyValuePairWrapper;

    function GetValues(const aKey:   TKey): TValue;
    function GetValueAt(const aIndex: Integer): TValue;
    function GetCount: Integer;

    procedure SetValueAt(const aIndex: Integer; aValue: TValue);
    procedure SetValues(const aKey:   TKey; aValue: TValue);
  public
    property Values [const aKey:   TKey]:    TValue read GetValues  write SetValues; default;
    property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;
    property Keys:          TKeyWrapper          read fKeyWrapper;
    property KeyValuePairs: TKeyValuePairWrapper read fKeyValuePairWrapper;
    property Count:         Integer              read GetCount;

    procedure Add(const aKey: TKey; const aValue: TValue);
    function IndexOf(const aKey: TKey): Integer;
    function Contains(const aKey: TKey): Boolean;
    procedure Delete(const aKey: TKey);
    procedure DeleteAt(const aIndex: Integer);
    procedure Clear;

    function GetEnumerator: TValueEnumerator;

    constructor Create(const aHashSet: THashSet);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlCustomMap<TKey, TValue> = class(specialize TutlMapBase<TKey, TValue>)
  private
    fHashSetImpl: THashSet;
  public
    constructor Create(const aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlQueue<T> = class(TObject)
  public type
    PListItem = ^TListItem;
    TListItem = packed record
      data: T;
      next: PListItem;
    end;
  private
    function GetCount: Integer;
  protected
    fFirst: PListItem;
    fLast: PListItem;
    fCount: Integer;
    fOwnsObjects: Boolean;
  public
    property Count: Integer read GetCount;

    procedure Push(const aItem: T); virtual;
    function Pop(out aItem: T): Boolean; virtual;
    function Pop: Boolean;
    procedure Clear;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlSyncQueue<T> = class(specialize TutlQueue<T>)
  private
    fPushLock: TutlSpinLock;
    fPopLock: TutlSpinLock;
  public
    procedure Push(const aItem: T); override;
    function Pop(out aItem: T): Boolean; override;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlInterfaceList<T> = class(TInterfaceList)
  private type
    TInterfaceEnumerator = class(TObject)
    private
      fList: TInterfaceList;
      fPos: Integer;
      function GetCurrent: T;
    public
      property Current: T read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aList: TInterfaceList);
    end;

  private
    function Get(i : Integer): T;
    procedure Put(i : Integer; aItem : T);
  public
    property Items[Index : Integer]: T read Get write Put; default;

    function First: T;
    function IndexOf(aItem : T): Integer;
    function Add(aItem : IUnknown): Integer;
    procedure Insert(i : Integer; aItem : T);
    function Last : T;
    function Remove(aItem : T): Integer;

    function GetEnumerator: TInterfaceEnumerator;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  EutlEnumConvert = class(EConvertError)
  public
    constructor Create(const aValue, aExpectedType: String);
  end;
  generic TutlEnumHelper<T> = class(TObject)
  private type
    TValueArray = array of T;
  private class var
    FTypeInfo: PTypeInfo;
    FValues: TValueArray;
  public
    class constructor Initialize;
    class function ToString(aValue: T): String; reintroduce;
    class function TryToEnum(aStr: String; out aValue: T): Boolean;
    class function ToEnum(aStr: String): T; overload;
    class function ToEnum(aStr: String; const aDefault: T): T; overload;
    class function Values: TValueArray;
    class function TypeInfo: PTypeInfo;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlRingBuffer<T> = class
  private
    fAborted: boolean;
    fData: packed array of T;
    fDataLen: Integer;
    fDataSize: integer;
    fFillState: integer;
    fWritePtr, fReadPtr: integer;
    fWrittenEvent,
    fReadEvent: TutlAutoResetEvent;
  public
    constructor Create(const Elements: Integer);
    destructor Destroy; override;
    function Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
    function Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
    procedure BreakPipe;
    property  FillState: Integer read fFillState;
    property Size: integer read fDataLen;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlPagedDataFiFo<TData> = class
  private type
    PPage = ^TPage;
    TPage = packed record
      Next: PPage;
      Data: array of TData;
      ReadPos: Integer;
      WritePos: Integer;
    end;
  public type
    PData = ^TData;

    IDataProvider = interface(IUnknown)
      function Give(const aBuffer: PData; aCount: Integer): Integer;
    end;

    IDataConsumer = interface(IUnknown)
      function Take(const aBuffer: PData; aCount: Integer): Integer;
    end;

    // read from buffer, write to fifo
    TDataProvider = class(TInterfacedObject, IDataProvider)
    private
      fData: PData;
      fPos: Integer;
      fCount: Integer;
    public
      function Give(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aData: PData; const aCount: Integer);
    end;

    // read from fifo, write to buffer
    TDataConsumer = class(TInterfacedObject, IDataConsumer)
    private
      fData: PData;
      fPos: Integer;
      fCount: Integer;
    public
      function Take(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aData: PData; const aCount: Integer);
    end;

    // read from nested callback, write to fifo
    TDataCallback = function(const aBuffer: PData; aCount: Integer): Integer is nested;
    TNestedDataProvider = class(TInterfacedObject, IDataProvider)
    private
      fCallback: TDataCallback;
    public
      function Give(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aCallback: TDataCallback);
    end;

    // read from fifo, write to nested callback
    TNestedDataConsumer = class(TInterfacedObject, IDataConsumer)
    private
      fCallback: TDataCallback;
    public
      function Take(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aCallback: TDataCallback);
    end;

    // read from stream, write to fifo
    TStreamDataProvider = class(TInterfacedObject, IDataProvider)
    private
      fStream: TStream;
    public
      function Give(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aStream: TStream);
    end;

    // read from fifo, write to stream
    TStreamDataConsumer = class(TInterfacedObject, IDataConsumer)
    private
      fStream: TStream;
    public
      function Take(const aBuffer: PData; aCount: Integer): Integer;
      constructor Create(const aStream: TStream);
    end;

  private
    fPageSize: Integer;
    fReadPage: PPage;
    fWritePage: PPage;
    fSize: Integer;
  protected
    function WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer; virtual;
    function ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer; virtual;
  public
    property Size:     Integer read fSize;
    property PageSize: Integer read fPageSize;

    function Write(const aProvider: IDataProvider; const aCount: Integer): Integer; overload;
    function Write(const aData: PData; const aCount: Integer): Integer; overload;

    function Read(const aConsumer: IDataConsumer; const aCount: Integer): Integer; overload;
    function Read(const aData: PData; const aCount: Integer): Integer; overload;

    function Peek(const aConsumer: IDataConsumer; const aCount: Integer): Integer; overload;
    function Peek(const aData: PData; const aCount: Integer): Integer; overload;

    function Discard(const aCount: Integer): Integer;
    procedure Clear;

    constructor Create(const aPageSize: Integer = 2048);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlSyncPagedDataFiFo<TData> = class(specialize TutlPagedDataFiFo<TData>)
  private
    fLock: TutlSpinLock;
  protected
    function WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer; override;
    function ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer; override;
  public
    constructor Create(const aPageSize: Integer = 2048);
    destructor Destroy; override;
  end;

  function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;

operator < (const i1, i2: TObject): Boolean; inline;
operator > (const i1, i2: TObject): Boolean; inline;

implementation

uses
  uutlExceptions, syncobjs;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator < (const i1, i2: TObject): Boolean;
begin
  result := Pointer(i1) < Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator > (const i1, i2: TObject): Boolean;
begin
  result := Pointer(i1) > Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;
var
  o: TObject;
begin
  result := true;
  case aTypeInfo^.Kind of
    tkClass: begin
      if (aFreeObj) then begin
        o := TObject(obj);
        Pointer(obj) := nil;
        o.Free;
      end;
    end;

    tkInterface: begin
      IUnknown(obj) := nil;
    end;

    tkAString: begin
      AnsiString(Obj) := '';
    end;

    tkUString: begin
      UnicodeString(Obj) := '';
    end;

    tkString: begin
      String(Obj) := '';
    end;
  else
    result := false;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.Create(const aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  fHashSetImpl := THashSet.Create(TKeyValuePairComparer.Create(aComparer), aOwnsObjects);
  inherited Create(fHashSetImpl);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.Destroy;
begin
  inherited Destroy;
  FreeAndNil(fHashSetImpl);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//EutlEnumConvert///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EutlEnumConvert.Create(const aValue, aExpectedType: String);
begin
  inherited Create(Format('%s is not a %s', [aValue, aExpectedType]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//EutlMapKeyNotFound////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EutlMapKeyNotFound.Create;
begin
  inherited Create('key not found');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//EutlMapKeyAlreadyExists///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EutlMapKeyAlreadyExists.Create;
begin
  inherited Create('key already exists');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEqualityComparer.EqualityCompare(const i1, i2: T): Boolean;
begin
  result := (i1 = i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventEqualityComparer.EqualityCompare(const i1, i2: T): Boolean;
begin
  case fEventType of
    eetNormal: result := fEvent(i1, i2);
    eetObject: result := fEventO(i1, i2);
    eetNested: result := fEventN(i1, i2);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEvent);
begin
  inherited Create;
  fEvent     := aEvent;
  fEventType := eetNormal;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventO);
begin
  inherited Create;
  fEventO    := aEvent;
  fEventType := eetObject;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventN);
begin
  inherited Create;
  fEventN    := aEvent;
  fEventType := eetNested;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlComparer.Compare(const i1, i2: T): Integer;
begin
  if (i1 < i2) then
    result := -1
  else if (i1 > i2) then
    result := 1
  else
    result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventComparer.Compare(const i1, i2: T): Integer;
begin
  case fEventType of
    etNormal: result := fEvent(i1, i2);
    etObject: result := fEventO(i1, i2);
    etNested: result := fEventN(i1, i2);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEvent);
begin
  inherited Create;
  fEvent     := aEvent;
  fEventType := etNormal;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEventO);
begin
  inherited Create;
  fEventO    := aEvent;
  fEventType := etObject;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventComparer.Create(const aEvent: TEventN);
begin
  inherited Create;
  fEventN    := aEvent;
  fEventType := etNested;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.GetCurrent: T;
begin
  result := PListItem(fList[fPosition])^.data;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.GetEnumerator: TEnumerator;
begin
  result := self;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.TEnumerator.MoveNext: Boolean;
begin
  if fReverse then begin
    dec(fPosition);
    result := (fPosition >= 0);
  end else begin
    inc(fPosition);
    result := (fPosition < fList.Count)
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.TEnumerator.Create(const aList: TFPList; const aReverse: Boolean);
begin
  inherited Create;
  fList     := aList;
  fReverse  := aReverse;
  if fReverse then
    fPosition := fList.Count
  else
    fPosition := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetCount: Integer;
begin
  result := fList.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetItem(const aIndex: Integer): T;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then
    result := PListItem(fList[aIndex])^.data
  else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetCount(const aValue: Integer);
var
  item: PListItem;
begin
  if (aValue < 0) then
    raise EArgument.Create('new value for count must be positiv');
  while (aValue > fList.Count) do begin
    item := CreateItem;
    FillByte(item^, SizeOf(item^), 0);
    fList.Add(item);
  end;
  while (aValue < fList.Count) do
    DeleteIntern(fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetItem(const aIndex: Integer; const aItem: T);
var
  item: PListItem;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then begin
    item := PListItem(fList[aIndex]);
    utlFreeOrFinalize(item^, TypeInfo(item^), fOwnsObjects);
    item^.data := aItem;
  end else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.CreateItem: PListItem;
begin
  new(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
begin
  utlFreeOrFinalize(aItem^.data, TypeInfo(aItem^.data), fOwnsObjects and aFreeItem);
  Dispose(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.InsertIntern(const aIndex: Integer; const aItem: T);
var
  item: PListItem;
begin
  item := CreateItem;
  try
    item^.data := aItem;
    fList.Insert(aIndex, item);
  except
    DestroyItem(item, false);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
  item: PListItem;
begin
  if (aIndex >= 0) and (aIndex < fList.Count) then begin
    item := PListItem(fList[aIndex]);
    fList.Delete(aIndex);
    DestroyItem(item, aFreeItem);
  end else
    raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetEnumerator: TEnumerator;
begin
  result := TEnumerator.Create(fList, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetReverseEnumerator: TEnumerator;
begin
  result := TEnumerator.Create(fList, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.Clear;
begin
  while (fList.Count > 0) do
    DeleteIntern(fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.Create(const aOwnsObjects: Boolean);
begin
  inherited Create;
  fOwnsObjects := aOwnsObjects;
  fList        := TFPList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlListBase.Destroy;
begin
  Clear;
  FreeAndNil(fList);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
var
  i, j: Integer;
  pivot: T;
begin
  i := aLeft;
  j := aRight - 1;
  pivot := GetItem(aRight);
  repeat
    while ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(i), pivot) <= 0) or
           (aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) >= 0)) and
          (i < aRight) do inc(i);

    while ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(j), pivot) >= 0) or
           (aDirection = sdDescending) and (aComparer.Compare(GetItem(j), pivot) <= 0)) and
          (j > aLeft) do dec(j);

    if (i < j) then
      Exchange(i, j);
  until (i >= j);

  if ((aDirection = sdAscending)  and (aComparer.Compare(GetItem(i), pivot) > 0)) or
     ((aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) < 0)) then
          Exchange(i, aRight);

  result := i;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
var
  s: Integer;
begin
  if (aLeft < aRight) then begin
    s := Split(aComparer, aDirection, aLeft, aRight);
    QuickSort(aComparer, aDirection, aLeft, s - 1);
    QuickSort(aComparer, aDirection, s + 1, aRight);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Add(const aItem: T): Integer;
begin
  result := Count;
  InsertIntern(result, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Insert(const aIndex: Integer; const aItem: T);
begin
  InsertIntern(aIndex, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
begin
  if (aIndex1 < 0) or (aIndex1 >= Count) then
    raise EOutOfRange.Create(aIndex1, 0, Count-1);
  if (aIndex2 < 0) or (aIndex2 >= Count) then
    raise EOutOfRange.Create(aIndex2, 0, Count-1);
  fList.Exchange(aIndex1, aIndex2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Move(const aCurIndex, aNewIndex: Integer);
begin
  if (aCurIndex < 0) or (aCurIndex >= Count) then
    raise EOutOfRange.Create(aCurIndex, 0, Count-1);
  if (aNewIndex < 0) or (aNewIndex >= Count) then
    raise EOutOfRange.Create(aNewIndex, 0, Count-1);
  fList.Move(aCurIndex, aNewIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Sort(aComparer: IComparer; const aDirection: TSortDirection);
begin
  QuickSort(aComparer, aDirection, 0, fList.Count-1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.First: T;
begin
  result := Items[0];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushFirst(const aItem: T);
begin
  InsertIntern(0, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
begin
  if aFreeItem then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := First;
  DeleteIntern(0, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Last: T;
begin
  result := Items[Count-1];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.PushLast(const aItem: T);
begin
  InsertIntern(Count, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
begin
  if aFreeItem then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := Last;
  DeleteIntern(Count-1, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.IndexOf(const aItem: T): Integer;
var
  c: Integer;
begin
  c := List.Count;
  result := 0;
  while (result < c) and
        not fEqualityComparer.EqualityCompare(PListItem(List[result])^.data, aItem) do
    inc(result);
  if (result >= c) then
    result := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
var
  i: Integer;
begin
  i := IndexOf(aItem);
  if (i >= 0) then begin
    result := Items[i];
    DeleteIntern(i, false);
  end else
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomList.Remove(const aItem: T): Integer;
begin
  result := IndexOf(aItem);
  if (result >= 0) then
    DeleteIntern(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aOwnsObjects);
  fEqualityComparer := aEqualityComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomList.Destroy;
begin
  fEqualityComparer := nil;
  inherited Destroy;
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHashSetBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHashSetBase.SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
var
  i, cmp: Integer;
begin
  if (aMin <= aMax) then begin
    i   := aMin + Trunc((aMax - aMin) / 2);
    cmp := fComparer.Compare(aItem, GetItem(i));
    if (cmp = 0) then
      result := i
    else if (cmp < 0) then
      result := SearchItem(aMin, i-1, aItem, aIndex)
    else if (cmp > 0) then
      result := SearchItem(i+1, aMax, aItem, aIndex);
  end else begin
    result := -1;
    aIndex := aMin;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlHashSetBase.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create(aOwnsObjects);
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlHashSetBase.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.Contains(const aItem: T): Boolean;
var
  tmp: Integer;
begin
  result := (SearchItem(0, List.Count-1, aItem, tmp) >= 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.IndexOf(const aItem: T): Integer;
var
  tmp: Integer;
begin
  result := SearchItem(0, List.Count-1, aItem, tmp);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomHashSet.Delete(const aIndex: Integer);
begin
  DeleteIntern(aIndex);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.THashSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.THashSet.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
begin
  // never free objects used as keys, but do finalize strings, interfaces etc.
  utlFreeOrFinalize(aItem^.data.key,   TypeInfo(aItem^.data.key),   false);
  utlFreeOrFinalize(aItem^.data.value, TypeInfo(aItem^.data.value), aFreeItem and OwnsObjects);
  inherited DestroyItem(aItem, aFreeItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TKeyValuePairComparer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairComparer.Compare(const i1, i2: TKeyValuePair): Integer;
begin
  result := fComparer.Compare(i1.Key, i2.Key);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TKeyValuePairComparer.Create(aComparer: IComparer);
begin
  inherited Create;
  fComparer := aComparer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMapBase.TKeyValuePairComparer.Destroy;
begin
  fComparer := nil;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TValueEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TValueEnumerator.GetCurrent: TValue;
begin
  result := fHashSet[fPos].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TValueEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TValueEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TKeyEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyEnumerator.GetCurrent: TKey;
begin
  result := fHashSet[fPos].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TKeyEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TKeyValuePairEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairEnumerator.GetCurrent: TKeyValuePair;
begin
  result := fHashSet[fPos];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TKeyValuePairEnumerator.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
  fPos     := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TKeyWrapper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyWrapper.GetItem(const aIndex: Integer): TKey;
begin
  result := fHashSet[aIndex].Key;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyWrapper.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyWrapper.GetEnumerator: TKeyEnumerator;
begin
  result := TKeyEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TKeyWrapper.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase.TKeyValuePairWrapper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairWrapper.GetItem(const aIndex: Integer): TKeyValuePair;
begin
  result := fHashSet[aIndex];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairWrapper.GetCount: Integer;
begin
  result := fHashSet.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.TKeyValuePairWrapper.GetEnumerator: TKeyValuePairEnumerator;
begin
  result := TKeyValuePairEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.TKeyValuePairWrapper.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSet := aHashSet;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.GetValues(const aKey: TKey): TValue;
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  i := fHashSetRef.IndexOf(kvp);
  if (i < 0) then
    FillByte(result{%H-}, SizeOf(result), 0)
  else
    result := fHashSetRef[i].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.GetValueAt(const aIndex: Integer): TValue;
begin
  result := fHashSetRef[aIndex].Value;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.GetCount: Integer;
begin
  result := fHashSetRef.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.SetValues(const aKey: TKey; aValue: TValue);
var
  i: Integer;
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  i := fHashSetRef.IndexOf(kvp);
  if (i < 0) then
    raise EutlMap.Create('key not found');
  fHashSetRef[i] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.SetValueAt(const aIndex: Integer; aValue: TValue);
var
  kvp: TKeyValuePair;
begin
  kvp := fHashSetRef[aIndex];
  kvp.Value := aValue;
  fHashSetRef[aIndex] := kvp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.Add(const aKey: TKey; const aValue: TValue);
var
  kvp: TKeyValuePair;
begin
  kvp.Key   := aKey;
  kvp.Value := aValue;
  if not fHashSetRef.Add(kvp) then
    raise EutlMapKeyAlreadyExists.Create();
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.IndexOf(const aKey: TKey): Integer;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result := fHashSetRef.IndexOf(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.Contains(const aKey: TKey): Boolean;
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  result := (fHashSetRef.IndexOf(kvp) >= 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.Delete(const aKey: TKey);
var
  kvp: TKeyValuePair;
begin
  kvp.Key := aKey;
  if not fHashSetRef.Remove(kvp) then
    raise EutlMapKeyNotFound.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.DeleteAt(const aIndex: Integer);
begin
  fHashSetRef.Delete(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapBase.Clear;
begin
  fHashSetRef.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapBase.GetEnumerator: TValueEnumerator;
begin
  result := TValueEnumerator.Create(fHashSetRef);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMapBase.Create(const aHashSet: THashSet);
begin
  inherited Create;
  fHashSetRef             := aHashSet;
  fKeyWrapper          := TKeyWrapper.Create(fHashSetRef);
  fKeyValuePairWrapper := TKeyValuePairWrapper.Create(fHashSetRef);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMapBase.Destroy;
begin
  FreeAndNil(fKeyValuePairWrapper);
  FreeAndNil(fKeyWrapper);
  fHashSetRef := nil;
  inherited Destroy;
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.GetCount: Integer;
begin
  InterLockedExchange(result{%H-}, fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Push(const aItem: T);
var
  p: PListItem;
begin
  new(p);
  p^.data := aItem;
  p^.next := nil;
  fLast^.next := p;
  fLast := fLast^.next;
  InterLockedIncrement(fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Pop(out aItem: T): Boolean;
var
  old: PListItem;
begin
  result := false;
  FillByte(aItem{%H-}, SizeOf(aItem), 0);
  if (Count <= 0) then
    exit;
  result := true;
  old    := fFirst;
  fFirst := fFirst^.next;
  aItem  := fFirst^.data;
  InterLockedDecrement(fCount);
  Dispose(old);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlQueue.Pop: Boolean;
var
  tmp: T;
begin
  result := Pop(tmp);
  utlFreeOrFinalize(tmp, TypeInfo(tmp), fOwnsObjects);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Clear;
begin
  while Pop do;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlQueue.Create(const aOwnsObjects: Boolean);
begin
  inherited Create;
  new(fFirst);
  FillByte(fFirst^, SizeOf(fFirst^), 0);
  fLast        := fFirst;
  fCount       := 0;
  fOwnsObjects := aOwnsObjects;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlQueue.Destroy;
begin
  Clear;
  if Assigned(fLast) then begin
    Dispose(fLast);
    fLast := nil;
  end;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSyncQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSyncQueue.Push(const aItem: T);
begin
  fPushLock.Enter;
  try
    inherited Push(aItem);
  finally
    fPushLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSyncQueue.Pop(out aItem: T): Boolean;
begin
  fPopLock.Enter;
  try
    result := inherited Pop(aItem);
  finally
    fPopLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSyncQueue.Create(const aOwnsObjects: Boolean);
begin
  inherited Create(aOwnsObjects);
  fPushLock := TutlSpinLock.Create;
  fPopLock  := TutlSpinLock.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlSyncQueue.Destroy;
begin
  inherited Destroy; //inherited will pop all remaining items, so do not destroy spinlock before!
  FreeAndNil(fPushLock);
  FreeAndNil(fPopLock);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceList.TInterfaceEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.TInterfaceEnumerator.GetCurrent: T;
begin
  result := T(fList[fPos]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.TInterfaceEnumerator.MoveNext: Boolean;
begin
  inc(fPos);
  result := (fPos < fList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlInterfaceList.TInterfaceEnumerator.Create(const aList: TInterfaceList);
begin
  inherited Create;
  fPos  := -1;
  fList := aList;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Get(i : Integer): T;
begin
  result := T(inherited Get(i));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlInterfaceList.Put(i : Integer; aItem : T);
begin
  inherited Put(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.First: T;
begin
  result := T(inherited First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.IndexOf(aItem : T): Integer;
begin
  result := inherited IndexOf(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Add(aItem : IUnknown): Integer;
begin
  result := inherited Add(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlInterfaceList.Insert(i : Integer; aItem : T);
begin
  inherited Insert(i, aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Last : T;
begin
  result := T(inherited Last);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.Remove(aItem : T): Integer;
begin
  result := inherited Remove(aItem);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlInterfaceList.GetEnumerator: TInterfaceEnumerator;
begin
  result := TInterfaceEnumerator.Create(self);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlEnumHelper.Initialize;
var
  tiArray: PTypeInfo;
  tdArray, tdEnum: PTypeData;
  aName: PShortString;
  i: integer;
  en: T;
begin
  {
    See FPC Bug http://bugs.freepascal.org/view.php?id=27622
    For Sparse Enums, the compiler won't give us TypeInfo, because it contains some wrong data. This is
    safe, but sadly we don't even get the *correct* fields (TypeName, NameList), even though they are
    generated in any case.
    Fortunately, arrays do know this type info segment as their Element Type (and we declared one anyway).
  }
  tiArray := System.TypeInfo(TValueArray);
  tdArray := GetTypeData(tiArray);
  FTypeInfo:= tdArray^.elType2;

  {
   Now that we have the TypeInfo, fill our values from it. This is safe because while the *values* in
   TypeData are wrong for Sparse Enums, the *names* are always correct.
  }
  tdEnum:= GetTypeData(FTypeInfo);
  aName:= @tdEnum^.NameList;
  SetLength(FValues, 0);
  i:= 0;
  While Length(aName^) > 0 do begin
    SetLength(FValues, i+1);
    {
      Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
      This can normally not be the same as a valid enum value, because it is in the same identifier
      namespace. However, with scoped enums we might have the same name for module and element, because
      the full identifier for the element would be TypeName.ElementName.
      In either case, the next PShortString will point to a zero-length string, and the loop is left
      with the last element being invalid (either empty or whatever value the unit-named element has).
    }
    if TryToEnum(aName^, en) then
      FValues[i]:= en;
    inc(i);
    inc(PByte(aName), Length(aName^) + 1);
  end;
  // remove the EnumUnitName item
  SetLength(FValues, Length(FValues) - 1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(aValue: T): String;
begin
  {$Push}
  {$IOChecks OFF}
  WriteStr(Result, aValue);
  if IOResult = 107 then
    Result:= '';
  {$Pop}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
var
  a: T;
begin
  Result:= false;
  if Length(aStr) = 0 then
    exit;

  {$Push}
  {$IOChecks OFF}
  ReadStr(aStr, a);
  Result:= IOResult <> 106;
  {$Pop}
  if Result then
    aValue:= a;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String): T;
begin
  if not TryToEnum(aStr, result) then
    raise EutlEnumConvert.Create(aStr, TypeInfo^.Name);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T;
begin
  if not TryToEnum(aStr, result) then
    result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Values: TValueArray;
begin
  Result:= FValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TypeInfo: PTypeInfo;
begin
  Result:= FTypeInfo;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlRingBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlRingBuffer.Create(const Elements: Integer);
begin
  inherited Create;
  fAborted:= false;
  fDataLen:= Elements;
  fDataSize:= SizeOf(T);
  SetLength(fData, fDataLen);
  fWritePtr:= 1;
  fReadPtr:= 0;
  fFillState:= 0;
  fReadEvent:= TutlAutoResetEvent.Create;
  fWrittenEvent:= TutlAutoResetEvent.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlRingBuffer.Destroy;
begin
  BreakPipe;
  FreeAndNil(fReadEvent);
  FreeAndNil(fWrittenEvent);
  SetLength(fData, 0);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlRingBuffer.Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
var
  wp, c, r: Integer;
begin
  Result:= 0;
  while Items > 0 do begin
    if fAborted then
      exit;

    InterLockedExchange(wp{%H-}, fWritePtr);
    r:= (fReadPtr + 1) mod fDataLen;
    if wp < r then
      wp:= fDataLen;
    c:= wp - r;
    if c > Items then
      c:= Items;
    if c > 0 then begin
      Move(fData[r], Buf^, c * fDataSize);
      Dec(Items, c);
      inc(Result, c);
      dec(fFillState, c);
      inc(PByte(Buf), c * fDataSize);
      InterLockedExchange(fReadPtr, (fReadPtr + c) mod fDataLen);
      fReadEvent.SetEvent;
    end else begin
      if not BlockUntilAvail then
        break;
      fWrittenEvent.WaitFor(INFINITE);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlRingBuffer.Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
var
  rp, c: integer;
begin
  Result:= 0;
  while Items > 0 do begin
    if fAborted then
      exit;

    InterLockedExchange(rp{%H-}, fReadPtr);
    if rp < fWritePtr then
      rp:= fDataLen;
    c:= rp - fWritePtr;
    if c > Items then
      c:= Items;
    if c > 0 then begin
      Move(Buf^, fData[fWritePtr], c * fDataSize);
      dec(Items, c);
      inc(Result, c);
      inc(fFillState, c);
      inc(PByte(Buf), c * fDataSize);
      InterLockedExchange(fWritePtr, (fWritePtr + c) mod fDataLen);
      fWrittenEvent.SetEvent;
    end else begin
      if not BlockUntilDone then
        Break;
      fReadEvent.WaitFor(INFINITE);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlRingBuffer.BreakPipe;
begin
  fAborted:= true;
  fWrittenEvent.SetEvent;
  fReadEvent.SetEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TDataProvider///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := 0;
  if (aCount > fCount - fPos) then
    aCount := fCount - fPos;
  if (aCount <= 0) then
    exit;
  Move((fData + fPos)^, aBuffer^, aCount * SizeOf(TData));
  inc(fPos, aCount);
  result := aCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TDataProvider.Create(const aData: PData; const aCount: Integer);
begin
  inherited Create;
  fData  := aData;
  fCount := aCount;
  fPos   := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TDataConsumer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := 0;
  if (aCount > fCount - fPos) then
    aCount := fCount - fPos;
  if (aCount <= 0) then
    exit;
  Move(aBuffer^, (fData + fPos)^, aCount * SizeOf(TData));
  inc(fPos, aCount);
  result := aCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TDataConsumer.Create(const aData: PData; const aCount: Integer);
begin
  inherited Create;
  fData  := aData;
  fCount := aCount;
  fPos   := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TNestedDataProvider/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TNestedDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := fCallback(aBuffer, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TNestedDataProvider.Create(const aCallback: TDataCallback);
begin
  inherited Create;
  fCallback := aCallback;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TNestedDataConsumer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TNestedDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := fCallback(aBuffer, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TNestedDataConsumer.Create(const aCallback: TDataCallback);
begin
  inherited Create;
  fCallback := aCallback;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TStreamDataProvider/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TStreamDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := fStream.Read(aBuffer^, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TStreamDataProvider.Create(const aStream: TStream);
begin
  inherited Create;
  fStream := aStream;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo.TStreamDataConsumer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.TStreamDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
begin
  result := fStream.Write(aBuffer^, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.TStreamDataConsumer.Create(const aStream: TStream);
begin
  inherited Create;
  fStream := aStream;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedDataFiFo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer;
var
  c, r: Integer;
  p: PPage;
begin
  if not Assigned(aProvider) then
    raise EArgumentNil.Create('aProvider');

  result := 0;
  while (aCount > 0) do begin
    if not Assigned(fWritePage) or (fWritePage^.WritePos >= fPageSize) then begin
      new(p);
      p^.ReadPos  := 0;
      p^.WritePos := 0;
      p^.Next     := nil;
      SetLength(p^.Data, fPageSize);
      if Assigned(fWritePage) then
        fWritePage^.Next := p;
      fWritePage := p;
      if not Assigned(fReadPage) then
        fReadPage := fWritePage;
    end;

    c := fPageSize - fWritePage^.WritePos;
    if (c > aCount) then
      c := aCount;

    r := aProvider.Give(@fWritePage^.Data[fWritePage^.WritePos], c);
    if (r = 0) then
      exit;

    inc(result,               r);
    inc(fWritePage^.WritePos, r);
    inc(fSize,                r);
    dec(aCount,               r);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer;
var
  ReadPage: PPage;
  DummyPage: TPage;
  c, r: Integer;

begin
  result := 0;

  if not Assigned(fReadPage) then
    exit;

  //init read page
  if not aMoveReadPos then begin
    DummyPage := fReadPage^; // copy page (data is not copied, because it's a dynamic array)
    ReadPage  := @DummyPage;
  end else
    ReadPage := fReadPage;

  while (aCount > 0) do begin
    if (ReadPage^.ReadPos >= fPageSize) then begin
      if not Assigned(ReadPage^.Next) then
        exit;
      if aMoveReadPos then begin
        if (fReadPage = fWritePage) then // write finished with page end, so reset WritePage wenn disposing ReadPage
          fWritePage := nil;
        fReadPage := fReadPage^.Next;
        Dispose(ReadPage);
        ReadPage := fReadPage;
      end else
        ReadPage^ := ReadPage^.Next^;
    end;

    c := ReadPage^.WritePos - ReadPage^.ReadPos;
    if (c = 0) then
      exit;
    if (c > aCount) then
      c := aCount;

    if Assigned(aConsumer) then begin

      r := aConsumer.Take(@ReadPage^.Data[ReadPage^.ReadPos], c);
      if (r = 0) then
        exit;
    end else
      r := c;

    inc(result,            r);
    inc(ReadPage^.ReadPos, r);
    dec(aCount,            r);
    if aMoveReadPos then
      dec(fSize, r);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Write(const aProvider: IDataProvider; const aCount: Integer): Integer;
begin
  result := WriteIntern(aProvider, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Write(const aData: PData; const aCount: Integer): Integer;
var
  provider: IDataProvider;
begin
  provider := TDataProvider.Create(aData, aCount);
  result := WriteIntern(provider, aCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Read(const aConsumer: IDataConsumer; const aCount: Integer): Integer;
begin
  result := ReadIntern(aConsumer, aCount, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Read(const aData: PData; const aCount: Integer): Integer;
var
  consumer: IDataConsumer;
begin
  consumer := TDataConsumer.Create(aData, aCount);
  result := ReadIntern(consumer, aCount, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Peek(const aConsumer: IDataConsumer; const aCount: Integer): Integer;
begin
  result := ReadIntern(aConsumer, aCount, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Peek(const aData: PData; const aCount: Integer): Integer;
var
  consumer: IDataConsumer;
begin
  consumer := TDataConsumer.Create(aData, aCount);
  result := ReadIntern(consumer, aCount, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedDataFiFo.Discard(const aCount: Integer): Integer;
begin
  result := ReadIntern(nil, aCount, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlPagedDataFiFo.Clear;
var
  tmp: PPage;
begin
  while Assigned(fReadPage) do begin
    tmp := fReadPage;
    fReadPage := tmp^.Next;
    Dispose(tmp);
  end;
  fReadPage  := nil;
  fWritePage := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedDataFiFo.Create(const aPageSize: Integer);
begin
  inherited Create;
  fReadPage  := nil;
  fWritePage := nil;
  fPageSize  := aPageSize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlPagedDataFiFo.Destroy;
begin
  Clear;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSyncPagedDataFiFo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSyncPagedDataFiFo.WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer;
begin
  fLock.Enter;
  try
    result := inherited WriteIntern(aProvider, aCount);
  finally
    fLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSyncPagedDataFiFo.ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer;
begin
  fLock.Enter;
  try
    result := inherited ReadIntern(aConsumer, aCount, aMoveReadPos);
  finally
    fLock.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSyncPagedDataFiFo.Create(const aPageSize: Integer);
begin
  inherited Create(aPageSize);
  fLock := TutlSpinLock.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlSyncPagedDataFiFo.Destroy;
begin
  inherited Destroy;
  FreeAndNil(fLock);
end;

end.