diff options
author | Alexander Sulfrian <alexander@sulfrian.net> | 2011-11-07 15:26:44 +0100 |
---|---|---|
committer | Alexander Sulfrian <alexander@sulfrian.net> | 2013-01-05 17:17:49 +0100 |
commit | 3260749d369d3466c345d40a8b2189c32c8c1b60 (patch) | |
tree | bdf235d333e6b4d0b0edb11bde421617a180ff92 /src/lib/collections | |
parent | de5a3593ae7bc6fb5aab9d76d01d3faa47b91bba (diff) | |
download | usdx-3260749d369d3466c345d40a8b2189c32c8c1b60.tar.gz usdx-3260749d369d3466c345d40a8b2189c32c8c1b60.tar.xz usdx-3260749d369d3466c345d40a8b2189c32c8c1b60.zip |
removed pascal code
Diffstat (limited to '')
-rw-r--r-- | src/lib/collections/CollArray.pas | 183 | ||||
-rw-r--r-- | src/lib/collections/CollHash.pas | 1497 | ||||
-rw-r--r-- | src/lib/collections/CollLibrary.pas | 131 | ||||
-rw-r--r-- | src/lib/collections/CollList.pas | 270 | ||||
-rw-r--r-- | src/lib/collections/CollPArray.pas | 689 | ||||
-rw-r--r-- | src/lib/collections/CollWrappers.pas | 876 | ||||
-rw-r--r-- | src/lib/collections/Collections.pas | 5318 |
7 files changed, 0 insertions, 8964 deletions
diff --git a/src/lib/collections/CollArray.pas b/src/lib/collections/CollArray.pas deleted file mode 100644 index a10ba905..00000000 --- a/src/lib/collections/CollArray.pas +++ /dev/null @@ -1,183 +0,0 @@ -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/src/lib/collections/CollHash.pas b/src/lib/collections/CollHash.pas deleted file mode 100644 index 796fc740..00000000 --- a/src/lib/collections/CollHash.pas +++ /dev/null @@ -1,1497 +0,0 @@ -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/src/lib/collections/CollLibrary.pas b/src/lib/collections/CollLibrary.pas deleted file mode 100644 index b7e3d268..00000000 --- a/src/lib/collections/CollLibrary.pas +++ /dev/null @@ -1,131 +0,0 @@ -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/src/lib/collections/CollList.pas b/src/lib/collections/CollList.pas deleted file mode 100644 index 68aa0d66..00000000 --- a/src/lib/collections/CollList.pas +++ /dev/null @@ -1,270 +0,0 @@ -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/src/lib/collections/CollPArray.pas b/src/lib/collections/CollPArray.pas deleted file mode 100644 index 5ebd534b..00000000 --- a/src/lib/collections/CollPArray.pas +++ /dev/null @@ -1,689 +0,0 @@ -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/src/lib/collections/CollWrappers.pas b/src/lib/collections/CollWrappers.pas deleted file mode 100644 index 513103a2..00000000 --- a/src/lib/collections/CollWrappers.pas +++ /dev/null @@ -1,876 +0,0 @@ -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/src/lib/collections/Collections.pas b/src/lib/collections/Collections.pas deleted file mode 100644 index 0c94173d..00000000 --- a/src/lib/collections/Collections.pas +++ /dev/null @@ -1,5318 +0,0 @@ -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. |