From dc71ad22a7e3bb2592e360a533843ca7aa88b1f8 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 12 Jan 2009 23:29:09 +0000 Subject: Delphi Collections by Matthew Greet for uniform collection (lists, maps, ...) support for both fpc and delphi (delphi misses collections entirely) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1570 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/lib/collections/CollList.pas | 264 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 264 insertions(+) create mode 100644 src/lib/collections/CollList.pas (limited to 'src/lib/collections/CollList.pas') diff --git a/src/lib/collections/CollList.pas b/src/lib/collections/CollList.pas new file mode 100644 index 00000000..ef22a6db --- /dev/null +++ b/src/lib/collections/CollList.pas @@ -0,0 +1,264 @@ +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. + * + * $Endlog$ + *****************************************************************************) + +interface + +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. -- cgit v1.2.3