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