just a first experimental version

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2011 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 270 insertions, 0 deletions

diff --git a/Medley/src/lib/collections/CollList.pas b/Medley/src/lib/collections/CollList.pas
new file mode 100644
index 00000000..68aa0d66
--- /dev/null
+++ b/Medley/src/lib/collections/CollList.pas
@@ -0,0 +1,270 @@
+unit CollList;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ * 
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $
+ * 
+ *   Collection implementations based on sorted TPArrayList instances.
+ * 
+ * Revision 1.1.1.2  by: Matthew Greet  Rev date: 12/06/04 20:05:54
+ *   Capacity property.
+ * 
+ * Revision 1.1.1.1  by: Matthew Greet  Rev date: 14/02/04 17:45:38
+ *   v1.0 branch.
+ * 
+ * Revision 1.1  by: Matthew Greet  Rev date: 06/04/03 10:41:52
+ *   Uses TExposedPArrayList to improve performance.
+ * 
+ * Revision 1.0  by: Matthew Greet  Rev date: 01/03/03 10:50:02
+ *   Initial revision.
+ * 
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}{$H+}
+{$ENDIF}
+
+uses
+    Collections, CollPArray;
+
+type
+    TListSet = class(TAbstractSet)
+    private
+        FList: TExposedPArrayList;
+    protected
+        function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+        procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+        procedure TrueClear; override;
+        function TrueGet(Position: TCollectionPosition): ICollectable; override;
+        procedure TrueRemove2(Position: TCollectionPosition); override;
+    public
+        constructor Create(NaturalItemsOnly: Boolean); override;
+        destructor Destroy; override;
+        function GetCapacity: Integer; override;
+        procedure SetCapacity(Value: Integer); override;
+        function GetIterator: IIterator; override;
+        function GetNaturalItemIID: TGUID; override;
+        function GetSize: Integer; override;
+    end;
+
+    TListMap = class(TAbstractMap)
+    private
+        FList: TExposedPArrayList;
+    protected
+        function GetAssociationIterator: IMapIterator; override;
+        function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+        procedure TrueClear; override;
+        function TrueGet(Position: TCollectionPosition): IAssociation; override;
+        function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+        function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+    public
+        constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+        destructor Destroy; override;
+        function GetCapacity: Integer; override;
+        procedure SetCapacity(Value: Integer); override;
+        procedure SetKeyComparator(const Value: IComparator); override;
+        function GetNaturalKeyIID: TGUID; override;
+        function GetSize: Integer; override;
+    end;
+
+implementation
+
+type
+    TListPosition = class(TCollectionPosition)
+    private
+        FSearchResult: TSearchResult;
+    public
+        constructor Create(Found: Boolean; SearchResult: TSearchResult);
+        property SearchResult: TSearchResult read FSearchResult;
+    end;
+
+constructor TListSet.Create(NaturalItemsOnly: Boolean);
+begin
+    inherited Create(NaturalItemsOnly);
+    FList := TExposedPArrayList.Create(NaturalItemsOnly);
+    FList.Comparator := Comparator;
+    FList.Sort;
+end;
+
+destructor TListSet.Destroy;
+begin
+    FList.Free;
+    inherited Destroy;
+end;
+
+function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+    SearchResult: TSearchResult;
+begin
+    SearchResult := FList.Search(Item);
+    Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+var
+    SearchResult: TSearchResult;
+    Index: Integer;
+begin
+    SearchResult := TListPosition(Position).SearchResult;
+    Index := SearchResult.Index;
+    if SearchResult.ResultType = srBeforeIndex then
+        FList.TrueInsert(Index, Item)
+    else
+        FList.TrueAppend(Item);
+end;
+
+procedure TListSet.TrueClear;
+begin
+    FList.Clear;
+end;
+
+function TListSet.TrueGet(Position: TCollectionPosition): ICollectable;
+begin
+    Result := FList.Items[TListPosition(Position).SearchResult.Index];
+end;
+
+procedure TListSet.TrueRemove2(Position: TCollectionPosition);
+begin
+    FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+function TListSet.GetCapacity: Integer;
+begin
+    Result := FList.Capacity;
+end;
+
+procedure TListSet.SetCapacity(Value: Integer);
+begin
+    FList.Capacity := Value;
+end;
+
+function TListSet.GetIterator: IIterator;
+begin
+    Result := FList.GetIterator;
+end;
+
+function TListSet.GetNaturalItemIID: TGUID;
+begin
+    Result := ComparableIID;
+end;
+
+function TListSet.GetSize: Integer;
+begin
+    Result := FList.Size;
+end;
+
+constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+    inherited Create(NaturalItemsOnly, NaturalKeysOnly);
+    FList := TExposedPArrayList.Create(false);
+    FList.Comparator := AssociationComparator;
+    FList.Sort;
+end;
+
+destructor TListMap.Destroy;
+begin
+    FList.Free;
+    inherited Destroy;
+end;
+
+function TListMap.GetAssociationIterator: IMapIterator;
+begin
+    Result := TAssociationIterator.Create(FList.GetIterator);
+end;
+
+function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+    Association: IAssociation;
+    SearchResult: TSearchResult;
+begin
+    Association := TAssociation.Create(Key, nil);
+    SearchResult := FList.Search(Association);
+    Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListMap.TrueClear;
+begin
+    FList.Clear;
+end;
+
+function TListMap.TrueGet(Position: TCollectionPosition): IAssociation;
+begin
+    Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+end;
+
+function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+    SearchResult: TSearchResult;
+    Index: Integer;
+begin
+    SearchResult := TListPosition(Position).SearchResult;
+    Index := SearchResult.Index;
+    if SearchResult.ResultType = srFoundAtIndex then
+    begin
+        Result := (FList.Items[Index]) as IAssociation;
+        FList.Items[Index] := Association;
+    end
+    else if SearchResult.ResultType = srBeforeIndex then
+        FList.TrueInsert(Index, Association)
+    else
+        FList.TrueAppend(Association);
+end;
+
+function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+begin
+    Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+    FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+procedure TListMap.SetKeyComparator(const Value: IComparator);
+begin
+    inherited SetKeyComparator(Value);
+    FList.Sort;
+end;
+
+function TListMap.GetCapacity: Integer;
+begin
+    Result := FList.Capacity;
+end;
+
+procedure TListMap.SetCapacity(Value: Integer);
+begin
+    FList.Capacity := Value;
+end;
+
+function TListMap.GetNaturalKeyIID: TGUID;
+begin
+    Result := ComparableIID;
+end;
+
+function TListMap.GetSize: Integer;
+begin
+    Result := FList.Size;
+end;
+
+constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult);
+begin
+    inherited Create(Found);
+    FSearchResult := SearchResult;
+end;
+
+end.