ShaderFile/uengShaderFileGenerics.pas

unit uengShaderFileGenerics;

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

interface

uses
  Classes, SysUtils, typinfo;

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

  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 TutlCustomHashSet<T> = class(specialize TutlListBase<T>)
  public type
    IComparer = specialize IutlComparer<T>;
  private
    fComparer: IComparer;
    function SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
  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);

    constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
    destructor Destroy; override;
  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 TutlCustomMap<TKey, TValue> = class(TObject)
  public type
    IComparer = specialize IutlComparer<TKey>;
    TKeyValuePair = packed record
      Key: TKey;
      Value: TValue;
    end;
  private type
    THashSetBase = specialize TutlCustomHashSet<TKeyValuePair>;
    THashSet = class(THashSetBase)
    protected
      procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); override;
    public
      property Items[const aIndex: Integer]: TKeyValuePair read GetItem write SetItem; default;
    end;

    TKVPComparer = 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
    fComparer: IComparer;
    fHashSet: 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(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;

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

implementation

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator > (const i1, i2: TObject): Boolean; inline;
begin
  result := PtrUInt(i1) > PtrUInt(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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//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 Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex, 0, fList.Count-1]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetCount(const aValue: Integer);
var
  item: PListItem;
begin
  if (aValue < 0) then
    raise Exception.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 Exception.CreateFmt('index (%d) out of range [%d:%d]', [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 Exception.CreateFmt('index (%d) out of range [%d:%d]', [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 Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex1, 0, fList.Count-1]);
  if (aIndex2 < 0) or (aIndex2 >= Count) then
    raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex2, 0, fList.Count-1]);
  fList.Exchange(aIndex1, aIndex2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSimpleList.Move(const aCurIndex, aNewIndex: Integer);
begin
  if (aCurIndex < 0) or (aCurIndex >= Count) then
    raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aCurIndex, 0, fList.Count-1]);
  if (aNewIndex < 0) or (aNewIndex >= Count) then
    raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aNewIndex, 0, fList.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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomHashSet.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;

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

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCustomMap.THashSet////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.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;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.TKVPComparer.Create(aComparer: IComparer);
begin
  inherited Create;
  fComparer := aComparer;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.DeleteAt(const aIndex: Integer);
begin
  fHashSet.Delete(aIndex);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Clear;
begin
  fHashSet.Clear;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCustomMap.GetEnumerator: TValueEnumerator;
begin
  result := TValueEnumerator.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCustomMap.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
begin
  inherited Create;
  fComparer            := aComparer;
  fHashSet             := THashSet.Create(TKVPComparer.Create(fComparer), aOwnsObjects);
  fKeyWrapper          := TKeyWrapper.Create(fHashSet);
  fKeyValuePairWrapper := TKeyValuePairWrapper.Create(fHashSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCustomMap.Destroy;
begin
  FreeAndNil(fKeyValuePairWrapper);
  FreeAndNil(fKeyWrapper);
  FreeAndNil(fHashSet);
  fComparer := nil;
  inherited Destroy;
end;

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

end.