aboutsummaryrefslogtreecommitdiffstats
path: root/Medley/src/lib/collections
diff options
context:
space:
mode:
Diffstat (limited to 'Medley/src/lib/collections')
-rw-r--r--Medley/src/lib/collections/CollArray.pas183
-rw-r--r--Medley/src/lib/collections/CollHash.pas1497
-rw-r--r--Medley/src/lib/collections/CollLibrary.pas131
-rw-r--r--Medley/src/lib/collections/CollList.pas270
-rw-r--r--Medley/src/lib/collections/CollPArray.pas689
-rw-r--r--Medley/src/lib/collections/CollWrappers.pas876
-rw-r--r--Medley/src/lib/collections/Collections.pas5318
-rw-r--r--Medley/src/lib/collections/readme.txt14
8 files changed, 8978 insertions, 0 deletions
diff --git a/Medley/src/lib/collections/CollArray.pas b/Medley/src/lib/collections/CollArray.pas
new file mode 100644
index 00000000..a10ba905
--- /dev/null
+++ b/Medley/src/lib/collections/CollArray.pas
@@ -0,0 +1,183 @@
+unit CollArray;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollArray.qbt $
+ *
+ * Colllection implementations based on arrays.
+ *
+ * Revision 1.2 by: Matthew Greet Rev date: 12/06/04 20:02:16
+ * Capacity property.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:30:36
+ * Size property dropped.
+ * Unused abstract functions still implemented.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Collections;
+
+type
+ TArray = class(TAbstractList)
+ private
+ FArray: array of ICollectable;
+ protected
+ function TrueGetItem(Index: Integer): ICollectable; override;
+ procedure TrueSetItem(Index: Integer; const Value: ICollectable); override;
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueDelete(Index: Integer): ICollectable; override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean = false); override;
+ constructor Create(Size: Integer; NaturalItemsOnly: Boolean = false); overload; virtual;
+ constructor Create(const Collection: ICollection); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetFixedSize: Boolean; override;
+ function GetSize: Integer; override;
+ end;
+
+implementation
+
+constructor TArray.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(0, NaturalItemsOnly);
+end;
+
+constructor TArray.Create(Size: Integer; NaturalItemsOnly: Boolean = false);
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, Size);
+end;
+
+constructor TArray.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I: Integer;
+begin
+ inherited Create(ItemArray, NaturalItemsOnly);
+ SetLength(FArray, Length(ItemArray));
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ Items[I] := Item;
+ end;
+end;
+
+constructor TArray.Create(const Collection: ICollection);
+var
+ Iterator: IIterator;
+ I: Integer;
+begin
+ inherited Create(Collection);
+ SetLength(FArray, Collection.GetSize);
+ Iterator := Collection.GetIterator;
+ I := 0;
+ while not Iterator.EOF do
+ begin
+ Items[I] := Iterator.CurrentItem;
+ Inc(I);
+ Iterator.Next;
+ end;
+end;
+
+destructor TArray.Destroy;
+var
+ I: Integer;
+begin
+ // Delete interface references to all items
+ for I := Low(FArray) to High(FArray) do
+ begin
+ FArray[I] := nil;
+ end;
+ inherited Destroy;
+end;
+
+function TArray.TrueGetItem(Index: Integer): ICollectable;
+begin
+ Result := FArray[Index];
+end;
+
+procedure TArray.TrueSetItem(Index: Integer; const Value: ICollectable);
+begin
+ FArray[Index] := Value;
+end;
+
+procedure TArray.TrueAppend(const Item: ICollectable);
+begin
+ // Ignored as collection is fixed size
+end;
+
+procedure TArray.TrueClear;
+begin
+ // Ignored as collection is fixed size
+end;
+
+function TArray.TrueDelete(Index: Integer): ICollectable;
+begin
+ // Ignored as collection is fixed size
+end;
+
+procedure TArray.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ // Ignored as collection is fixed size
+end;
+
+function TArray.GetCapacity: Integer;
+begin
+ Result := Size;
+end;
+
+procedure TArray.SetCapacity(Value: Integer);
+begin
+ // Ignored
+end;
+
+function TArray.GetFixedSize: Boolean;
+begin
+ Result := true;
+end;
+
+function TArray.GetSize: Integer;
+begin
+ Result := Length(FArray);
+end;
+
+end.
diff --git a/Medley/src/lib/collections/CollHash.pas b/Medley/src/lib/collections/CollHash.pas
new file mode 100644
index 00000000..796fc740
--- /dev/null
+++ b/Medley/src/lib/collections/CollHash.pas
@@ -0,0 +1,1497 @@
+unit CollHash;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $
+ *
+ * Collection implementations based on hash tables.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30
+ * Capacity property.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16
+ * Added integer map and string map versions.
+ * THashSet uses its own implementation, not THashMap.
+ * DefaulMaxLoadFactor changed.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, Math,
+ Collections;
+
+const
+ DefaultTableSize = 100;
+ MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property.
+ DefaultMaxLoadFactor = 5.0;
+
+type
+ THashMap = class(TAbstractMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: ICollectable): Integer; virtual;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalKeys: Boolean; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetNaturalKeyIID: TGUID; override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashSet = class(TAbstractSet)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Item: ICollectable): Integer; virtual;
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalItems: Boolean; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashIntegerMap = class(TAbstractIntegerMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IIntegerMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: Integer): Integer; virtual;
+ function GetKeyPosition(const Key: Integer): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashStringMap = class(TAbstractStringMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IStringMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: String): Integer; virtual;
+ function GetKeyPosition(const Key: String): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IStringAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+implementation
+
+const
+ (* (sqrt(5) - 1)/2
+ See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons,
+ published by John Wiley & Sons, Inc, ISBN 0-471-11600-9
+ *)
+ HashFactor = 0.618033988749894848204586834365638;
+
+type
+ THashIterator = class(TAbstractIterator)
+ private
+ FHashSet: THashSet;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashSet: THashSet);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashAssociationIterator = class(TAbstractAssociationIterator)
+ private
+ FHashMap: THashMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashMap: THashMap);
+ function TrueFirst: IAssociation; override;
+ function TrueNext: IAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashIntegerIterator = class(TAbstractIntegerAssociationIterator)
+ private
+ FHashIntegerMap: THashIntegerMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashIntegerMap: THashIntegerMap);
+ function TrueFirst: IIntegerAssociation; override;
+ function TrueNext: IIntegerAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashStringIterator = class(TAbstractStringAssociationIterator)
+ private
+ FHashStringMap: THashStringMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashStringMap: THashStringMap);
+ function TrueFirst: IStringAssociation; override;
+ function TrueNext: IStringAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashPosition = class(TCollectionPosition)
+ private
+ FChain: TList;
+ FIndex: Integer;
+ public
+ constructor Create(Found: Boolean; Chain: TList; Index: Integer);
+ property Chain: TList read FChain;
+ property Index: Integer read FIndex;
+ end;
+
+{ THashMap }
+constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I: Integer;
+begin
+ // Force use of natural keys
+ inherited Create(NaturalItemsOnly, true);
+ FTableSize := DefaultTableSize;
+ FMaxLoadFactor := DefaultMaxLoadFactor;
+ SetLength(FArray, FTableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FCapacity := 0;
+ FSize := 0;
+ ChangeCapacity(FArray);
+end;
+
+destructor THashMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+class function THashMap.GetAlwaysNaturalKeys: Boolean;
+begin
+ Result := true;
+end;
+
+function THashMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := HashableIID;
+end;
+
+function THashMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := THashAssociationIterator.Create(Self);
+end;
+
+procedure THashMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashMap.ChangeCapacity(Value: TListArray);
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashMap.GetHash(const Key: ICollectable): Integer;
+var
+ Hashable: IHashable;
+ HashCode: Cardinal;
+begin
+ Key.QueryInterface(IHashable, Hashable);
+ HashCode := Hashable.HashCode;
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashMap.TrueClear;
+var
+ Association: IAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashMap.TrueGet(Position: TCollectionPosition): IAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+var
+ Association: IAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashSet }
+constructor THashSet.Create(NaturalItemsOnly: Boolean);
+var
+ I: Integer;
+begin
+ // Force use of natural items
+ inherited Create(true);
+ FTableSize := DefaultTableSize;
+ FMaxLoadFactor := DefaultMaxLoadFactor;
+ SetLength(FArray, FTableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FSize := 0;
+end;
+
+destructor THashSet.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+procedure THashSet.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashSet.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashSet.ChangeCapacity(Value: TListArray);
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashSet.GetHash(const Item: ICollectable): Integer;
+var
+ Hashable: IHashable;
+ HashCode: Cardinal;
+begin
+ Item.QueryInterface(IHashable, Hashable);
+ HashCode := Hashable.HashCode;
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Item)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(Chain[I]));
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashSet.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Item: ICollectable;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Item := ICollectable(OldChain[J]);
+ Hash := GetHash(Item);
+ NewArray[Hash].Add(Pointer(Item));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ HashPosition.Chain.Add(Pointer(Item));
+ Inc(FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._AddRef;
+end;
+
+procedure THashSet.TrueClear;
+var
+ Item: ICollectable;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Item := ICollectable(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashSet.TrueGet(Position: TCollectionPosition): ICollectable;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+procedure THashSet.TrueRemove2(Position: TCollectionPosition);
+var
+ Item: ICollectable;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Item := TrueGet(Position);
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+class function THashSet.GetAlwaysNaturalItems: Boolean;
+begin
+ Result := true;
+end;
+
+function THashSet.GetIterator: IIterator;
+begin
+ Result := THashIterator.Create(Self);
+end;
+
+function THashSet.GetNaturalItemIID: TGUID;
+begin
+ Result := HashableIID;
+end;
+
+function THashSet.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashSet.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashSet.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashIntegerMap }
+constructor THashIntegerMap.Create;
+begin
+ Create(false, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
+var
+ I: Integer;
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, TableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FTableSize := TableSize;
+ FMaxLoadFactor := MaxLoadFactor;
+ FSize := 0;
+end;
+
+destructor THashIntegerMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator;
+begin
+ Result := THashIntegerIterator.Create(Self);
+end;
+
+procedure THashIntegerMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashIntegerMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashIntegerMap.ChangeCapacity;
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashIntegerMap.GetHash(const Key: Integer): Integer;
+begin
+ Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize);
+end;
+
+function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := (Key = IIntegerAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashIntegerMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IIntegerAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IIntegerAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashIntegerMap.TrueClear;
+var
+ Association: IIntegerAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IIntegerAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IIntegerAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation;
+var
+ Association: IIntegerAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IIntegerAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashIntegerMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashIntegerMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashIntegerMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashStringMap }
+constructor THashStringMap.Create;
+begin
+ Create(false, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashStringMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
+var
+ I: Integer;
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, TableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FTableSize := TableSize;
+ FMaxLoadFactor := MaxLoadFactor;
+ FSize := 0;
+end;
+
+destructor THashStringMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+function THashStringMap.GetAssociationIterator: IStringMapIterator;
+begin
+ Result := THashStringIterator.Create(Self);
+end;
+
+procedure THashStringMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashStringMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashStringMap.ChangeCapacity;
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashStringMap.GetHash(const Key: String): Integer;
+var
+ HashCode: Cardinal;
+ I: Integer;
+begin
+ HashCode := 0;
+ for I := 1 to Length(Key) do
+ HashCode := (HashCode shl 1) xor Ord(Key[I]);
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := (Key = IStringAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashStringMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IStringAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IStringAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashStringMap.TrueClear;
+var
+ Association: IStringAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IStringAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IStringAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation;
+var
+ Association: IStringAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IStringAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashStringMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashStringMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashStringMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashPosition }
+constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer);
+begin
+ inherited Create(Found);
+ FChain := Chain;
+ FIndex := Index;
+end;
+
+{ THashIterator }
+constructor THashIterator.Create(HashSet: THashSet);
+begin
+ inherited Create(true);
+ FHashSet := HashSet;
+ First;
+end;
+
+function THashIterator.TrueFirst: ICollectable;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashSet.TableSize do
+ begin
+ Chain := FHashSet.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashIterator.TrueNext: ICollectable;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashSet.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashSet.TableSize then
+ Chain := FHashSet.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashSet.TableSize);
+ if Success then
+ Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashIterator.TrueRemove;
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]);
+ FHashSet.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashSet.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+
+{ THashAssociationIterator }
+constructor THashAssociationIterator.Create(HashMap: THashMap);
+begin
+ inherited Create(true);
+ FHashMap := HashMap;
+ First;
+end;
+
+function THashAssociationIterator.TrueFirst: IAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashMap.TableSize do
+ begin
+ Chain := FHashMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashAssociationIterator.TrueNext: IAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashMap.TableSize then
+ Chain := FHashMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashMap.TableSize);
+ if Success then
+ Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashAssociationIterator.TrueRemove;
+var
+ Association: IAssociation;
+begin
+ Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]);
+ FHashMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+
+{ THashIntegerIterator }
+constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap);
+begin
+ inherited Create(true);
+ FHashIntegerMap := HashIntegerMap;
+ First;
+end;
+
+function THashIntegerIterator.TrueFirst: IIntegerAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashIntegerMap.TableSize do
+ begin
+ Chain := FHashIntegerMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashIntegerIterator.TrueNext: IIntegerAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashIntegerMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashIntegerMap.TableSize then
+ Chain := FHashIntegerMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashIntegerMap.TableSize);
+ if Success then
+ Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashIntegerIterator.TrueRemove;
+var
+ Association: IIntegerAssociation;
+begin
+ Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]);
+ FHashIntegerMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashIntegerMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+{ THashStringIterator }
+constructor THashStringIterator.Create(HashStringMap: THashStringMap);
+begin
+ inherited Create(true);
+ FHashStringMap := HashStringMap;
+ First;
+end;
+
+function THashStringIterator.TrueFirst: IStringAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashStringMap.TableSize do
+ begin
+ Chain := FHashStringMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashStringIterator.TrueNext: IStringAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashStringMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashStringMap.TableSize then
+ Chain := FHashStringMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashStringMap.TableSize);
+ if Success then
+ Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashStringIterator.TrueRemove;
+var
+ Association: IStringAssociation;
+begin
+ Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]);
+ FHashStringMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashStringMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+
+end.
diff --git a/Medley/src/lib/collections/CollLibrary.pas b/Medley/src/lib/collections/CollLibrary.pas
new file mode 100644
index 00000000..b7e3d268
--- /dev/null
+++ b/Medley/src/lib/collections/CollLibrary.pas
@@ -0,0 +1,131 @@
+unit CollLibrary;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.0.1.1 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollLibrary.qbt $
+ *
+ * Initial version.
+ *
+ * Revision 1.0.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 06/04/03 10:40:32
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Collections, CollArray, CollHash, CollList, CollPArray, CollWrappers;
+
+type
+ TMiscCollectionLibrary = class
+ public
+ class function ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
+ class function EqualIID(const IID1, IID2: TGUID): Boolean;
+ class function HashCode(Value: String): Integer;
+ class procedure ShuffleArray(var ItemArray: array of ICollectable);
+ class procedure ShuffleList(const List: IList);
+ end;
+
+implementation
+
+{ TMiscCollectionLibrary }
+class function TMiscCollectionLibrary.ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
+begin
+ if ClassName = 'TArray' then
+ Result := TArray
+ else if ClassName = 'THashSet' then
+ Result := THashSet
+ else if ClassName = 'THashMap' then
+ Result := THashMap
+ else if ClassName = 'THashIntegerMap' then
+ Result := THashIntegerMap
+ else if ClassName = 'THashStringMap' then
+ Result := THashStringMap
+ else if ClassName = 'TListSet' then
+ Result := TListSet
+ else if ClassName = 'TListMap' then
+ Result := TListMap
+ else if ClassName = 'TPArrayBag' then
+ Result := TPArrayBag
+ else if ClassName = 'TPArraySet' then
+ Result := TPArraySet
+ else if ClassName = 'TPArrayList' then
+ Result := TPArrayList
+ else if ClassName = 'TPArrayMap' then
+ Result := TPArrayMap
+ else
+ Result := nil;
+end;
+
+class function TMiscCollectionLibrary.EqualIID(const IID1, IID2: TGUID): Boolean;
+begin
+ Result := (IID1.D1 = IID2.D1) and (IID1.D2 = IID2.D2) and (IID1.D3 = IID2.D3) and
+ (IID1.D4[0] = IID2.D4[0]) and (IID1.D4[1] = IID2.D4[1]) and
+ (IID1.D4[2] = IID2.D4[2]) and (IID1.D4[3] = IID2.D4[3]) and
+ (IID1.D4[4] = IID2.D4[4]) and (IID1.D4[5] = IID2.D4[5]) and
+ (IID1.D4[6] = IID2.D4[6]) and (IID1.D4[7] = IID2.D4[7]);
+end;
+
+class function TMiscCollectionLibrary.HashCode(Value: String): Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 1 to Length(Value) do
+ Result := (Result shl 1) xor Ord(Value[I]);
+end;
+
+class procedure TMiscCollectionLibrary.ShuffleArray(var ItemArray: array of ICollectable);
+var
+ Item: ICollectable;
+ ArraySize, I, Index: Integer;
+begin
+ Randomize;
+ ArraySize := Length(ItemArray);
+ for I := 0 to ArraySize - 1 do
+ begin
+ Index := (I + Random(ArraySize - 1) + 1) mod ArraySize;
+ Item := ItemArray[I];
+ ItemArray[I] := ItemArray[Index];
+ ItemArray[Index] := Item;
+ end;
+end;
+
+class procedure TMiscCollectionLibrary.ShuffleList(const List: IList);
+var
+ ListSize, I: Integer;
+begin
+ Randomize;
+ ListSize := List.GetSize;
+ for I := 0 to ListSize - 1 do
+ begin
+ List.Exchange(I, (I + Random(ListSize - 1) + 1) mod ListSize);
+ end;
+end;
+
+
+end.
diff --git a/Medley/src/lib/collections/CollList.pas b/Medley/src/lib/collections/CollList.pas
new file mode 100644
index 00000000..68aa0d66
--- /dev/null
+++ b/Medley/src/lib/collections/CollList.pas
@@ -0,0 +1,270 @@
+unit CollList;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $
+ *
+ * Collection implementations based on sorted TPArrayList instances.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:05:54
+ * Capacity property.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 14/02/04 17:45:38
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:41:52
+ * Uses TExposedPArrayList to improve performance.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+uses
+ Collections, CollPArray;
+
+type
+ TListSet = class(TAbstractSet)
+ private
+ FList: TExposedPArrayList;
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSize: Integer; override;
+ end;
+
+ TListMap = class(TAbstractMap)
+ private
+ FList: TExposedPArrayList;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ procedure SetKeyComparator(const Value: IComparator); override;
+ function GetNaturalKeyIID: TGUID; override;
+ function GetSize: Integer; override;
+ end;
+
+implementation
+
+type
+ TListPosition = class(TCollectionPosition)
+ private
+ FSearchResult: TSearchResult;
+ public
+ constructor Create(Found: Boolean; SearchResult: TSearchResult);
+ property SearchResult: TSearchResult read FSearchResult;
+ end;
+
+constructor TListSet.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TExposedPArrayList.Create(NaturalItemsOnly);
+ FList.Comparator := Comparator;
+ FList.Sort;
+end;
+
+destructor TListSet.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ SearchResult: TSearchResult;
+begin
+ SearchResult := FList.Search(Item);
+ Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+var
+ SearchResult: TSearchResult;
+ Index: Integer;
+begin
+ SearchResult := TListPosition(Position).SearchResult;
+ Index := SearchResult.Index;
+ if SearchResult.ResultType = srBeforeIndex then
+ FList.TrueInsert(Index, Item)
+ else
+ FList.TrueAppend(Item);
+end;
+
+procedure TListSet.TrueClear;
+begin
+ FList.Clear;
+end;
+
+function TListSet.TrueGet(Position: TCollectionPosition): ICollectable;
+begin
+ Result := FList.Items[TListPosition(Position).SearchResult.Index];
+end;
+
+procedure TListSet.TrueRemove2(Position: TCollectionPosition);
+begin
+ FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+function TListSet.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TListSet.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TListSet.GetIterator: IIterator;
+begin
+ Result := FList.GetIterator;
+end;
+
+function TListSet.GetNaturalItemIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TListSet.GetSize: Integer;
+begin
+ Result := FList.Size;
+end;
+
+constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly, NaturalKeysOnly);
+ FList := TExposedPArrayList.Create(false);
+ FList.Comparator := AssociationComparator;
+ FList.Sort;
+end;
+
+destructor TListMap.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TListMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := TAssociationIterator.Create(FList.GetIterator);
+end;
+
+function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ Association: IAssociation;
+ SearchResult: TSearchResult;
+begin
+ Association := TAssociation.Create(Key, nil);
+ SearchResult := FList.Search(Association);
+ Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListMap.TrueClear;
+begin
+ FList.Clear;
+end;
+
+function TListMap.TrueGet(Position: TCollectionPosition): IAssociation;
+begin
+ Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+end;
+
+function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ SearchResult: TSearchResult;
+ Index: Integer;
+begin
+ SearchResult := TListPosition(Position).SearchResult;
+ Index := SearchResult.Index;
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ Result := (FList.Items[Index]) as IAssociation;
+ FList.Items[Index] := Association;
+ end
+ else if SearchResult.ResultType = srBeforeIndex then
+ FList.TrueInsert(Index, Association)
+ else
+ FList.TrueAppend(Association);
+end;
+
+function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+begin
+ Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+ FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+procedure TListMap.SetKeyComparator(const Value: IComparator);
+begin
+ inherited SetKeyComparator(Value);
+ FList.Sort;
+end;
+
+function TListMap.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TListMap.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TListMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TListMap.GetSize: Integer;
+begin
+ Result := FList.Size;
+end;
+
+constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult);
+begin
+ inherited Create(Found);
+ FSearchResult := SearchResult;
+end;
+
+end.
diff --git a/Medley/src/lib/collections/CollPArray.pas b/Medley/src/lib/collections/CollPArray.pas
new file mode 100644
index 00000000..5ebd534b
--- /dev/null
+++ b/Medley/src/lib/collections/CollPArray.pas
@@ -0,0 +1,689 @@
+unit CollPArray;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.2.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollPArray.qbt $
+ *
+ * Collection implementations based on TList.
+ *
+ * Revision 1.2.1.2 by: Matthew Greet Rev date: 12/06/04 20:08:30
+ * Capacity property.
+ *
+ * Revision 1.2.1.1 by: Matthew Greet Rev date: 14/02/04 17:46:10
+ * v1.0 branch.
+ *
+ * Revision 1.2 by: Matthew Greet Rev date: 28/04/03 15:07:14
+ * Correctly handles nil items.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:43:16
+ * Added TPArrayMap and TExposedPArrayList.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes,
+ Collections;
+
+type
+ TPArrayBag = class(TAbstractBag)
+ private
+ FList: TList;
+ protected
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueClear; override;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ end;
+
+ TPArraySet = class(TAbstractSet)
+ private
+ FList: TList;
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ end;
+
+ TPArrayList = class(TAbstractList)
+ private
+ FList: TList;
+ protected
+ function TrueGetItem(Index: Integer): ICollectable; override;
+ procedure TrueSetItem(Index: Integer; const Item: ICollectable); override;
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueDelete(Index: Integer): ICollectable; override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ end;
+
+ TPArrayMap = class(TAbstractMap)
+ private
+ FList: TList;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ end;
+
+ // Same as TPArrayList but raises method visibilities so items can be manually
+ // appended or inserted without resetting sort flag.
+ TExposedPArrayList = class(TPArrayList)
+ public
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ end;
+
+
+implementation
+
+type
+ TPArrayIterator = class(TAbstractIterator)
+ private
+ FList: TList;
+ FIndex: Integer;
+ protected
+ constructor Create(List: TList; AllowRemove: Boolean);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ TPArrayAssociationIterator = class(TAbstractAssociationIterator)
+ private
+ FList: TList;
+ FIndex: Integer;
+ protected
+ constructor Create(List: TList; AllowRemove: Boolean);
+ function TrueFirst: IAssociation; override;
+ function TrueNext: IAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ TPArrayPosition = class(TCollectionPosition)
+ private
+ FIndex: Integer;
+ public
+ constructor Create(Found: Boolean; Index: Integer);
+ property Index: Integer read FIndex;
+ end;
+
+constructor TPArrayBag.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayBag.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayBag.TrueAdd(const Item: ICollectable): Boolean;
+begin
+ FList.Add(Pointer(Item));
+ Result := true;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+procedure TPArrayBag.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayBag.TrueContains(const Item: ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) and not Success do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(FList[I]));
+ Inc(I);
+ end;
+ Result := Success;
+end;
+
+function TPArrayBag.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ I: Integer;
+ Found: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Found := false;
+ Result := nil;
+ while (I < FList.Count) and not Found do
+ begin
+ Item2 := ICollectable(FList[I]);
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Found := true;
+ Result := Item2;
+ FList.Delete(I);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item2 <> nil then
+ Item2._Release;
+ end
+ else
+ Inc(I);
+ end;
+end;
+
+function TPArrayBag.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: TPArrayBag;
+ Item2: ICollectable;
+ I: Integer;
+begin
+ // Sequential search
+ I := 0;
+ ResultCollection := TPArrayBag.Create;
+ while I < FList.Count do
+ begin
+ Item2 := ICollectable(FList[I]);
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ FList.Delete(I);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end
+ else
+ Inc(I);
+ end;
+ Result := ResultCollection;
+end;
+
+function TPArrayBag.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayBag.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayBag.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArrayBag.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArraySet.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArraySet.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArraySet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(FList[I]));
+ if Success then
+ break;
+ Inc(I);
+ end;
+ Result := TPArrayPosition.Create(Success, I);
+end;
+
+procedure TPArraySet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+begin
+ FList.Add(Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._AddRef;
+end;
+
+procedure TPArraySet.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArraySet.TrueGet(Position: TCollectionPosition): ICollectable;
+begin
+ Result := ICollectable(FList.Items[TPArrayPosition(Position).Index]);
+end;
+
+procedure TPArraySet.TrueRemove2(Position: TCollectionPosition);
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FList[TPArrayPosition(Position).Index]);
+ FList.Delete(TPArrayPosition(Position).Index);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+function TPArraySet.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArraySet.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArraySet.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArraySet.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArrayList.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayList.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayList.TrueGetItem(Index: Integer): ICollectable;
+begin
+ Result := ICollectable(FList.Items[Index]);
+end;
+
+procedure TPArrayList.TrueSetItem(Index: Integer; const Item: ICollectable);
+var
+ OldItem: ICollectable;
+begin
+ OldItem := ICollectable(FList[Index]);
+ FList[Index] := Pointer(Item);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+ if OldItem <> nil then
+ OldItem._Release;
+end;
+
+procedure TPArrayList.TrueAppend(const Item: ICollectable);
+begin
+ FList.Add(Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+procedure TPArrayList.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayList.TrueDelete(Index: Integer): ICollectable;
+begin
+ Result := ICollectable(FList[Index]);
+ FList.Delete(Index);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Result <> nil then
+ Result._Release;
+end;
+
+procedure TPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ FList.Insert(Index, Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+function TPArrayList.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayList.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayList.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArrayList.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArrayMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly, NaturalKeysOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayMap.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := TPArrayAssociationIterator.Create(FList, true);
+end;
+
+function TPArrayMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) do
+ begin
+ Success := KeyComparator.Equals(Key, IAssociation(FList[I]).GetKey);
+ if Success then
+ break;
+ Inc(I);
+ end;
+ Result := TPArrayPosition.Create(Success, I);
+end;
+
+procedure TPArrayMap.TrueClear;
+var
+ Association: IAssociation;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Association := IAssociation(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayMap.TrueGet(Position: TCollectionPosition): IAssociation;
+begin
+ Result := IAssociation(FList.Items[TPArrayPosition(Position).Index]);
+end;
+
+function TPArrayMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ OldAssociation: IAssociation;
+ Index: Integer;
+begin
+ if Position.Found then
+ begin
+ Index := (Position as TPArrayPosition).Index;
+ OldAssociation := IAssociation(FList[Index]);
+ FList[Index] := Pointer(Association);
+ end
+ else
+ begin
+ OldAssociation := nil;
+ FList.Add(Pointer(Association));
+ end;
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ if OldAssociation <> nil then
+ OldAssociation._Release;
+end;
+
+function TPArrayMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+var
+ OldAssociation: IAssociation;
+begin
+ OldAssociation := IAssociation(FList[TPArrayPosition(Position).Index]);
+ FList.Delete(TPArrayPosition(Position).Index);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ OldAssociation._Release;
+end;
+
+function TPArrayMap.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayMap.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayMap.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TExposedPArrayList.TrueAppend(const Item: ICollectable);
+begin
+ inherited TrueAppend(Item);
+end;
+
+procedure TExposedPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ inherited TrueInsert(Index, Item);
+end;
+
+{ TPArrayIterator }
+constructor TPArrayIterator.Create(List: TList; AllowRemove: Boolean);
+begin
+ inherited Create(AllowRemove);
+ FList := List;
+ FIndex := -1;
+end;
+
+function TPArrayIterator.TrueFirst: ICollectable;
+begin
+ FIndex := 0;
+ if FIndex < FList.Count then
+ Result := ICollectable(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+function TPArrayIterator.TrueNext: ICollectable;
+begin
+ Inc(FIndex);
+ if FIndex < FList.Count then
+ Result := ICollectable(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+procedure TPArrayIterator.TrueRemove;
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FList[FIndex]);
+ FList.Delete(FIndex);
+ Dec(FIndex);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+{ TPArrayAssociationIterator }
+constructor TPArrayAssociationIterator.Create(List: TList; AllowRemove: Boolean);
+begin
+ inherited Create(AllowRemove);
+ FList := List;
+ FIndex := -1;
+end;
+
+function TPArrayAssociationIterator.TrueFirst: IAssociation;
+begin
+ FIndex := 0;
+ if FIndex < FList.Count then
+ Result := IAssociation(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+function TPArrayAssociationIterator.TrueNext: IAssociation;
+begin
+ Inc(FIndex);
+ if FIndex < FList.Count then
+ Result := IAssociation(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+procedure TPArrayAssociationIterator.TrueRemove;
+var
+ Association: IAssociation;
+begin
+ Association := IAssociation(FList[FIndex]);
+ FList.Delete(FIndex);
+ Dec(FIndex);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+{ TPArrayPosition }
+constructor TPArrayPosition.Create(Found: Boolean; Index: Integer);
+begin
+ inherited Create(Found);
+ FIndex := Index;
+end;
+
+end.
diff --git a/Medley/src/lib/collections/CollWrappers.pas b/Medley/src/lib/collections/CollWrappers.pas
new file mode 100644
index 00000000..513103a2
--- /dev/null
+++ b/Medley/src/lib/collections/CollWrappers.pas
@@ -0,0 +1,876 @@
+unit CollWrappers;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.1 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $
+ *
+ * Various primitive type wrappers, adapters and abstract base classes for
+ * natural items.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04
+ * Primitive type wrapper interfaces added.
+ * Abstract, template classes added.
+ * All classes implement reference counting by descending from
+ * TInterfacedObject.
+ *
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils,
+ Collections;
+
+type
+ IAssociationWrapper = interface
+ ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: ICollectable;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: ICollectable read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ IBoolean = interface
+ ['{62D1D160-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Boolean;
+ property Value: Boolean read GetValue;
+ end;
+
+ ICardinal = interface
+ ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Cardinal;
+ property Value: Cardinal read GetValue;
+ end;
+
+ IChar = interface
+ ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Char;
+ property Value: Char read GetValue;
+ end;
+
+ IClass = interface
+ ['{7A84B660-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: TClass;
+ property Value: TClass read GetValue;
+ end;
+
+ IDouble = interface
+ ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Double;
+ property Value: Double read GetValue;
+ end;
+
+ IInteger = interface
+ ['{88ECC300-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Integer;
+ property Value: Integer read GetValue;
+ end;
+
+ IIntegerAssociationWrapper = interface
+ ['{8F582220-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: Integer;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: Integer read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ IInterfaceWrapper = interface
+ ['{962E5100-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: IUnknown;
+ property Value: IUnknown read GetValue;
+ end;
+
+ IObject = interface
+ ['{9C675580-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetValue: TObject;
+ property Value: TObject read GetValue;
+ end;
+
+ IString = interface
+ ['{A420DF80-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: String;
+ property Value: String read GetValue;
+ end;
+
+ IStringAssociationWrapper = interface
+ ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: String;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: String read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TAbstractItem = class(TInterfacedObject, ICollectable)
+ public
+ function GetInstance: TObject; virtual;
+ end;
+
+ TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable)
+ private
+ FKey: Integer;
+ protected
+ function MakeKey: Integer; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: Integer; virtual;
+ end;
+
+ TAbstractMappable = class(TAbstractItem, IEquatable, IMappable)
+ private
+ FKey: ICollectable;
+ protected
+ function MakeKey: ICollectable; virtual; abstract;
+ public
+ destructor Destroy; override;
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: ICollectable; virtual;
+ end;
+
+ TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable)
+ private
+ FKey: String;
+ protected
+ function MakeKey: String; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: String; virtual;
+ end;
+
+ TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: ICollectable;
+ FValue: TObject;
+ public
+ constructor Create(const Key: ICollectable; Value: TObject); overload;
+ constructor Create(Key: Integer; Value: TObject); overload;
+ constructor Create(Key: String; Value: TObject); overload;
+ constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: ICollectable;
+ function GetValue: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: ICollectable read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean)
+ private
+ FValue: Boolean;
+ public
+ constructor Create(Value: Boolean);
+ function GetValue: Boolean;
+ function CompareTo(const Item: ICollectable): Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: Boolean read GetValue;
+ end;
+
+ TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal)
+ private
+ FValue: Cardinal;
+ public
+ constructor Create(Value: Cardinal);
+ function GetValue: Cardinal;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Cardinal read GetValue;
+ end;
+
+ TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar)
+ private
+ FValue: Char;
+ public
+ constructor Create(Value: Char);
+ function GetValue: Char;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Char read GetValue;
+ end;
+
+ TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass)
+ private
+ FValue: TClass;
+ public
+ constructor Create(Value: TClass);
+ function GetValue: TClass;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: TClass read GetValue;
+ end;
+
+ TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble)
+ private
+ FValue: Double;
+ public
+ constructor Create(Value: Double);
+ function GetValue: Double;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Double read GetValue;
+ end;
+
+ TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger)
+ private
+ FValue: Integer;
+ public
+ constructor Create(Value: Integer);
+ function GetValue: Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Integer read GetValue;
+ end;
+
+ TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: Integer;
+ FValue: TObject;
+ public
+ constructor Create(const Key: Integer; Value: TObject); overload;
+ destructor Destroy; override;
+ function Equals(const Item: ICollectable): Boolean;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: Integer;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: Integer read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper)
+ private
+ FValue: IUnknown;
+ public
+ constructor Create(const Value: IUnknown);
+ destructor Destroy; override;
+ function GetValue: IUnknown;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: IUnknown read GetValue;
+ end;
+
+ TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject)
+ private
+ FAutoDestroy: Boolean;
+ FValue: TObject;
+ public
+ constructor Create(Value: TObject); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetValue: TObject;
+ function CompareTo(const Item: ICollectable): Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy;
+ property Value: TObject read GetValue;
+ end;
+
+ TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString)
+ private
+ FValue: String;
+ public
+ constructor Create(Value: String);
+ function GetValue: String;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: String read FValue;
+ end;
+
+ TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: String;
+ FValue: TObject;
+ public
+ constructor Create(const Key: String; Value: TObject); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: String;
+ function GetValue: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: String read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+implementation
+
+{ TAbstractItem }
+function TAbstractItem.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+
+{ TAbstractIntegerMappable }
+procedure TAbstractIntegerMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractIntegerMappable.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+{ TAbstractMappable }
+destructor TAbstractMappable.Destroy;
+begin
+ FKey := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractMappable.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+{ TAbstractStringMappable }
+procedure TAbstractStringMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractStringMappable.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+{ TAssociationWrapper }
+constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+constructor TAssociationWrapper.Create(Key: Integer; Value: TObject);
+begin
+ Create(TIntegerWrapper.Create(Key) as ICollectable, Value);
+end;
+
+constructor TAssociationWrapper.Create(Key: String; Value: TObject);
+begin
+ Create(TStringWrapper.Create(Key) as ICollectable, Value);
+end;
+
+constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean);
+var
+ KeyWrapper: TObjectWrapper;
+begin
+ KeyWrapper := TObjectWrapper.Create(Key);
+ KeyWrapper.AutoDestroy := AutoDestroyKey;
+ Create(KeyWrapper as ICollectable, Value);
+end;
+
+destructor TAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ FKey := nil;
+ inherited Destroy;
+end;
+
+function TAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TAssociationWrapper.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+function TAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value)
+end;
+
+{ TCardinalWrapper }
+constructor TCardinalWrapper.Create(Value: Cardinal);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TCardinalWrapper.GetValue: Cardinal;
+begin
+ Result := FValue;
+end;
+
+function TCardinalWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value)
+end;
+
+function TCardinalWrapper.HashCode: Integer;
+begin
+ Result := FValue;
+end;
+
+function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Cardinal;
+begin
+ Value2 := (Item.GetInstance as TCardinalWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TBooleanWrapper }
+constructor TBooleanWrapper.Create(Value: Boolean);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TBooleanWrapper.GetValue: Boolean;
+begin
+ Result := FValue;
+end;
+
+function TBooleanWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value)
+end;
+
+function TBooleanWrapper.HashCode: Integer;
+begin
+ Result := Ord(FValue);
+end;
+
+function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Boolean;
+begin
+ Value2 := (Item.GetInstance as TBooleanWrapper).Value;
+ if not Value and Value2 then
+ Result := -1
+ else if Value and not Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TCharWrapper }
+constructor TCharWrapper.Create(Value: Char);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TCharWrapper.GetValue: Char;
+begin
+ Result := FValue;
+end;
+
+function TCharWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value)
+end;
+
+function TCharWrapper.HashCode: Integer;
+begin
+ Result := Integer(FValue);
+end;
+
+function TCharWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Char;
+begin
+ Value2 := (Item.GetInstance as TCharWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TClassWrapper }
+constructor TClassWrapper.Create(Value: TClass);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TClassWrapper.GetValue: TClass;
+begin
+ Result := FValue;
+end;
+
+function TClassWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value)
+end;
+
+function TClassWrapper.HashCode: Integer;
+begin
+ Result := Integer(FValue.ClassInfo);
+end;
+
+{ TDoubleWrapper }
+constructor TDoubleWrapper.Create(Value: Double);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TDoubleWrapper.GetValue: Double;
+begin
+ Result := FValue;
+end;
+
+function TDoubleWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value)
+end;
+
+function TDoubleWrapper.HashCode: Integer;
+var
+ DblAsInt: array[0..1] of Integer;
+begin
+ Double(DblAsInt) := Value;
+ Result := DblAsInt[0] xor DblAsInt[1];
+end;
+
+function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Double;
+begin
+ Value2 := (Item.GetInstance as TDoubleWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TIntegerWrapper }
+constructor TIntegerWrapper.Create(Value: Integer);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TIntegerWrapper.GetValue: Integer;
+begin
+ Result := FValue;
+end;
+
+function TIntegerWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value)
+end;
+
+function TIntegerWrapper.HashCode: Integer;
+begin
+ Result := FValue;
+end;
+
+function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Integer;
+begin
+ Value2 := (Item.GetInstance as TIntegerWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TIntegerAssociationWrapper }
+constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TIntegerAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TIntegerAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TIntegerAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value)
+end;
+
+function TIntegerAssociationWrapper.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+{ TStringAssociationWrapper }
+constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TStringAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TStringAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TStringAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value)
+end;
+
+function TStringAssociationWrapper.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+{ TInterfaceWrapper }
+constructor TInterfaceWrapper.Create(const Value: IUnknown);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+destructor TInterfaceWrapper.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TInterfaceWrapper.GetValue: IUnknown;
+begin
+ Result := FValue;
+end;
+
+function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value)
+end;
+
+function TInterfaceWrapper.HashCode: Integer;
+begin
+ Result := Integer(Pointer(FValue));
+end;
+
+{ TObjectWrapper }
+constructor TObjectWrapper.Create(Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FValue := Value;
+end;
+
+destructor TObjectWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TObjectWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TObjectWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TObjectWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TObjectWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value1, Value2: Integer;
+begin
+ Value1 := Integer(Pointer(Self));
+ if Item <> nil then
+ Value2 := Integer(Pointer(Item))
+ else
+ Value2 := Low(Integer);
+ if (Value1 < Value2) then
+ Result := -1
+ else if (Value1 > Value2) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TObjectWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value)
+end;
+
+function TObjectWrapper.HashCode: Integer;
+begin
+ Result := Integer(Pointer(FValue));
+end;
+
+{ TStringWrapper }
+constructor TStringWrapper.Create(Value: String);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TStringWrapper.GetValue: String;
+begin
+ Result := FValue;
+end;
+
+function TStringWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value)
+end;
+
+function TStringWrapper.HashCode: Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 1 to Length(FValue) do
+ Result := (Result shl 1) xor Ord(FValue[I]);
+end;
+
+function TStringWrapper.CompareTo(const Item: ICollectable): Integer;
+begin
+ Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value)
+end;
+
+
+end.
diff --git a/Medley/src/lib/collections/Collections.pas b/Medley/src/lib/collections/Collections.pas
new file mode 100644
index 00000000..0c94173d
--- /dev/null
+++ b/Medley/src/lib/collections/Collections.pas
@@ -0,0 +1,5318 @@
+unit Collections;
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0 $
+ * $Revision: 1.1.1.4 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\Collections.qbt $
+ *
+ * Main unit containing all interface and abstract class definitions.
+ *
+ * Revision 1.1.1.4 by: Matthew Greet Rev date: 14/03/05 23:26:32
+ * Fixed RemoveAll for TAbstractList for sorted lists.
+ *
+ * Revision 1.1.1.3 by: Matthew Greet Rev date: 14/10/04 16:31:18
+ * Fixed memory lean in ContainsKey of TAbstractStringMap and
+ * TAbstractIntegerMap.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:03:26
+ * Capacity property.
+ * Memory leak fixed.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 13/02/04 16:12:10
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:36:30
+ * Added integer map and string map collection types with supporting
+ * classes.
+ * Add clone and filter functions with supporting classes.
+ * Added nil not allowed collection error.
+ * Properties appear in collection interfaces as well as abstract
+ * classes.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+const
+ EquatableIID: TGUID = '{EAC823A7-0B90-11D7-8120-0002E3165EF8}';
+ HashableIID: TGUID = '{98998440-4C3E-11D7-8120-0002E3165EF8}';
+ ComparableIID: TGUID = '{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}';
+ MappableIID: TGUID = '{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}';
+ StringMappableIID: TGUID = '{3CC61F40-5F92-11D7-8120-0002E3165EF8}';
+ IntegerMappableIID: TGUID = '{774FC760-5F92-11D7-8120-0002E3165EF8}';
+
+type
+ TDefaultComparator = class;
+ TNaturalComparator = class;
+ ICollectable = interface;
+
+ TCollectableArray = array of ICollectable;
+ TIntegerArray = array of Integer;
+ TStringArray = array of String;
+ TListArray = array of TList;
+
+ TCollectionError = (ceOK, ceDuplicate, ceDuplicateKey, ceFixedSize, ceNilNotAllowed, ceNotNaturalItem, ceOutOfRange);
+ TCollectionErrors = set of TCollectionError;
+
+ TSearchResultType = (srNotFound, srFoundAtIndex, srBeforeIndex, srAfterEnd);
+
+ TCollectionType = (ctBag, ctSet, ctList, ctMap, ctIntegerMap, ctStringMap);
+
+ TCollectionFilterFunc = function (const Item: ICollectable): Boolean of object;
+ TCollectionCompareFunc = function (const Item1, Item2: ICollectable): Integer of object;
+
+ TSearchResult = record
+ ResultType: TSearchResultType;
+ Index: Integer;
+ end;
+
+ ICollectable = interface
+ ['{98998441-4C3E-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ end;
+
+ IEquatable = interface
+ ['{EAC823A7-0B90-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ end;
+
+ IHashable = interface(IEquatable)
+ ['{98998440-4C3E-11D7-8120-0002E3165EF8}']
+ function HashCode: Integer;
+ end;
+
+ IComparable = interface(IEquatable)
+ ['{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}']
+ function CompareTo(const Item: ICollectable): Integer;
+ end;
+
+ IMappable = interface(IEquatable)
+ ['{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}']
+ function GetKey: ICollectable;
+ end;
+
+ IStringMappable = interface(IEquatable)
+ ['{3CC61F40-5F92-11D7-8120-0002E3165EF8}']
+ function GetKey: String;
+ end;
+
+ IIntegerMappable = interface(IEquatable)
+ ['{774FC760-5F92-11D7-8120-0002E3165EF8}']
+ function GetKey: Integer;
+ end;
+
+ IComparator = interface
+ ['{1F20CD60-10FE-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ function Compare(const Item1, Item2: ICollectable): Integer;
+ function Equals(const Item1, Item2: ICollectable): Boolean; overload;
+ function Equals(const Comparator: IComparator): Boolean; overload;
+ end;
+
+ IFilter = interface
+ ['{27FE44C0-638E-11D7-8120-0002E3165EF8}']
+ function Accept(const Item: ICollectable): Boolean;
+ end;
+
+ IIterator = interface
+ ['{F6930500-1113-11D7-8120-0002E3165EF8}']
+ function GetAllowRemoval: Boolean;
+ function CurrentItem: ICollectable;
+ function EOF: Boolean;
+ function First: ICollectable;
+ function Next: ICollectable;
+ function Remove: Boolean;
+ end;
+
+ IMapIterator = interface(IIterator)
+ ['{848CC0E0-2A31-11D7-8120-0002E3165EF8}']
+ function CurrentKey: ICollectable;
+ end;
+
+ IIntegerMapIterator = interface(IIterator)
+ ['{C7169780-606C-11D7-8120-0002E3165EF8}']
+ function CurrentKey: Integer;
+ end;
+
+ IStringMapIterator = interface(IIterator)
+ ['{1345ED20-5F93-11D7-8120-0002E3165EF8}']
+ function CurrentKey: String;
+ end;
+
+ IAssociation = interface(ICollectable)
+ ['{556CD700-4DB3-11D7-8120-0002E3165EF8}']
+ function GetKey: ICollectable;
+ function GetValue: ICollectable;
+ end;
+
+ IIntegerAssociation = interface(ICollectable)
+ ['{ED954420-5F94-11D7-8120-0002E3165EF8}']
+ function GetKey: Integer;
+ function GetValue: ICollectable;
+ end;
+
+ IStringAssociation = interface(ICollectable)
+ ['{FB87D2A0-5F94-11D7-8120-0002E3165EF8}']
+ function GetKey: String;
+ function GetValue: ICollectable;
+ end;
+
+ IAssociationComparator = interface(IComparator)
+ ['{EA9BE6E0-A852-11D8-B93A-0002E3165EF8}']
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(Value: IComparator);
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ end;
+
+ IIntegerAssociationComparator = interface(IComparator)
+ ['{EA9BE6E1-A852-11D8-B93A-0002E3165EF8}']
+ end;
+
+ IStringAssociationComparator = interface(IComparator)
+ ['{EA9BE6E2-A852-11D8-B93A-0002E3165EF8}']
+ end;
+
+ ICollection = interface
+ ['{EAC823AC-0B90-11D7-8120-0002E3165EF8}']
+ function GetAsArray: TCollectableArray;
+ function GetCapacity: Integer;
+ procedure SetCapacity(Value: Integer);
+ function GetComparator: IComparator;
+ procedure SetComparator(const Value: IComparator);
+ function GetDuplicates: Boolean;
+ function GetFixedSize: Boolean;
+ function GetIgnoreErrors: TCollectionErrors;
+ procedure SetIgnoreErrors(Value: TCollectionErrors);
+ function GetInstance: TObject;
+ function GetIterator: IIterator; overload;
+ function GetIterator(const Filter: IFilter): IIterator; overload;
+ function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload;
+ function GetNaturalItemIID: TGUID;
+ function GetNaturalItemsOnly: Boolean;
+ function GetSize: Integer;
+ function GetType: TCollectionType;
+ function Add(const Item: ICollectable): Boolean; overload;
+ function Add(const ItemArray: array of ICollectable): Integer; overload;
+ function Add(const Collection: ICollection): Integer; overload;
+ function Clear: Integer;
+ function Clone: ICollection;
+ function Contains(const Item: ICollectable): Boolean; overload;
+ function Contains(const ItemArray: array of ICollectable): Boolean; overload;
+ function Contains(const Collection: ICollection): Boolean; overload;
+ function Equals(const Collection: ICollection): Boolean;
+ function Find(const Filter: IFilter): ICollectable; overload;
+ function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload;
+ function FindAll(const Filter: IFilter = nil): ICollection; overload;
+ function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload;
+ function IsEmpty: Boolean;
+ function IsNaturalItem(const Item: ICollectable): Boolean;
+ function IsNilAllowed: Boolean;
+ function ItemAllowed(const Item: ICollectable): TCollectionError;
+ function ItemCount(const Item: ICollectable): Integer; overload;
+ function ItemCount(const ItemArray: array of ICollectable): Integer; overload;
+ function ItemCount(const Collection: ICollection): Integer; overload;
+ function Matching(const ItemArray: array of ICollectable): ICollection; overload;
+ function Matching(const Collection: ICollection): ICollection; overload;
+ function Remove(const Item: ICollectable): ICollectable; overload;
+ function Remove(const ItemArray: array of ICollectable): ICollection; overload;
+ function Remove(const Collection: ICollection): ICollection; overload;
+ function RemoveAll(const Item: ICollectable): ICollection; overload;
+ function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload;
+ function RemoveAll(const Collection: ICollection): ICollection; overload;
+ function Retain(const ItemArray: array of ICollectable): ICollection; overload;
+ function Retain(const Collection: ICollection): ICollection; overload;
+ property AsArray: TCollectableArray read GetAsArray;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Comparator: IComparator read GetComparator write SetComparator;
+ property FixedSize: Boolean read GetFixedSize;
+ property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
+ property NaturalItemIID: TGUID read GetNaturalItemIID;
+ property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
+ property Size: Integer read GetSize;
+ end;
+
+ IBag = interface(ICollection)
+ ['{C29C9560-2D59-11D7-8120-0002E3165EF8}']
+ function CloneAsBag: IBag;
+ end;
+
+ ISet = interface(ICollection)
+ ['{DD7888E2-0BB1-11D7-8120-0002E3165EF8}']
+ function CloneAsSet: ISet;
+ function Complement(const Universe: ISet): ISet;
+ function Intersect(const Set2: ISet): ISet;
+ function Union(const Set2: ISet): ISet;
+ end;
+
+ IList = interface(ICollection)
+ ['{EE81AB60-0B9F-11D7-8120-0002E3165EF8}']
+ function GetDuplicates: Boolean;
+ procedure SetDuplicates(Value: Boolean);
+ function GetItem(Index: Integer): ICollectable;
+ procedure SetItem(Index: Integer; const Item: ICollectable);
+ function GetSorted: Boolean;
+ procedure SetSorted(Value: Boolean);
+ function CloneAsList: IList;
+ function Delete(Index: Integer): ICollectable;
+ procedure Exchange(Index1, Index2: Integer);
+ function First: ICollectable;
+ function IndexOf(const Item: ICollectable): Integer;
+ function Insert(Index: Integer; const Item: ICollectable): Boolean; overload;
+ function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload;
+ function Insert(Index: Integer; const Collection: ICollection): Integer; overload;
+ function Last: ICollectable;
+ procedure Sort(const Comparator: IComparator); overload;
+ procedure Sort(CompareFunc: TCollectionCompareFunc); overload;
+ property Duplicates: Boolean read GetDuplicates write SetDuplicates;
+ property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
+ property Sorted: Boolean read GetSorted write SetSorted;
+ end;
+
+ IMap = interface(ICollection)
+ ['{AD458280-2A6B-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: ICollectable): ICollectable;
+ procedure SetItem(const Key, Item: ICollectable);
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(const Value: IComparator);
+ function GetKeyIterator: IIterator;
+ function GetKeys: ISet;
+ function GetMapIterator: IMapIterator;
+ function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload;
+ function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload;
+ function GetNaturalKeyIID: TGUID;
+ function GetNaturalKeysOnly: Boolean;
+ function GetValues: ICollection;
+ function CloneAsMap: IMap;
+ function ContainsKey(const Key: ICollectable): Boolean; overload;
+ function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload;
+ function ContainsKey(const Collection: ICollection): Boolean; overload;
+ function Get(const Key: ICollectable): ICollectable;
+ function IsNaturalKey(const Key: ICollectable): Boolean;
+ function KeyAllowed(const Key: ICollectable): TCollectionError;
+ function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function MatchingKey(const Collection: ICollection): ICollection; overload;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key, Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IMap): ICollection; overload;
+ function RemoveKey(const Key: ICollectable): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function RemoveKey(const Collection: ICollection): ICollection; overload;
+ function RetainKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function RetainKey(const Collection: ICollection): ICollection; overload;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
+ property NaturalKeyIID: TGUID read GetNaturalKeyIID;
+ property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
+ end;
+
+ IIntegerMap = interface(ICollection)
+ ['{93DBA9A0-606C-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: Integer): ICollectable;
+ procedure SetItem(const Key: Integer; const Item: ICollectable);
+ function GetKeys: ISet;
+ function GetMapIterator: IIntegerMapIterator;
+ function GetValues: ICollection;
+ function CloneAsIntegerMap: IIntegerMap;
+ function ContainsKey(const Key: Integer): Boolean; overload;
+ function ContainsKey(const KeyArray: array of Integer): Boolean; overload;
+ function Get(const Key: Integer): ICollectable;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IIntegerMap): ICollection; overload;
+ function RemoveKey(const Key: Integer): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of Integer): ICollection; overload;
+ function RetainKey(const KeyArray: array of Integer): ICollection; overload;
+ property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ IStringMap = interface(ICollection)
+ ['{20531A20-5F92-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: String): ICollectable;
+ procedure SetItem(const Key: String; const Item: ICollectable);
+ function GetKeys: ISet;
+ function GetMapIterator: IStringMapIterator;
+ function GetValues: ICollection;
+ function CloneAsStringMap: IStringMap;
+ function ContainsKey(const Key: String): Boolean; overload;
+ function ContainsKey(const KeyArray: array of String): Boolean; overload;
+ function Get(const Key: String): ICollectable;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key: String; const Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IStringMap): ICollection; overload;
+ function RemoveKey(const Key: String): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of String): ICollection; overload;
+ function RetainKey(const KeyArray: array of String): ICollection; overload;
+ property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TCollectionPosition = class
+ private
+ FFound: Boolean;
+ public
+ constructor Create(Found: Boolean);
+ property Found: Boolean read FFound;
+ end;
+
+ TAbstractComparator = class(TInterfacedObject, IComparator)
+ public
+ class function GetDefaultComparator: IComparator;
+ class function GetNaturalComparator: IComparator;
+ class function GetReverseNaturalComparator: IComparator;
+ function GetInstance: TObject;
+ function Compare(const Item1, Item2: ICollectable): Integer; virtual; abstract;
+ function Equals(const Item1, Item2: ICollectable): Boolean; overload; virtual; abstract;
+ function Equals(const Comparator: IComparator): Boolean; overload; virtual;
+ end;
+
+ TDefaultComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TNaturalComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TReverseNaturalComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TAssociation = class(TInterfacedObject, ICollectable, IAssociation)
+ private
+ FKey: ICollectable;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key, Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: ICollectable;
+ function GetValue: ICollectable;
+ end;
+
+ TIntegerAssociation = class(TInterfacedObject, ICollectable, IIntegerAssociation)
+ private
+ FKey: Integer;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key: Integer; const Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: Integer;
+ function GetValue: ICollectable;
+ end;
+
+ TStringAssociation = class(TInterfacedObject, ICollectable, IStringAssociation)
+ private
+ FKey: String;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key: String; const Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: String;
+ function GetValue: ICollectable;
+ end;
+
+ TAssociationComparator = class(TAbstractComparator, IAssociationComparator)
+ private
+ FKeyComparator: IComparator;
+ public
+ constructor Create(NaturalKeys: Boolean = false);
+ destructor Destroy; override;
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(Value: IComparator);
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ end;
+
+ TIntegerAssociationComparator = class(TAbstractComparator, IIntegerAssociationComparator)
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TStringAssociationComparator = class(TAbstractComparator, IStringAssociationComparator)
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+
+
+ TAbstractCollection = class(TInterfacedObject, ICollection)
+ private
+ FCreated: Boolean; // Required to avoid passing destroyed object reference to exception
+ FComparator: IComparator;
+ FIgnoreErrors: TCollectionErrors;
+ FNaturalItemsOnly: Boolean;
+ protected
+ procedure CollectionError(ErrorType: TCollectionError);
+ procedure InitFrom(const Collection: ICollection); overload; virtual;
+ function TrueAdd(const Item: ICollectable): Boolean; virtual; abstract;
+ procedure TrueClear; virtual; abstract;
+ function TrueContains(const Item: ICollectable): Boolean; virtual; abstract;
+ function TrueItemCount(const Item: ICollectable): Integer; virtual;
+ function TrueRemove(const Item: ICollectable): ICollectable; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; virtual; abstract;
+ public
+ constructor Create; overload; virtual;
+ constructor Create(NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Collection: ICollection); overload; virtual;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalItems: Boolean; virtual;
+ function GetAsArray: TCollectableArray; virtual;
+ function GetCapacity: Integer; virtual; abstract;
+ procedure SetCapacity(Value: Integer); virtual; abstract;
+ function GetComparator: IComparator; virtual;
+ procedure SetComparator(const Value: IComparator); virtual;
+ function GetDuplicates: Boolean; virtual;
+ function GetFixedSize: Boolean; virtual;
+ function GetIgnoreErrors: TCollectionErrors;
+ procedure SetIgnoreErrors(Value: TCollectionErrors);
+ function GetInstance: TObject;
+ function GetIterator: IIterator; overload; virtual; abstract;
+ function GetIterator(const Filter: IFilter): IIterator; overload; virtual;
+ function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; virtual;
+ function GetNaturalItemIID: TGUID; virtual; abstract;
+ function GetNaturalItemsOnly: Boolean; virtual;
+ function GetSize: Integer; virtual; abstract;
+ function GetType: TCollectionType; virtual; abstract;
+ function Add(const Item: ICollectable): Boolean; overload; virtual;
+ function Add(const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function Add(const Collection: ICollection): Integer; overload; virtual;
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+ function Clear: Integer; virtual;
+ function Clone: ICollection; virtual;
+ function Contains(const Item: ICollectable): Boolean; overload; virtual;
+ function Contains(const ItemArray: array of ICollectable): Boolean; overload; virtual;
+ function Contains(const Collection: ICollection): Boolean; overload; virtual;
+ function Equals(const Collection: ICollection): Boolean; virtual;
+ function Find(const Filter: IFilter): ICollectable; overload; virtual;
+ function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; virtual;
+ function FindAll(const Filter: IFilter): ICollection; overload; virtual;
+ function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; virtual;
+ function IsEmpty: Boolean; virtual;
+ function IsNaturalItem(const Item: ICollectable): Boolean; virtual;
+ function IsNilAllowed: Boolean; virtual; abstract;
+ function ItemAllowed(const Item: ICollectable): TCollectionError; virtual;
+ function ItemCount(const Item: ICollectable): Integer; overload; virtual;
+ function ItemCount(const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function ItemCount(const Collection: ICollection): Integer; overload; virtual;
+ function Matching(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Matching(const Collection: ICollection): ICollection; overload; virtual;
+ function Remove(const Item: ICollectable): ICollectable; overload; virtual;
+ function Remove(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Remove(const Collection: ICollection): ICollection; overload; virtual;
+ function RemoveAll(const Item: ICollectable): ICollection; overload; virtual;
+ function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function RemoveAll(const Collection: ICollection): ICollection; overload; virtual;
+ function Retain(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Retain(const Collection: ICollection): ICollection; overload; virtual;
+ property AsArray: TCollectableArray read GetAsArray;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Comparator: IComparator read GetComparator write SetComparator;
+ property FixedSize: Boolean read GetFixedSize;
+ property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
+ property NaturalItemIID: TGUID read GetNaturalItemIID;
+ property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
+ property Size: Integer read GetSize;
+ end;
+
+ TAbstractBag = class(TAbstractCollection, IBag)
+ public
+ function CloneAsBag: IBag; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function IsNilAllowed: Boolean; override;
+ end;
+
+ TAbstractSet = class (TAbstractCollection, ISet)
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); virtual; abstract;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ function GetDuplicates: Boolean; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function CloneAsSet: ISet; virtual;
+ function Complement(const Universe: ISet): ISet; overload; virtual;
+ function Intersect(const Set2: ISet): ISet; overload; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Union(const Set2: ISet): ISet; overload; virtual;
+ end;
+
+ TAbstractList = class(TAbstractCollection, IList)
+ private
+ FDuplicates: Boolean;
+ FSorted: Boolean;
+ protected
+ function BinarySearch(const Item: ICollectable): TSearchResult; virtual;
+ procedure InitFrom(const Collection: ICollection); override;
+ procedure QuickSort(Lo, Hi: Integer; const Comparator: IComparator); overload; virtual;
+ procedure QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); overload; virtual;
+ function SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGetItem(Index: Integer): ICollectable; virtual; abstract;
+ procedure TrueSetItem(Index: Integer; const Item: ICollectable); virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueAppend(const Item: ICollectable); virtual; abstract;
+ function TrueDelete(Index: Integer): ICollectable; virtual; abstract;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); virtual; abstract;
+ function TrueItemCount(const Item: ICollectable): Integer; override;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ function GetDuplicates: Boolean; override;
+ procedure SetDuplicates(Value: Boolean); virtual;
+ function GetItem(Index: Integer): ICollectable; virtual;
+ procedure SetItem(Index: Integer; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSorted: Boolean; virtual;
+ procedure SetSorted(Value: Boolean); virtual;
+ function GetType: TCollectionType; override;
+ function CloneAsList: IList; virtual;
+ function Delete(Index: Integer): ICollectable; virtual;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function First: ICollectable; virtual;
+ function IndexOf(const Item: ICollectable): Integer; virtual;
+ function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; virtual;
+ function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function Insert(Index: Integer; const Collection: ICollection): Integer; overload; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Last: ICollectable; virtual;
+ function Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
+ procedure Sort(const SortComparator: IComparator = nil); overload; virtual;
+ procedure Sort(CompareFunc: TCollectionCompareFunc); overload; virtual;
+ property Duplicates: Boolean read GetDuplicates write SetDuplicates;
+ property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
+ property Sorted: Boolean read GetSorted write SetSorted;
+ end;
+
+ TAbstractMap = class(TAbstractCollection, IMap)
+ private
+ FAssociationComparator: IAssociationComparator;
+ FKeyComparator: IComparator;
+ FNaturalKeysOnly: Boolean;
+ protected
+ function GetAssociationIterator: IMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; virtual; abstract;
+ procedure InitFrom(const Collection: ICollection); override;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IAssociationComparator read FAssociationComparator;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+// Don't use this parameter signature as it hits a compiler bug in D5.
+// constructor Create(const KeyArray, ItemArray: TCollectableArray; NaturalItemsOnly: Boolean = false; NaturalKeysOnly: Boolean = true); overload; virtual;
+ constructor Create(const Map: IMap); overload; virtual;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalKeys: Boolean; virtual;
+ function GetItem(const Key: ICollectable): ICollectable; virtual;
+ procedure SetItem(const Key, Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeyComparator: IComparator; virtual;
+ procedure SetKeyComparator(const Value: IComparator); virtual;
+ function GetKeyIterator: IIterator; virtual;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IMapIterator; virtual;
+ function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; virtual;
+ function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetNaturalKeyIID: TGUID; virtual;
+ function GetNaturalKeysOnly: Boolean; virtual;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsMap: IMap; virtual;
+ function ContainsKey(const Key: ICollectable): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; virtual;
+ function ContainsKey(const Collection: ICollection): Boolean; overload; virtual;
+ function Get(const Key: ICollectable): ICollectable; virtual;
+ function KeyAllowed(const Key: ICollectable): TCollectionError; virtual;
+ function IsNaturalKey(const Key: ICollectable): Boolean; virtual;
+ function IsNilAllowed: Boolean; override;
+ function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function MatchingKey(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key, Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: ICollectable): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function RemoveKey(const Collection: ICollection): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function RetainKey(const Collection: ICollection): ICollection; overload; virtual;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
+ property NaturalKeyIID: TGUID read GetNaturalKeyIID;
+ property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
+ end;
+
+ TAbstractIntegerMap = class(TAbstractCollection, IIntegerMap)
+ private
+ FAssociationComparator: IIntegerAssociationComparator;
+ protected
+ function GetAssociationIterator: IIntegerMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: Integer): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IIntegerAssociationComparator read FAssociationComparator;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Map: IIntegerMap); overload; virtual;
+ destructor Destroy; override;
+ function GetItem(const Key: Integer): ICollectable; virtual;
+ procedure SetItem(const Key: Integer; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IIntegerMapIterator; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsIntegerMap: IIntegerMap; virtual;
+ function ContainsKey(const Key: Integer): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of Integer): Boolean; overload; virtual;
+ function Get(const Key: Integer): ICollectable; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IIntegerMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: Integer): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of Integer): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of Integer): ICollection; overload; virtual;
+ property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TAbstractStringMap = class(TAbstractCollection, IStringMap)
+ private
+ FAssociationComparator: IStringAssociationComparator;
+ protected
+ function GetAssociationIterator: IStringMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: String): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IStringAssociationComparator read FAssociationComparator;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Map: IStringMap); overload; virtual;
+ destructor Destroy; override;
+ function GetItem(const Key: String): ICollectable; virtual;
+ procedure SetItem(const Key: String; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IStringMapIterator; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsStringMap: IStringMap; virtual;
+ function ContainsKey(const Key: String): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of String): Boolean; overload; virtual;
+ function Get(const Key: String): ICollectable; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key: String; const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IStringMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: String): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of String): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of String): ICollection; overload; virtual;
+ property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TAbstractCollectionClass = class of TAbstractCollection;
+ TAbstractBagClass = class of TAbstractBag;
+ TAbstractSetClass = class of TAbstractSet;
+ TAbstractListClass = class of TAbstractList;
+ TAbstractMapClass = class of TAbstractMap;
+ TAbstractIntegerMapClass = class of TAbstractIntegerMap;
+ TAbstractStringMapClass = class of TAbstractStringMap;
+
+ TAbstractIterator = class(TInterfacedObject, IIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FItem: ICollectable;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: ICollectable; virtual; abstract;
+ function TrueNext: ICollectable; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractListIterator = class(TAbstractIterator)
+ private
+ FCollection: TAbstractList;
+ FIndex: Integer;
+ protected
+ constructor Create(Collection: TAbstractList);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ TAbstractMapIterator = class(TAbstractIterator, IMapIterator)
+ public
+ function CurrentKey: ICollectable; virtual; abstract;
+ end;
+
+ TAbstractAssociationIterator = class(TInterfacedObject, IIterator, IMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IAssociation; virtual; abstract;
+ function TrueNext: IAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: ICollectable; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractIntegerAssociationIterator = class(TInterfacedObject, IIterator, IIntegerMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IIntegerAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IIntegerAssociation; virtual; abstract;
+ function TrueNext: IIntegerAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: Integer; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractStringAssociationIterator = class(TInterfacedObject, IIterator, IStringMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IStringAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IStringAssociation; virtual; abstract;
+ function TrueNext: IStringAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: String; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAssociationIterator = class(TAbstractIterator, IMapIterator)
+ private
+ FIterator: IIterator;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator);
+ destructor Destroy; override;
+ function CurrentItem: ICollectable; override;
+ function CurrentKey: ICollectable; virtual;
+ end;
+
+ TAssociationKeyIterator = class(TAbstractIterator)
+ private
+ FIterator: IMapIterator;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator);
+ destructor Destroy; override;
+ end;
+
+ TAbstractFilter = class(TInterfacedObject, IFilter)
+ public
+ function Accept(const Item: ICollectable): Boolean; virtual; abstract;
+ end;
+
+ TFilterIterator = class(TAbstractIterator)
+ private
+ FIterator: IIterator;
+ FFilter: IFilter;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ end;
+
+ TFilterFuncIterator = class(TAbstractIterator)
+ private
+ FIterator: IIterator;
+ FFilterFunc: TCollectionFilterFunc;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ end;
+
+ TKeyFilterMapIterator = class(TAbstractMapIterator)
+ private
+ FIterator: IMapIterator;
+ FFilter: IFilter;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ function CurrentKey: ICollectable; override;
+ end;
+
+ TKeyFilterFuncMapIterator = class(TAbstractMapIterator)
+ private
+ FIterator: IMapIterator;
+ FFilterFunc: TCollectionFilterFunc;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ function CurrentKey: ICollectable; override;
+ end;
+
+
+ ECollectionError = class(Exception)
+ private
+ FCollection: ICollection;
+ FErrorType: TCollectionError;
+ public
+ constructor Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
+ property Collection: ICollection read FCollection;
+ property ErrorType: TCollectionError read FErrorType;
+ end;
+
+implementation
+
+uses
+ Math,
+ CollArray, CollHash, CollList, CollPArray, CollWrappers;
+
+var
+ FDefaultComparator: IComparator;
+ FNaturalComparator: IComparator;
+ FReverseNaturalComparator: IComparator;
+
+{ TCollectionPosition }
+constructor TCollectionPosition.Create(Found: Boolean);
+begin
+ FFound := Found;
+end;
+
+{ TAbstractComparator }
+class function TAbstractComparator.GetDefaultComparator: IComparator;
+begin
+ if FDefaultComparator = nil then
+ FDefaultComparator := TDefaultComparator.Create;
+ Result := FDefaultComparator;
+end;
+
+class function TAbstractComparator.GetNaturalComparator: IComparator;
+begin
+ if FNaturalComparator = nil then
+ FNaturalComparator := TNaturalComparator.Create;
+ Result := FNaturalComparator;
+end;
+
+class function TAbstractComparator.GetReverseNaturalComparator: IComparator;
+begin
+ if FReverseNaturalComparator = nil then
+ FReverseNaturalComparator := TReverseNaturalComparator.Create;
+ Result := FReverseNaturalComparator;
+end;
+
+function TAbstractComparator.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAbstractComparator.Equals(const Comparator: IComparator): Boolean;
+begin
+ Result := (Self = Comparator.GetInstance);
+end;
+
+{ TDefaultComparator }
+constructor TDefaultComparator.Create;
+begin
+ // Empty
+end;
+
+function TDefaultComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Value1, Value2: Integer;
+begin
+ if Item1 <> nil then
+ Value1 := Integer(Pointer(Item1))
+ else
+ Value1 := Low(Integer);
+ if Item2 <> nil then
+ Value2 := Integer(Pointer(Item2))
+ else
+ Value2 := Low(Integer);
+ if (Value1 < Value2) then
+ Result := -1
+ else if (Value1 > Value2) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TDefaultComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := (Item1 = Item2);
+end;
+
+{ TNaturalComparator }
+constructor TNaturalComparator.Create;
+begin
+ // Empty
+end;
+
+function TNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ if (Item1 = nil) and (Item2 <> nil) then
+ Result := -1
+ else if (Item1 <> nil) and (Item2 = nil) then
+ Result := 1
+ else if (Item1 = nil) and (Item2 = nil) then
+ Result := 0
+ else
+ Result := (Item1 as IComparable).CompareTo(Item2);
+end;
+
+function TNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ if (Item1 = nil) or (Item2 = nil) then
+ Result := (Item1 = Item2)
+ else
+ begin
+ Result := (Item1 as IEquatable).Equals(Item2);
+ end;
+end;
+
+{ TReverseNaturalComparator }
+constructor TReverseNaturalComparator.Create;
+begin
+ // Empty
+end;
+
+function TReverseNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ if (Item1 = nil) and (Item2 <> nil) then
+ Result := 1
+ else if (Item1 <> nil) and (Item2 = nil) then
+ Result := -1
+ else if (Item1 = nil) and (Item2 = nil) then
+ Result := 0
+ else
+ Result := -(Item1 as IComparable).CompareTo(Item2);
+end;
+
+function TReverseNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ if (Item1 = nil) or (Item2 = nil) then
+ Result := (Item1 = Item2)
+ else
+ Result := (Item1 as IEquatable).Equals(Item2);
+end;
+
+{ TAssociation }
+constructor TAssociation.Create(const Key, Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TAssociation.Destroy;
+begin
+ FKey := nil;
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAssociation.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+function TAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TIntegerAssociation }
+constructor TIntegerAssociation.Create(const Key: Integer; const Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TIntegerAssociation.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TIntegerAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TIntegerAssociation.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+function TIntegerAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TStringAssociation }
+constructor TStringAssociation.Create(const Key: String; const Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TStringAssociation.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TStringAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TStringAssociation.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+function TStringAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TAbstractIterator }
+constructor TAbstractIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FItem := nil;
+end;
+
+procedure TAbstractIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractIterator.CurrentItem: ICollectable;
+begin
+ Result := FItem;
+end;
+
+function TAbstractIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractIterator.First: ICollectable;
+begin
+ FEOF := false;
+ FItem := TrueFirst;
+ if FItem = nil then
+ FEOF := true;
+ Result := FItem;
+end;
+
+function TAbstractIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FItem := TrueNext;
+ if FItem = nil then
+ FEOF := true;
+ end;
+ Result := FItem;
+end;
+
+function TAbstractIterator.Remove: Boolean;
+begin
+ if (FItem <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FItem := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractAssociationIterator }
+constructor TAbstractAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractAssociationIterator.CurrentKey: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := nil;
+end;
+
+function TAbstractAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractIntegerAssociationIterator }
+constructor TAbstractIntegerAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractIntegerAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractIntegerAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractIntegerAssociationIterator.CurrentKey: Integer;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := 0;
+end;
+
+function TAbstractIntegerAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractIntegerAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractIntegerAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractIntegerAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractIntegerAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractStringAssociationIterator }
+constructor TAbstractStringAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractStringAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractStringAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractStringAssociationIterator.CurrentKey: String;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := '';
+end;
+
+function TAbstractStringAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractStringAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractStringAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractStringAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractStringAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAssociationIterator }
+constructor TAssociationIterator.Create(const Iterator: IIterator);
+begin
+ inherited Create(Iterator.GetAllowRemoval);
+ FIterator := Iterator;
+end;
+
+destructor TAssociationIterator.Destroy;
+begin
+ FIterator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationIterator.TrueFirst: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.First as IAssociation;
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+function TAssociationIterator.TrueNext: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := (FIterator.Next as IAssociation);
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+procedure TAssociationIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TAssociationIterator.CurrentItem: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.CurrentItem as IAssociation;
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+function TAssociationIterator.CurrentKey: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.CurrentItem as IAssociation;
+ if Association <> nil then
+ Result := Association.GetKey
+ else
+ Result := nil;
+end;
+
+{ TAssociationComparator }
+constructor TAssociationComparator.Create(NaturalKeys: Boolean);
+begin
+ inherited Create;
+ if NaturalKeys then
+ FKeyComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FKeyComparator := TAbstractComparator.GetDefaultComparator;
+end;
+
+destructor TAssociationComparator.Destroy;
+begin
+ FKeyComparator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationComparator.GetKeyComparator: IComparator;
+begin
+ Result := FKeyComparator;
+end;
+
+procedure TAssociationComparator.SetKeyComparator(Value: IComparator);
+begin
+ FKeyComparator := Value;
+end;
+
+function TAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ Result := KeyComparator.Compare((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
+end;
+
+function TAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := KeyComparator.Equals((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
+end;
+
+{ TIntegerAssociationComparator }
+constructor TIntegerAssociationComparator.Create;
+begin
+ inherited Create;
+end;
+
+destructor TIntegerAssociationComparator.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TIntegerAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Key1, Key2: Integer;
+begin
+ Key1 := (Item1 as IIntegerAssociation).GetKey;
+ Key2 := (Item2 as IIntegerAssociation).GetKey;
+ if Key1 < Key2 then
+ Result := -1
+ else if Key1 > Key2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TIntegerAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := ((Item1 as IIntegerAssociation).GetKey = (Item2 as IIntegerAssociation).GetKey);
+end;
+
+{ TStringAssociationComparator }
+constructor TStringAssociationComparator.Create;
+begin
+ inherited Create;
+end;
+
+destructor TStringAssociationComparator.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TStringAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Key1, Key2: String;
+begin
+ Key1 := (Item1 as IStringAssociation).GetKey;
+ Key2 := (Item2 as IStringAssociation).GetKey;
+ if Key1 < Key2 then
+ Result := -1
+ else if Key1 > Key2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TStringAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := ((Item1 as IStringAssociation).GetKey = (Item2 as IStringAssociation).GetKey);
+end;
+
+{ TAssociationKeyIterator }
+constructor TAssociationKeyIterator.Create(const Iterator: IMapIterator);
+begin
+ inherited Create(Iterator.GetAllowRemoval);
+ FIterator := Iterator;
+end;
+
+destructor TAssociationKeyIterator.Destroy;
+begin
+ FIterator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationKeyIterator.TrueFirst: ICollectable;
+begin
+ FIterator.First;
+ Result := FIterator.CurrentKey;
+end;
+
+function TAssociationKeyIterator.TrueNext: ICollectable;
+begin
+ FIterator.Next;
+ Result := FIterator.CurrentKey;
+end;
+
+procedure TAssociationKeyIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TFilterIterator }
+constructor TFilterIterator.Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilter := Filter;
+end;
+
+destructor TFilterIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilter := nil;
+end;
+
+function TFilterIterator.TrueFirst: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ if FFilter.Accept(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TFilterIterator.TrueNext: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ if FFilter.Accept(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TFilterIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TFilterFuncIterator }
+constructor TFilterFuncIterator.Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilterFunc := FilterFunc;
+end;
+
+destructor TFilterFuncIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilterFunc := nil;
+end;
+
+function TFilterFuncIterator.TrueFirst: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ if FFilterFunc(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TFilterFuncIterator.TrueNext: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ if FFilterFunc(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TFilterFuncIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TKeyFilterMapIterator }
+constructor TKeyFilterMapIterator.Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilter := Filter;
+end;
+
+destructor TKeyFilterMapIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilter := nil;
+end;
+
+function TKeyFilterMapIterator.TrueFirst: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilter.Accept(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TKeyFilterMapIterator.TrueNext: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilter.Accept(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TKeyFilterMapIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TKeyFilterMapIterator.CurrentKey: ICollectable;
+begin
+ Result := FIterator.CurrentKey;
+end;
+
+{ TKeyFilterFuncMapIterator }
+constructor TKeyFilterFuncMapIterator.Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilterFunc := FilterFunc;
+end;
+
+destructor TKeyFilterFuncMapIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilterFunc := nil;
+end;
+
+function TKeyFilterFuncMapIterator.TrueFirst: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilterFunc(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TKeyFilterFuncMapIterator.TrueNext: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilterFunc(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TKeyFilterFuncMapIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TKeyFilterFuncMapIterator.CurrentKey: ICollectable;
+begin
+ Result := FIterator.CurrentKey;
+end;
+
+
+{ TAbstractCollection }
+constructor TAbstractCollection.Create;
+begin
+ Create(false);
+end;
+
+constructor TAbstractCollection.Create(NaturalItemsOnly: Boolean);
+begin
+ FCreated := false;
+ inherited Create;
+ FNaturalItemsOnly := NaturalItemsOnly or GetAlwaysNaturalItems;
+ if FNaturalItemsOnly then
+ FComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FComparator := TAbstractComparator.GetDefaultComparator;
+ FIgnoreErrors := [ceDuplicate];
+end;
+
+constructor TAbstractCollection.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, false);
+end;
+
+// Fixed size collections must override this.
+constructor TAbstractCollection.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I: Integer;
+begin
+ Create(NaturalItemsOnly);
+ if not FixedSize then
+ begin
+ Capacity := Length(ItemArray);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Add(ItemArray[I]);
+ end;
+ end;
+end;
+
+// Fixed size collections must override this.
+constructor TAbstractCollection.Create(const Collection: ICollection);
+var
+ Iterator: IIterator;
+begin
+ Create(Collection.GetNaturalItemsOnly);
+ InitFrom(Collection);
+ if not FixedSize then
+ begin
+ Capacity := Collection.GetSize;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractCollection.Destroy;
+begin
+ FCreated := false;
+ FComparator := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractCollection.CollectionError(ErrorType: TCollectionError);
+var
+ Msg: String;
+begin
+ if not (ErrorType in FIgnoreErrors) then
+ begin
+ case ErrorType of
+ ceDuplicate: Msg := 'Collection does not allow duplicates.';
+ ceDuplicateKey: Msg := 'Collection does not allow duplicate keys.';
+ ceFixedSize: Msg := 'Collection has fixed size.';
+ ceNilNotAllowed: Msg := 'Collection does not allow nil.';
+ ceNotNaturalItem: Msg := 'Collection only accepts natural items.';
+ ceOutOfRange: Msg := 'Index out of collection range.';
+ end;
+ // If exception is thrown during construction, collection cannot be
+ // passed to it as destructor is automatically called and this leaves an
+ // interface reference to a destroyed object and crashes.
+ if FCreated then
+ raise ECollectionError.Create(Msg, Self, ErrorType)
+ else
+ raise ECollectionError.Create(Msg, nil, ErrorType);
+ end;
+end;
+
+procedure TAbstractCollection.InitFrom(const Collection: ICollection);
+begin
+ Comparator := Collection.GetComparator;
+ IgnoreErrors := Collection.GetIgnoreErrors;
+end;
+
+// Implementations should override this if possible
+function TAbstractCollection.TrueItemCount(const Item: ICollectable): Integer;
+var
+ Iterator: IIterator;
+ Total: Integer;
+begin
+ Total := 0;
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ if FComparator.Equals(Item, Iterator.CurrentItem) then
+ Inc(Total);
+ Iterator.Next;
+ end;
+ Result := Total;
+end;
+
+class function TAbstractCollection.GetAlwaysNaturalItems: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractCollection.GetAsArray: TCollectableArray;
+var
+ Iterator: IIterator;
+ Working: TCollectableArray;
+ I: Integer;
+begin
+ SetLength(Working, Size);
+ I := 0;
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Working[I] := Iterator.CurrentItem;
+ Inc(I);
+ Iterator.Next;
+ end;
+ Result := Working;
+end;
+
+function TAbstractCollection.GetComparator: IComparator;
+begin
+ Result := FComparator;
+end;
+
+function TAbstractCollection.GetDuplicates: Boolean;
+begin
+ Result := true; // Sets and lists override this.
+end;
+
+procedure TAbstractCollection.SetComparator(const Value: IComparator);
+begin
+ if Value = nil then
+ begin
+ if NaturalItemsOnly then
+ FComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FComparator := TAbstractComparator.GetDefaultComparator;
+ end
+ else
+ FComparator := Value;
+end;
+
+function TAbstractCollection.GetFixedSize: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractCollection.GetIgnoreErrors: TCollectionErrors;
+begin
+ Result := FIgnoreErrors;
+end;
+
+procedure TAbstractCollection.SetIgnoreErrors(Value: TCollectionErrors);
+begin
+ FIgnoreErrors := Value;
+end;
+
+function TAbstractCollection.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAbstractCollection.GetIterator(const Filter: IFilter): IIterator;
+var
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Result := TFilterIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractCollection.GetIterator(FilterFunc: TCollectionFilterFunc): IIterator;
+var
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Result := TFilterFuncIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractCollection.GetNaturalItemsOnly: Boolean;
+begin
+ Result := FNaturalItemsOnly;
+end;
+
+function TAbstractCollection.Add(const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+ Success: Boolean;
+begin
+ ItemError := ItemAllowed(Item); // Can be natural items only error or nil not allowed error
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Add(const ItemArray: array of ICollectable): Integer;
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ if Success then
+ Inc(Count);
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractCollection.Add(const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ if Success then
+ Inc(Count);
+ Iterator.Next;
+ end;
+ Result := Count;
+end;
+
+procedure TAbstractCollection.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FCreated := true;
+end;
+
+procedure TAbstractCollection.BeforeDestruction;
+begin
+ if not FixedSize then
+ TrueClear;
+ inherited BeforeDestruction;
+end;
+
+function TAbstractCollection.Clear: Integer;
+begin
+ if not FixedSize then
+ begin
+ Result := Size;
+ TrueClear;
+ end
+ else
+ begin
+ CollectionError(ceFixedSize);
+ Result := 0;
+ end;
+end;
+
+function TAbstractCollection.Clone: ICollection;
+begin
+ Result := (TAbstractCollectionClass(ClassType)).Create(Self);
+end;
+
+function TAbstractCollection.Contains(const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+ Success: Boolean;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueContains(Item);
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Contains(const ItemArray: array of ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Success := Success and Contains(ItemArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Contains(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ Success := true;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Success := Success and Contains(Iterator.CurrentItem);
+ if not Success then
+ break;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Equals(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ if Collection.GetType <> GetType then
+ Result := false
+ else if Collection.Size <> Size then
+ Result := false
+ else if not Collection.Comparator.Equals(Comparator) then
+ Result := false
+ else if not Collection.GetDuplicates and not GetDuplicates then
+ begin
+ // Not equal if any item not found in parameter collection
+ Success := true;
+ Iterator := GetIterator;
+ while not Iterator.EOF and Success do
+ begin
+ Success := Collection.Contains(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := Success;
+ end
+ else
+ begin
+ // Not equal if any item count not equal to item count in parameter collection
+ Success := true;
+ Iterator := GetIterator;
+ while not Iterator.EOF and Success do
+ begin
+ Success := (ItemCount(Iterator.CurrentItem) = Collection.ItemCount(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := Success;
+ end;
+end;
+
+function TAbstractCollection.Find(const Filter: IFilter): ICollectable;
+begin
+ Result := GetIterator(Filter).First;
+end;
+
+function TAbstractCollection.Find(FilterFunc: TCollectionFilterFunc): ICollectable;
+begin
+ Result := GetIterator(FilterFunc).First;
+end;
+
+function TAbstractCollection.FindAll(const Filter: IFilter): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Self.GetIterator(Filter);
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.FindAll(FilterFunc: TCollectionFilterFunc): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Self.GetIterator(FilterFunc);
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.IsEmpty: Boolean;
+begin
+ Result := (Size = 0);
+end;
+
+function TAbstractCollection.IsNaturalItem(const Item: ICollectable): Boolean;
+var
+ Temp: IUnknown;
+begin
+ if Item <> nil then
+ Result := (Item.QueryInterface(NaturalItemIID, Temp) <> E_NOINTERFACE)
+ else
+ Result := false;
+end;
+
+function TAbstractCollection.ItemAllowed(const Item: ICollectable): TCollectionError;
+begin
+ if NaturalItemsOnly and not IsNaturalItem(Item) then
+ Result := ceNotNaturalItem
+ else if not IsNilAllowed and (Item = nil) then
+ Result := ceNilNotAllowed
+ else
+ Result := ceOK;
+end;
+
+function TAbstractCollection.ItemCount(const Item: ICollectable): Integer;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := 0;
+ end
+ else if GetDuplicates then
+ begin
+ Result := TrueItemCount(Item);
+ end
+ else
+ begin
+ // Where duplicates are not allowed, TrueContains will be faster than TrueItemCount.
+ if TrueContains(Item) then
+ Result := 1
+ else
+ Result := 0;
+ end;
+end;
+
+function TAbstractCollection.ItemCount(const ItemArray: array of ICollectable): Integer;
+var
+ I: Integer;
+ Total: Integer;
+begin
+ Total := 0;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Total := Total + ItemCount(ItemArray[I]);
+ end;
+ Result := Total;
+end;
+
+function TAbstractCollection.ItemCount(const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Total: Integer;
+begin
+ Total := 0;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Total := Total + ItemCount(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := Total;
+end;
+
+function TAbstractCollection.Matching(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ if Contains(ItemArray[I]) then
+ ResultCollection.Add(ItemArray[I]);
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Matching(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ if Contains(Iterator.CurrentItem) then
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Remove(const Item: ICollectable): ICollectable;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueRemove(Item);
+ end;
+end;
+
+function TAbstractCollection.Remove(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ ResultCollection.Add(Remove(ItemArray[I]));
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Remove(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Remove(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.RemoveAll(const Item: ICollectable): ICollection;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueRemoveAll(Item);
+ end;
+end;
+
+function TAbstractCollection.RemoveAll(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ ResultCollection.Add(RemoveAll(ItemArray[I]));
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.RemoveAll(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(RemoveAll(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Retain(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+ Item: ICollectable;
+ I: Integer;
+ Found, Success: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := Iterator.CurrentItem;
+ Found := Comparator.Equals(Item, ItemArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ Success := Iterator.Remove;
+ if Success then
+ ResultCollection.Add(Item);
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Retain(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+ Item: ICollectable;
+ Success: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Collection.Contains(Item) then
+ begin
+ Success := Iterator.Remove;
+ if Success then
+ ResultCollection.Add(Item);
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+{ TAbstractBag }
+function TAbstractBag.CloneAsBag: IBag;
+begin
+ Result := (TAbstractBagClass(ClassType)).Create(Self);
+end;
+
+function TAbstractBag.GetNaturalItemIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractBag.GetType: TCollectionType;
+begin
+ Result := ctBag;
+end;
+
+function TAbstractBag.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+{ TAbstractSet }
+function TAbstractSet.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ // Adds if not already present otherwise fails
+ Position := GetPosition(Item);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end
+ else
+ begin
+ TrueAdd2(Position, Item);
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueContains(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetPosition(Item);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetPosition(Item);
+ try
+ if Position.Found then
+ begin
+ Result := TrueGet(Position);
+ TrueRemove2(Position);
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ RemovedItem: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create;
+ RemovedItem := TrueRemove(Item);
+ if RemovedItem <> nil then
+ ResultCollection.Add(RemovedItem);
+ Result := ResultCollection;
+end;
+
+function TAbstractSet.GetDuplicates: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractSet.GetNaturalItemIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractSet.GetType: TCollectionType;
+begin
+ Result := ctSet;
+end;
+
+function TAbstractSet.CloneAsSet: ISet;
+begin
+ Result := (TAbstractSetClass(ClassType)).Create(Self);
+end;
+
+function TAbstractSet.Complement(const Universe: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items in universe not found in self.
+ ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
+ Iterator := Universe.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Contains(Item) then
+ ResultSet.Add(Item);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+function TAbstractSet.Intersect(const Set2: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items found in self and parameter.
+ ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if Contains(Item) and Set2.Contains(Item) then
+ ResultSet.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+function TAbstractSet.IsNilAllowed: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractSet.Union(const Set2: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items found in self or parameter.
+ ResultSet := CloneAsSet;
+ Iterator := Set2.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Contains(Item) and Set2.Contains(Item) then
+ ResultSet.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+{ TAbstractList }
+constructor TAbstractList.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FDuplicates := true;
+ FSorted := false;
+end;
+
+procedure TAbstractList.InitFrom(const Collection: ICollection);
+var
+ List: IList;
+begin
+ inherited InitFrom(Collection);
+ if Collection.QueryInterface(IList, List) = S_OK then
+ begin
+ FDuplicates := List.GetDuplicates;
+ FSorted := List.GetSorted;
+ end;
+end;
+
+function TAbstractList.TrueAdd(const Item: ICollectable): Boolean;
+var
+ SearchResult: TSearchResult;
+begin
+ Result := True;
+ if Sorted then
+ begin
+ // Insert in appropriate place to maintain sort order, unless duplicate
+ // not allowed.
+ SearchResult := BinarySearch(Item);
+ case SearchResult.ResultType of
+ srBeforeIndex: TrueInsert(SearchResult.Index, Item);
+ srFoundAtIndex: begin
+ if Duplicates then
+ TrueInsert(SearchResult.Index, Item)
+ else
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end;
+ end;
+ srAfterEnd: TrueAppend(Item);
+ end;
+ end
+ else
+ begin
+ // Add to end, unless duplicate not allowed.
+ if not Duplicates and (SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex) then
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end
+ else
+ TrueAppend(Item);
+ end;
+end;
+
+function TAbstractList.TrueContains(const Item: ICollectable): Boolean;
+begin
+ if Sorted then
+ Result := BinarySearch(Item).ResultType = srFoundAtIndex
+ else
+ Result := SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex
+end;
+
+function TAbstractList.TrueItemCount(const Item: ICollectable): Integer;
+var
+ SearchResult: TSearchResult;
+ Count: Integer;
+begin
+ if Sorted then
+ begin
+ // If sorted, use binary search.
+ Count := 0;
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ repeat
+ Inc(Count);
+ until not Comparator.Equals(Item, Items[SearchResult.Index]);
+ end;
+ Result := Count;
+ end
+ else
+ // Resort to sequential search for unsorted
+ Result := inherited TrueItemCount(Item);
+end;
+
+function TAbstractList.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ SearchResult: TSearchResult;
+begin
+ Result := nil;
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ Result := TrueDelete(SearchResult.Index);
+ end;
+ end
+ else
+ begin
+ SearchResult := SequentialSearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ Result := TrueDelete(SearchResult.Index);
+ end;
+end;
+
+function TAbstractList.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ SearchResult: TSearchResult;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create;
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ repeat
+ ResultCollection.Add(TrueDelete(SearchResult.Index));
+ until not Comparator.Equals(Item, Items[SearchResult.Index]);
+ end;
+ end
+ else
+ begin
+ I := 0;
+ while I < Size do
+ begin
+ if Comparator.Equals(Item, Items[I]) then
+ begin
+ ResultCollection.Add(TrueDelete(I));
+ end
+ else
+ Inc(I);
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+procedure TAbstractList.QuickSort(Lo, Hi: Integer; const Comparator: IComparator);
+var
+ I, J, Mid: Integer;
+begin
+ repeat
+ I := Lo;
+ J := Hi;
+ Mid := (Lo + Hi) div 2;
+ repeat
+ while Comparator.Compare(Items[I], Items[Mid]) < 0 do
+ Inc(I);
+ while Comparator.Compare(Items[J], Items[Mid]) > 0 do
+ Dec(J);
+ if I <= J then
+ begin
+ Exchange(I, J);
+ if Mid = I then
+ Mid := J
+ else if Mid = J then
+ Mid := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if Lo < J then
+ QuickSort(Lo, J, Comparator);
+ Lo := I;
+ until I >= Hi;
+end;
+
+procedure TAbstractList.QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc);
+var
+ I, J, Mid: Integer;
+begin
+ repeat
+ I := Lo;
+ J := Hi;
+ Mid := (Lo + Hi) div 2;
+ repeat
+ while CompareFunc(Items[I], Items[Mid]) < 0 do
+ Inc(I);
+ while CompareFunc(Items[J], Items[Mid]) > 0 do
+ Dec(J);
+ if I <= J then
+ begin
+ Exchange(I, J);
+ if Mid = I then
+ Mid := J
+ else if Mid = J then
+ Mid := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if Lo < J then
+ QuickSort(Lo, J, CompareFunc);
+ Lo := I;
+ until I >= Hi;
+end;
+
+function TAbstractList.GetDuplicates: Boolean;
+begin
+ Result := FDuplicates;
+end;
+
+procedure TAbstractList.SetDuplicates(Value: Boolean);
+var
+ Iterator: IIterator;
+ Failed: Boolean;
+begin
+ Failed := false;
+ // If trying to set no duplicates, check there are no existing duplicates.
+ if not Value then
+ begin
+ Iterator := GetIterator;
+ while not Iterator.EOF and not Failed do
+ begin
+ Failed := (ItemCount(Iterator.CurrentItem) > 1);
+ Iterator.Next;
+ end;
+ if Failed then
+ CollectionError(ceDuplicate);
+ end;
+ if not Failed then
+ FDuplicates := Value;
+end;
+
+function TAbstractList.GetItem(Index: Integer): ICollectable;
+begin
+ if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := nil;
+ end
+ else
+ Result := TrueGetItem(Index);
+end;
+
+procedure TAbstractList.SetItem(Index: Integer; const Item: ICollectable);
+var
+ SearchResult: TSearchResult;
+begin
+ if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange)
+ end
+ else if not Duplicates then
+ begin
+ // Find any duplicates
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ case SearchResult.ResultType of
+ srBeforeIndex, srAfterEnd: begin // If item is not present
+ FSorted := false;
+ TrueSetItem(Index, Item);
+ end;
+ srFoundAtIndex: begin // If item is already present
+ CollectionError(ceDuplicate);
+ end;
+ end;
+ end
+ else
+ begin
+ // If item is already present
+ if SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex then
+ begin
+ CollectionError(ceDuplicate);
+ end
+ else
+ begin
+ TrueSetItem(Index, Item);
+ end;
+ end;
+ end
+ else
+ begin
+ FSorted := false;
+ TrueSetItem(Index, Item);
+ end;
+end;
+
+function TAbstractList.GetIterator: IIterator;
+begin
+ Result := TAbstractListIterator.Create(Self);
+end;
+
+function TAbstractList.GetNaturalItemIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TAbstractList.GetSorted: Boolean;
+begin
+ Result := FSorted;
+end;
+
+procedure TAbstractList.SetSorted(Value: Boolean);
+begin
+ if Value then
+ Sort;
+end;
+
+function TAbstractList.GetType: TCollectionType;
+begin
+ Result := ctList;
+end;
+
+function TAbstractList.BinarySearch(const Item: ICollectable): TSearchResult;
+var
+ Lo, Hi, Mid: Integer;
+ CompareResult: Integer;
+ Success: Boolean;
+begin
+ if Size = 0 then
+ begin
+ Result.ResultType := srAfterEnd;
+ Exit;
+ end;
+ Lo := 0;
+ Hi := Size - 1;
+ Success := false;
+ repeat
+ Mid := (Lo + Hi) div 2;
+ CompareResult := Comparator.Compare(Item, Items[Mid]);
+ if CompareResult = 0 then
+ Success := true
+ else if CompareResult > 0 then
+ Lo := Mid + 1
+ else
+ Hi := Mid - 1;
+ until (Lo > Hi) or Success;
+ if Success then
+ begin
+ // Move index back if in cluster of duplicates
+ while (Mid > 0) and Comparator.Equals(Item, Items[Mid - 1]) do
+ Dec(Mid);
+ Result.ResultType := srFoundAtIndex;
+ Result.Index := Mid;
+ end
+ else if CompareResult < 0 then
+ begin
+ Result.ResultType := srBeforeIndex;
+ Result.Index := Mid;
+ end
+ else if Hi < Size - 1 then
+ begin
+ Result.ResultType := srBeforeIndex;
+ Result.Index := Mid + 1;
+ end
+ else
+ Result.ResultType := srAfterEnd;
+end;
+
+function TAbstractList.CloneAsList: IList;
+begin
+ Result := (TAbstractListClass(ClassType)).Create(Self);
+end;
+
+function TAbstractList.Delete(Index: Integer): ICollectable;
+begin
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueDelete(Index);
+ end;
+end;
+
+procedure TAbstractList.Exchange(Index1, Index2: Integer);
+var
+ Item: ICollectable;
+begin
+ if (Index1 < 0) or (Index1 >= Size) then
+ CollectionError(ceOutOfRange);
+ if (Index2 < 0) or (Index2 >= Size) then
+ CollectionError(ceOutOfRange);
+ FSorted := false;
+ Item := ICollectable(Items[Index1]);
+ Items[Index1] := Items[Index2];
+ Items[Index2] := Item;
+end;
+
+function TAbstractList.First: ICollectable;
+begin
+ if Size > 0 then
+ Result := Items[0]
+ else
+ Result := nil;
+end;
+
+function TAbstractList.IndexOf(const Item: ICollectable): Integer;
+var
+ SearchResult: TSearchResult;
+begin
+ if Sorted then
+ SearchResult := BinarySearch(Item)
+ else
+ SearchResult := SequentialSearch(Item, Comparator);
+ if SearchResult.ResultType = srFoundAtIndex then
+ Result := SearchResult.Index
+ else
+ Result := -1;
+end;
+
+function TAbstractList.Insert(Index: Integer; const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := false;
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := false;
+ end
+ else
+ begin
+ FSorted := false;
+ if Index = Size then
+ TrueAdd(Item)
+ else
+ TrueInsert(Index, Item);
+ Result := true;
+ end;
+end;
+
+function TAbstractList.Insert(Index: Integer; const ItemArray: array of ICollectable): Integer;
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I, NewIndex, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ end
+ else
+ begin
+ // Insert entire array in place in correct order
+ NewIndex := Index;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Success := Insert(NewIndex, Item);
+ if Success then
+ begin
+ Inc(NewIndex);
+ Inc(Count);
+ end;
+ end;
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractList.Insert(Index: Integer; const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ NewIndex, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ end
+ else
+ begin
+ // Insert entire collection in place in correct order
+ NewIndex := Index;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Success := Insert(NewIndex, Item);
+ if Success then
+ begin
+ Inc(NewIndex);
+ Inc(Count);
+ end;
+ end;
+ Iterator.Next;
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractList.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractList.Last: ICollectable;
+begin
+ if Size > 0 then
+ Result := Items[Size - 1]
+ else
+ Result := nil;
+end;
+
+function TAbstractList.Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult;
+begin
+ if Sorted and (SearchComparator = nil) then
+ Result := BinarySearch(Item)
+ else
+ Result := SequentialSearch(Item, SearchComparator);
+end;
+
+function TAbstractList.SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator): TSearchResult;
+var
+ WorkingComparator: IComparator;
+ I: Integer;
+ Success: Boolean;
+begin
+ if SearchComparator = nil then
+ WorkingComparator := Comparator
+ else
+ WorkingComparator := SearchComparator;
+ Result.ResultType := srNotFound;
+ I := 0;
+ Success := false;
+ while (I < Size) and not Success do
+ begin
+ if WorkingComparator.Equals(Item, Items[I]) then
+ begin
+ Result.ResultType := srFoundAtIndex;
+ Result.Index := I;
+ Success := true;
+ end
+ else
+ Inc(I);
+ end;
+end;
+
+procedure TAbstractList.Sort(const SortComparator: IComparator);
+begin
+ if SortComparator = nil then
+ begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, Comparator);
+ FSorted := true;
+ end
+ else
+ begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, SortComparator);
+ FSorted := false;
+ end;
+end;
+
+procedure TAbstractList.Sort(CompareFunc: TCollectionCompareFunc);
+begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, CompareFunc);
+ FSorted := false;
+end;
+
+{ TAbstractMap }
+constructor TAbstractMap.Create;
+begin
+ Create(false, true);
+end;
+
+constructor TAbstractMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, true);
+end;
+
+constructor TAbstractMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FNaturalKeysOnly := NaturalKeysOnly or GetAlwaysNaturalKeys;
+ FAssociationComparator := TAssociationComparator.Create(FNaturalKeysOnly);
+ if FNaturalKeysOnly then
+ FKeyComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FKeyComparator := TAbstractComparator.GetDefaultComparator;
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true, true);
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ Create(ItemArray, true, true);
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I: Integer;
+begin
+ Create(true, NaturalKeysOnly);
+ if not FixedSize then
+ begin
+ Capacity := Length(ItemArray);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Add(ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false, true);
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ Create(KeyArray, ItemArray, NaturalItemsOnly, true);
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly, NaturalKeysOnly);
+ if not FixedSize then
+ begin
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractMap.Create(const Map: IMap);
+var
+ MapIterator: IMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly, Map.GetNaturalKeysOnly);
+ InitFrom(Map);
+ if not FixedSize then
+ begin
+ Capacity := Map.GetSize;
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractMap.Destroy;
+begin
+ FKeyComparator := nil;
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractMap.InitFrom(const Collection: ICollection);
+var
+ Map: IMap;
+begin
+ inherited InitFrom(Collection);
+ if Collection.QueryInterface(IMap, Map) = S_OK then
+ begin
+ FNaturalKeysOnly := Map.GetNaturalKeysOnly or GetAlwaysNaturalKeys;
+ KeyComparator := Map.GetKeyComparator;
+ end;
+end;
+
+function TAbstractMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IMapIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+class function TAbstractMap.GetAlwaysNaturalKeys: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractMap.GetItem(const Key: ICollectable): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractMap.SetItem(const Key, Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractMap.GetKeyComparator: IComparator;
+begin
+ Result := FKeyComparator;
+end;
+
+procedure TAbstractMap.SetKeyComparator(const Value: IComparator);
+begin
+ FKeyComparator := Value;
+ FAssociationComparator.KeyComparator := Value;
+end;
+
+function TAbstractMap.GetKeyIterator: IIterator;
+begin
+ Result := TAssociationKeyIterator.Create(GetAssociationIterator);
+end;
+
+function TAbstractMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ KeyIterator: IIterator;
+begin
+ ResultCollection := TPArraySet.Create(NaturalKeysOnly);
+ ResultCollection.SetComparator(GetKeyComparator);
+ KeyIterator := GetKeyIterator;
+ while not KeyIterator.EOF do
+ begin
+ ResultCollection.Add(KeyIterator.CurrentItem);
+ KeyIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.GetMapIterator: IMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractMap.GetMapIteratorByKey(const Filter: IFilter): IMapIterator;
+var
+ Iterator: IMapIterator;
+begin
+ Iterator := GetMapIterator;
+ Result := TKeyFilterMapIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractMap.GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator;
+var
+ Iterator: IMapIterator;
+begin
+ Iterator := GetMapIterator;
+ Result := TKeyFilterFuncMapIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractMap.GetNaturalItemIID: TGUID;
+begin
+ Result := MappableIID;
+end;
+
+function TAbstractMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractMap.GetNaturalKeysOnly: Boolean;
+begin
+ Result := FNaturalKeysOnly;
+end;
+
+function TAbstractMap.GetType: TCollectionType;
+begin
+ Result := ctMap;
+end;
+
+function TAbstractMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractMap.Clone: ICollection;
+begin
+ Result := (TAbstractMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractMap.CloneAsMap: IMap;
+begin
+ Result := (TAbstractMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractMap.ContainsKey(const Key: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractMap.ContainsKey(const KeyArray: array of ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.ContainsKey(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ Success := true;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Success := Success and ContainsKey(Iterator.CurrentItem);
+ if not Success then
+ break;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.Get(const Key: ICollectable): ICollectable;
+var
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.KeyAllowed(const Key: ICollectable): TCollectionError;
+begin
+ if NaturalKeysOnly and not IsNaturalKey(Key) then
+ Result := ceNotNaturalItem
+ else if Key = nil then
+ Result := ceNilNotAllowed
+ else
+ Result := ceOK;
+end;
+
+function TAbstractMap.IsNaturalKey(const Key: ICollectable): Boolean;
+var
+ Temp: IUnknown;
+begin
+ if Key.QueryInterface(NaturalKeyIID, Temp) <> E_NOINTERFACE then
+ Result := true
+ else
+ Result := false;
+end;
+
+function TAbstractMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractMap.MatchingKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ if ContainsKey(KeyArray[I]) then
+ ResultCollection.Add(KeyArray[I]);
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.MatchingKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ if ContainsKey(Iterator.CurrentItem) then
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.Put(const Key, Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IAssociation;
+ ItemError, KeyError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ KeyError := KeyAllowed(Key);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Map: IMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IAssociation;
+ ItemError, KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IMapIterator;
+ Key, Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ KeyError := KeyAllowed(Key);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RemoveKey(const Key: ICollectable): ICollectable;
+var
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ OldAssociation: IAssociation;
+begin
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.RemoveKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IAssociation;
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ Key: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RemoveKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IAssociation;
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ Key: ICollectable;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Key := Iterator.CurrentItem;
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RetainKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := KeyComparator.Equals(MapIterator.CurrentKey, KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+function TAbstractMap.RetainKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IMapIterator;
+ Key: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ if not Collection.Contains(Key) then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+
+{ TAbstractIntegerMap }
+constructor TAbstractIntegerMap.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FAssociationComparator := TIntegerAssociationComparator.Create;
+end;
+
+constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true);
+end;
+
+constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ inherited Create(ItemArray, true);
+end;
+
+constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false);
+end;
+
+constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly);
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ if not FixedSize then
+ begin
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractIntegerMap.Create(const Map: IIntegerMap);
+var
+ MapIterator: IIntegerMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly);
+ InitFrom(Map);
+ Capacity := Map.GetSize;
+ if not FixedSize then
+ begin
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractIntegerMap.Destroy;
+begin
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+function TAbstractIntegerMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IIntegerMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IIntegerMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TIntegerAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractIntegerMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractIntegerMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IIntegerMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractIntegerMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IIntegerMapIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.GetItem(const Key: Integer): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractIntegerMap.SetItem(const Key: Integer; const Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractIntegerMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractIntegerMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ MapIterator: IIntegerMapIterator;
+begin
+ ResultCollection := TPArraySet.Create(true);
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ ResultCollection.Add(TIntegerWrapper.Create(MapIterator.CurrentKey) as ICollectable);
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.GetMapIterator: IIntegerMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractIntegerMap.GetNaturalItemIID: TGUID;
+begin
+ Result := IntegerMappableIID;
+end;
+
+function TAbstractIntegerMap.GetType: TCollectionType;
+begin
+ Result := ctIntegerMap;
+end;
+
+function TAbstractIntegerMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractIntegerMap.Clone: ICollection;
+begin
+ Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractIntegerMap.CloneAsIntegerMap: IIntegerMap;
+begin
+ Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractIntegerMap.ContainsKey(const Key: Integer): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.ContainsKey(const KeyArray: array of Integer): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractIntegerMap.Get(const Key: Integer): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractIntegerMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractIntegerMap.Put(const Key: Integer; const Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TIntegerAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractIntegerMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.Put(const Map: IIntegerMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IIntegerMapIterator;
+ Item: ICollectable;
+ Key: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TIntegerAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.RemoveKey(const Key: Integer): ICollectable;
+var
+ Position: TCollectionPosition;
+ OldAssociation: IIntegerAssociation;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.RemoveKey(const KeyArray: array of Integer): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Key: Integer;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.RetainKey(const KeyArray: array of Integer): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IIntegerMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := (MapIterator.CurrentKey = KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+
+{ TAbstractStringMap }
+constructor TAbstractStringMap.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FAssociationComparator := TStringAssociationComparator.Create;
+end;
+
+constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true);
+end;
+
+constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ inherited Create(ItemArray, true);
+end;
+
+constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false);
+end;
+
+constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly);
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ if not FixedSize then
+ begin
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractStringMap.Create(const Map: IStringMap);
+var
+ MapIterator: IStringMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly);
+ InitFrom(Map);
+ Capacity := Map.GetSize;
+ if not FixedSize then
+ begin
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractStringMap.Destroy;
+begin
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+function TAbstractStringMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IStringMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IStringMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TStringAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractStringMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractStringMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IStringMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractStringMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.GetItem(const Key: String): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractStringMap.SetItem(const Key: String; const Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractStringMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractStringMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ MapIterator: IStringMapIterator;
+begin
+ ResultCollection := TPArraySet.Create(true);
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ ResultCollection.Add(TStringWrapper.Create(MapIterator.CurrentKey) as ICollectable);
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.GetMapIterator: IStringMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractStringMap.GetNaturalItemIID: TGUID;
+begin
+ Result := StringMappableIID;
+end;
+
+function TAbstractStringMap.GetType: TCollectionType;
+begin
+ Result := ctStringMap;
+end;
+
+function TAbstractStringMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractStringMap.Clone: ICollection;
+begin
+ Result := (TAbstractStringMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractStringMap.CloneAsStringMap: IStringMap;
+begin
+ Result := (TAbstractStringMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractStringMap.ContainsKey(const Key: String): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.ContainsKey(const KeyArray: array of String): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractStringMap.Get(const Key: String): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractStringMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractStringMap.Put(const Key: String; const Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IStringAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TStringAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractStringMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.Put(const Map: IStringMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IStringAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IStringMapIterator;
+ Item: ICollectable;
+ Key: String;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TStringAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.RemoveKey(const Key: String): ICollectable;
+var
+ Position: TCollectionPosition;
+ OldAssociation: IStringAssociation;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.RemoveKey(const KeyArray: array of String): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Key: String;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.RetainKey(const KeyArray: array of String): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IStringMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := (MapIterator.CurrentKey = KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+
+{ ECollectionError }
+constructor ECollectionError.Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
+begin
+ inherited Create(Msg);
+ FCollection := Collection;
+ FErrorType := ErrorType;
+end;
+
+{ TAbstractListIterator }
+constructor TAbstractListIterator.Create(Collection: TAbstractList);
+begin
+ inherited Create(true);
+ FCollection := Collection;
+ First;
+end;
+
+function TAbstractListIterator.TrueFirst: ICollectable;
+begin
+ FIndex := 0;
+ if FIndex < FCollection.GetSize then
+ Result := FCollection.GetItem(FIndex)
+ else
+ Result := nil;
+end;
+
+function TAbstractListIterator.TrueNext: ICollectable;
+begin
+ Inc(FIndex);
+ if FIndex < FCollection.GetSize then
+ Result := FCollection.GetItem(FIndex)
+ else
+ Result := nil;
+end;
+
+procedure TAbstractListIterator.TrueRemove;
+begin
+ FCollection.Delete(FIndex);
+ Dec(FIndex);
+end;
+
+end.
diff --git a/Medley/src/lib/collections/readme.txt b/Medley/src/lib/collections/readme.txt
new file mode 100644
index 00000000..1f6477de
--- /dev/null
+++ b/Medley/src/lib/collections/readme.txt
@@ -0,0 +1,14 @@
+Delphi Collections by Matthew Greet
+http://www.warmachine.u-net.com/delphi_collections/
+
+Help files (MS .hlp format) at
+http://www.warmachine.u-net.com/downloads/delphi_collections_1_0_help.zip
+
+Changes
+=====================
+2008-11-06 FPC compatibility fixes by UltraStar Deluxe Team
+2005-03-14 Maintenance release v1.0.5 - bug fix for sorted lists and functional tests checks unsorted and sorted lists.
+2004-10-14 Maintenance release v1.0.4 - memory leak fixed.
+2004-06-12 Maintenance release v1.0.3 - memory leak fixed, memory leak test, new Capacity property.
+2004-02-13 Maintenance release v1.0.2 - expanded introduction and quick start sections in help file.
+2003-10-25 Maintenance release v1.0.1 - packages and test harness no longer list unused packages. \ No newline at end of file
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-27 07:12:07 +0000