diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi
index 4187d12..b486d52 100644
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@@ -138,6 +138,11 @@
+
+
+
+
+
@@ -163,7 +168,7 @@
-
+
@@ -434,6 +439,16 @@
+
+
+
+
+
+
+
+
+
+
@@ -462,7 +477,6 @@
-
@@ -470,8 +484,7 @@
-
+
diff --git a/Client/CentrED.lpr b/Client/CentrED.lpr
index d633c3d..1bb1597 100644
--- a/Client/CentrED.lpr
+++ b/Client/CentrED.lpr
@@ -28,6 +28,7 @@ program CentrED;
{$mode objfpc}{$H+}
uses
+ {$IFNDEF NoLogging}heaptrc,{$ENDIF}
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
@@ -43,7 +44,12 @@ begin
end;
begin
+ {$IFNDEF NoLogging}
+ SetHeapTraceOutput('CentrED.trc');
+ {$ENDIF}
+
OnGetApplicationName := @GetApplicationName;
+
Application.Initialize;
Application.CreateForm(TdmNetwork, dmNetwork);
Application.Run;
diff --git a/Client/ULightManager.pas b/Client/ULightManager.pas
index 71789a3..dde8314 100644
--- a/Client/ULightManager.pas
+++ b/Client/ULightManager.pas
@@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
- * Portions Copyright 2011 Andreas Schneider
+ * Portions Copyright 2012 Andreas Schneider
*)
unit ULightManager;
@@ -31,8 +31,8 @@ interface
uses
Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases,
- ImagingOpenGL, GL, GLu, GLext, fgl, ULandscape, UWorldItem, UCacheManager,
- Math;
+ ImagingOpenGL, GL, GLu, GLext, Math, heContnrs, ULandscape, UWorldItem,
+ UCacheManager;
type
@@ -70,7 +70,7 @@ type
property Material: TLightMaterial read FMaterial;
end;
- TLightSources = specialize TFPGObjectList;
+ TLightSources = specialize TheObjectVector;
{ TLightManager }
diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas
index b7f0ff0..f5b58f5 100644
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@@ -34,8 +34,9 @@ uses
ComCtrls, OpenGLContext, GL, GLu, UGameResources, ULandscape, ExtCtrls,
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
- XMLPropStorage, fgl, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
- UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager;
+ XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
+ UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, heContnrs,
+ UContnrExt;
type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@@ -43,12 +44,12 @@ type
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState;
- TBlockInfoList = specialize TFPGList;
+ TBlockInfoList = specialize TheVector;
TGhostTile = class(TStaticItem);
- TPacketList = specialize TFPGObjectList;
- TAccessChangedListeners = specialize TFPGList;
- TSelectionListeners = specialize TFPGList;
+ TPacketList = specialize TheObjectVector;
+ TAccessChangedListeners = specialize TPointerVectorSet;
+ TSelectionListeners = specialize TPointerVectorSet;
TTileHintInfo = record
Name: String;
@@ -650,6 +651,7 @@ var
tileX, tileY, newX, newY: Word;
targetBlocks: TBlockInfoList;
targetTile: TWorldItem;
+ selectionListener: TSelectionListener;
begin
Logger.EnterMethod([lcClient, lcDebug], 'MouseUp');
if Button <> mbLeft then
@@ -677,8 +679,8 @@ begin
mnuGrabTileIDClick(nil);
end;
- for i := FSelectionListeners.Count - 1 downto 0 do
- FSelectionListeners[i](CurrentTile);
+ for selectionListener in FSelectionListeners.Reversed do
+ selectionListener(CurrentTile);
end;
if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
@@ -1123,14 +1125,16 @@ end;
procedure TfrmMain.acUndoExecute(Sender: TObject);
var
- i: Integer;
+ packet: TPacket;
begin
- for i := FUndoList.Count - 1 downto 0 do
- begin
- dmNetwork.Send(FUndoList[i]);
- FUndoList[i] := nil;
- end;
- FUndoList.Clear;
+ //Send each reversed action in reverse order.
+ for packet in FUndoList.Reversed do
+ dmNetwork.Send(packet);
+
+ //Cleanup without freeing the objects (this was already done by dmNetwork.Send)
+ FUndoList.Wipe;
+
+ //No Undo packets, nothing to undo.
acUndo.Enabled := False;
end;
@@ -1912,25 +1916,23 @@ end;
procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener);
begin
- if FAccessChangedListeners.IndexOf(AListener) < 0 then
- FAccessChangedListeners.Add(AListener);
+ FAccessChangedListeners.Include(AListener);
end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin
- if FSelectionListeners.IndexOf(AListener) < 0 then
- FSelectionListeners.Add(AListener);
+ FSelectionListeners.Include(AListener);
end;
procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener);
begin
- FAccessChangedListeners.Remove(AListener);
+ FAccessChangedListeners.Exclude(AListener);
end;
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin
- FSelectionListeners.Remove(AListener);
+ FSelectionListeners.Exclude(AListener);
end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
@@ -3057,6 +3059,7 @@ var
sender, msg: string;
i: Integer;
accessLevel: TAccessLevel;
+ accessChangedListener: TAccessChangedListener;
begin
case ABuffer.ReadByte of
$01: //client connected
@@ -3111,8 +3114,8 @@ begin
end;
end;
- for i := FAccessChangedListeners.Count - 1 downto 0 do
- FAccessChangedListeners[i](accessLevel);
+ for accessChangedListener in FAccessChangedListeners.Reversed do
+ accessChangedListener(accessLevel);
end;
end;
end;
diff --git a/Server/cedserver.lpi b/Server/cedserver.lpi
index f3ffad3..0426239 100644
--- a/Server/cedserver.lpi
+++ b/Server/cedserver.lpi
@@ -237,15 +237,13 @@
-
-
+
diff --git a/Server/cedserver.lpr b/Server/cedserver.lpr
index be6bd76..3ac6b04 100644
--- a/Server/cedserver.lpr
+++ b/Server/cedserver.lpr
@@ -28,6 +28,7 @@ program cedserver;
{$mode objfpc}{$H+}
uses
+ {$IFNDEF NoLogging}heaptrc,{$ENDIF}
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
@@ -36,6 +37,10 @@ uses
{$R *.res}
begin
+ {$IFNDEF NoLogging}
+ SetHeapTraceOutput('cedserver.trc');
+ {$ENDIF}
+
Writeln('');
Writeln('CentrED Server Version ', VersionInfo.GetProductVersionString);
Writeln(VersionInfo.GetCopyright(True));
diff --git a/UContnrExt.pas b/UContnrExt.pas
new file mode 100644
index 0000000..7035866
--- /dev/null
+++ b/UContnrExt.pas
@@ -0,0 +1,54 @@
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License"). You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php. If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ * Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ * Portions Copyright 2012 Andreas Schneider
+ *)
+unit UContnrExt;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ heContnrs;
+
+type
+
+ { TPointerVectorSet }
+
+ generic TPointerVectorSet = class(specialize TheCmpVectorSet)
+ public
+ function Compare(const A, B: T): Integer; override;
+ end;
+
+implementation
+
+{ TPointerVectorSet }
+
+function TPointerVectorSet.Compare(const A, B: T): Integer;
+begin
+ Result := @A - @B;
+end;
+
+end.
+
diff --git a/UOLib/UMap.pas b/UOLib/UMap.pas
index a223cd6..2b1a8dc 100644
--- a/UOLib/UMap.pas
+++ b/UOLib/UMap.pas
@@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
- * Portions Copyright 2009 Andreas Schneider
+ * Portions Copyright 2012 Andreas Schneider
*)
unit UMap;
@@ -30,7 +30,7 @@ unit UMap;
interface
uses
- SysUtils, Classes, fgl, UWorldItem;
+ SysUtils, Classes, heContnrs, UWorldItem;
const
MapCellSize = 3;
@@ -60,7 +60,7 @@ type
procedure Write(AData: TStream); override;
end;
- TMapCellList = specialize TFPGObjectList;
+ TMapCellList = specialize TheObjectVector;
{ TMapBlock }
diff --git a/UOLib/UStatics.pas b/UOLib/UStatics.pas
index 08535ca..ef6b94a 100644
--- a/UOLib/UStatics.pas
+++ b/UOLib/UStatics.pas
@@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
- * Portions Copyright 2009 Andreas Schneider
+ * Portions Copyright 2012 Andreas Schneider
*)
unit UStatics;
@@ -30,7 +30,7 @@ unit UStatics;
interface
uses
- SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
+ SysUtils, Classes, heContnrs, UGenericIndex, UWorldItem, UTiledata;
type
{ TStaticItem }
@@ -56,7 +56,7 @@ type
procedure Write(AData: TStream); override;
end;
- TStaticItemList = specialize TFPGObjectList;
+ TStaticItemList = specialize TheObjectVector;
{ TStaticBlock}
diff --git a/UOLib/UWorldItem.pas b/UOLib/UWorldItem.pas
index 829535c..b56c89c 100644
--- a/UOLib/UWorldItem.pas
+++ b/UOLib/UWorldItem.pas
@@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
- * Portions Copyright 2009 Andreas Schneider
+ * Portions Copyright 2012 Andreas Schneider
*)
unit UWorldItem;
@@ -30,7 +30,7 @@ unit UWorldItem;
interface
uses
- Classes, fgl, UMulBlock;
+ Classes, heContnrs, UMulBlock;
type
TWorldBlock = class;
@@ -81,7 +81,7 @@ type
property RawZ: ShortInt read FZ;
end;
- TWorldItemList = specialize TFPGObjectList;
+ TWorldItemList = specialize TheObjectVector;
{ TWorldBlock }
diff --git a/heContnrs.pas b/heContnrs.pas
new file mode 100644
index 0000000..6ebdce2
--- /dev/null
+++ b/heContnrs.pas
@@ -0,0 +1,7370 @@
+unit heContnrs; { http://code.google.com/p/fprb/wiki/heContnrs }
+
+{$mode objfpc}{$H+}
+
+//------------------------------------------------------------------------------
+// Copyright 2010, bflm. All rights reserved.
+// Use of this source code is governed by a BSD-style
+// license that can be found in the LICENSE file.
+//------------------------------------------------------------------------------
+// The list container is a FPC port/modification of source code from
+// the Google Go project: http://code.google.com/p/go
+//
+// Copyright 2009 The Go Authors. All rights reserved.
+// Use of this source code is governed by a BSD-style
+// license that can be found in the LICENSE-GO file.
+//------------------------------------------------------------------------------
+
+{$if (FPC_VERSION < 2) or ((FPC_VERSION = 2) and (FPC_RELEASE < 6))}
+{$fatal 'Requires FPC >= 2.6.0'}
+{$endif}
+
+interface
+
+uses
+ SysUtils;
+
+type
+
+ EMapKeyNotFound = class(Exception);
+
+ { TheEnumerator }
+
+ generic TheEnumerator = object
+ public type
+ TGetCurrent = function(var Iterator: TIterator): TValue of object;
+ TMoveNext = function(var Iterator: TIterator): Boolean of object;
+ private
+ FGetCurrent: TGetCurrent;
+ FIterator: TIterator;
+ FMoveNext: TMoveNext;
+ function GetCurrent: TValue;
+ public
+ procedure Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent);
+ function MoveNext: Boolean;
+ property Current: TValue read GetCurrent;
+ end;
+
+ { TheEnumeratorProvider }
+
+ generic TheEnumeratorProvider = object
+ public
+ FEnumerator: TProvidedEnumerator;
+ function GetEnumerator: TProvidedEnumerator;
+ end;
+
+ { TheObjectVector }
+
+ generic TheObjectVector = class { http://code.google.com/p/fprb/wiki/TheObjectVector }
+ public type
+ PItem = ^TItem;
+ TCompare = function(const A, B: TItem): Integer;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ FOwnObjects: Boolean;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetItems(const Index: Integer; const AValue: TItem);
+ procedure Sort(Left, Right: Integer; const Compare: TCompare);
+ protected
+ property Data: PItem read FData;
+ public
+ constructor Create(const AOwnObjects: Boolean = True);
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Insert(const Index: Integer; const Item: TItem);
+ procedure Kill;
+ procedure Pack;
+ procedure Sort(const Compare: TCompare);
+ procedure Swap(const ItemAIndex, ItemBIndex: Integer);
+ procedure Wipe;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
+ property Last: TItem read GetLast;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ end;
+
+ { TheVector }
+
+ generic TheVector = class { http://code.google.com/p/fprb/wiki/TheVector }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetItems(const Index: Integer; const AValue: TItem);
+ procedure Sort(Left, Right: Integer);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Insert(const Index: Integer; const Item: TItem);
+ procedure Pack;
+ procedure Sort;
+ procedure Swap(const ItemAIndex, ItemBIndex: Integer);
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheCmpVector }
+
+ generic TheCmpVector = class { http://code.google.com/p/fprb/wiki/TheCmpVector }
+ public type
+ PItem = ^TItem;
+ TCompare = function(const A, B: TItem): Integer;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetItems(const Index: Integer; const AValue: TItem);
+ procedure Sort(Left, Right: Integer);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ function SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Insert(const Index: Integer; const Item: TItem);
+ procedure Pack;
+ procedure Sort;
+ procedure Swap(const ItemAIndex, ItemBIndex: Integer);
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems write SetItems; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheSortVector }
+
+ generic TheSortVector = class { http://code.google.com/p/fprb/wiki/TheSortVector }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheVectorSet }
+
+ generic TheVectorSet = class { http://code.google.com/p/fprb/wiki/TheVectorSet }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Exclude(const Item: TItem): Boolean; // true => was in set
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean; // true => was in set
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheVectorMap }
+
+ generic TheVectorMap = class { http://code.google.com/p/fprb/wiki/TheVectorMap }
+ public type
+ PItem = ^TItem;
+ TItem = record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetKey(const Index: Integer): TKey;
+ function GetCurrentKey(var Index: Integer): TKey;
+ function GetLast: TItem;
+ function GetMap(const AKey: TKey): TValue;
+ function GetValue(const Index: Integer): TValue;
+ function GetCurrentValue(var Index: Integer): TValue;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMap(const AKey: TKey; const AValue: TValue);
+ protected
+ property Data: PItem read FData;
+ function MissingKeyValue(const AKey: TKey): TValue; virtual;
+ public
+ destructor Destroy; override;
+ function Extract(const Index: Integer): TItem;
+ function Find(const AKey: TKey; out Index: Integer): Boolean;
+ function Has(const AKey: TKey): Boolean;
+ function IndexOf(const AKey: TKey): Integer;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Remove(const AKey: TKey): Integer;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Item[const Index: Integer]: TItem read GetItem;
+ property Key[const Index: Integer]: TKey read GetKey;
+ property Last: TItem read GetLast;
+ property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
+ property Value[const Index: Integer]: TValue read GetValue;
+ end;
+
+ { TheCmpVectorMap }
+
+ generic TheCmpVectorMap = class { http://code.google.com/p/fprb/wiki/TheCmpVectorMap }
+ public type
+ PItem = ^TItem;
+ TItem = record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetKey(const Index: Integer): TKey;
+ function GetCurrentKey(var Index: Integer): TKey;
+ function GetLast: TItem;
+ function GetMap(const AKey: TKey): TValue;
+ function GetValue(const Index: Integer): TValue;
+ function GetCurrentValue(var Index: Integer): TValue;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMap(const AKey: TKey; const AValue: TValue);
+ protected
+ property Data: PItem read FData;
+ function MissingKeyValue(const AKey: TKey): TValue; virtual;
+ public
+ destructor Destroy; override;
+ function Compare(const A, B: TKey): Integer; virtual; // abstract;
+ function Extract(const Index: Integer): TItem;
+ function Find(const AKey: TKey; out Index: Integer): Boolean;
+ function Has(const AKey: TKey): Boolean;
+ function IndexOf(const AKey: TKey): Integer;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Remove(const AKey: TKey): Integer;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Item[const Index: Integer]: TItem read GetItem;
+ property Key[const Index: Integer]: TKey read GetKey;
+ property Last: TItem read GetLast;
+ property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
+ property Value[const Index: Integer]: TValue read GetValue;
+ end;
+
+ { TheObjectVectorMap }
+
+ generic TheObjectVectorMap = class { http://code.google.com/p/fprb/wiki/TheObjectVectorMap }
+ public type
+ PItem = ^TItem;
+ TItem = record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ FOwnObjects: Boolean;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetKey(const Index: Integer): TKey;
+ function GetCurrentKey(var Index: Integer): TKey;
+ function GetLast: TItem;
+ function GetMap(const AKey: TKey): TValue;
+ function GetValue(const Index: Integer): TValue;
+ function GetCurrentValue(var Index: Integer): TValue;
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMap(const AKey: TKey; const AValue: TValue);
+ protected
+ property Data: PItem read FData;
+ function MissingKeyValue(const AKey: TKey): TValue; virtual;
+ public
+ constructor Create(const AOwnObjects: Boolean = True);
+ destructor Destroy; override;
+ function Compare(const A, B: TKey): Integer; virtual; // abstract;
+ function Extract(const Index: Integer): TItem;
+ function Find(const AKey: TKey; out Index: Integer): Boolean;
+ function Has(const AKey: TKey): Boolean;
+ function IndexOf(const AKey: TKey): Integer;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Remove(const AKey: TKey): Integer;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Item[const Index: Integer]: TItem read GetItem;
+ property Key[const Index: Integer]: TKey read GetKey;
+ property Last: TItem read GetLast;
+ property Map[const AKey: TKey]: TValue read GetMap write SetMap; default;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ property Value[const Index: Integer]: TValue read GetValue;
+ end;
+
+ { TheCmpVectorSet }
+
+ generic TheCmpVectorSet = class { http://code.google.com/p/fprb/wiki/TheCmpVectorSet }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract;
+ function Exclude(const Item: TItem): Boolean; // true => was in set
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean; // true => was in set
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheObjectVectorSet }
+
+ generic TheObjectVectorSet = class { http://code.google.com/p/fprb/wiki/TheObjectVectorSet }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ FOwnObjects: Boolean;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetItem(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ protected
+ property Data: PItem read FData;
+ public
+ constructor Create(const AOwnObjects: Boolean = True);
+ destructor Destroy; override;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract;
+ function Exclude(const Item: TItem): Boolean; // true => was in set
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean; // true => was in set
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Kill;
+ procedure Pack;
+ procedure Wipe;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property Last: TItem read GetLast;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ end;
+
+ { TheCmpSortVector }
+
+ generic TheCmpSortVector = class { http://code.google.com/p/fprb/wiki/TheCmpSortVector }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ protected
+ property Data: PItem read FData;
+ public
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Pack;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems; default;
+ property Last: TItem read GetLast;
+ end;
+
+ { TheObjectSortVector }
+
+ generic TheObjectSortVector = class { http://code.google.com/p/fprb/wiki/TheObjectSortVector }
+ public type
+ PItem = ^TItem;
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCapacity: Integer;
+ FCount: Integer;
+ FData: PItem;
+ FOwnObjects: Boolean;
+ function GetFirst: TItem;
+ function GetItems(const Index: Integer): TItem;
+ function GetCurrent(var Index: Integer): TItem;
+ function GetLast: TItem;
+ procedure Insert(const Index: Integer; const Item: TItem);
+ function MoveNext(var Index: Integer): Boolean;
+ function MovePrev(var Index: Integer): Boolean;
+ procedure SetCapacity(AValue: Integer);
+ protected
+ property Data: PItem read FData;
+ public
+ constructor Create(const AOwnObjects: Boolean = True);
+ destructor Destroy; override;
+ function Add(const Item: TItem): Integer;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract;
+ function Extract(const Index: Integer): TItem;
+ function Find(const Item: TItem; out Index: Integer): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Has(const Item: TItem): Boolean;
+ function IndexOf(const Item: TItem): Integer;
+ function Push(const Item: TItem): TItem;
+ function Remove(const Item: TItem): Integer;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Delete(const Index: Integer);
+ procedure Kill;
+ procedure Pack;
+ procedure Wipe;
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount;
+ property First: TItem read GetFirst;
+ property Items[const Index: Integer]: TItem read GetItems; default;
+ property Last: TItem read GetLast;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ end;
+
+ { TheList }
+
+ generic TheList = class { http://code.google.com/p/fprb/wiki/TheList }
+ public type
+ PNode = ^TNode;
+ TNode = object
+ private
+ FNext: PNode;
+ FPrev: PNode;
+ public
+ Item: TItem;
+ property Next: PNode read FNext;
+ property Prev: PNode read FPrev;
+ end;
+ private type
+ TIterator = record
+ List: TObject;
+ Node: PNode;
+ end;
+ public type
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private type
+ PNode_ = ^TNode_;
+ TNode_ = object
+ public
+ FNext: PNode_;
+ FPrev: PNode_;
+ FItem: TItem;
+ end;
+ private
+ FCount: Integer;
+ FFirst: PNode;
+ FLast: PNode;
+ function CurrentItem(var Iterator: TIterator): TItem;
+ function InsertAfter_(const After, Node: PNode): PNode;
+ function InsertBack(const Node: PNode): PNode;
+ function InsertBefore_(const Node, Before: PNode): PNode;
+ function InsertFront(const Node: PNode): PNode;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function NewIterator: TIterator;
+ function NewNode(const AItem: TItem): PNode;
+ public
+ destructor Destroy; override;
+ function Extract(const Node: PNode): PNode;
+ function GetEnumerator: TEnumerator;
+ function InsertAfter(const After: PNode; const AItem: TItem): PNode;
+ function InsertBefore(const AItem: TItem; const Before: PNode): PNode;
+ function MoveAfter(const After, Node: PNode): PNode;
+ function MoveBefore(const Node, Before: PNode): PNode;
+ function MoveToBack(const Node: PNode): PNode;
+ function MoveToFront(const Node: PNode): PNode;
+ function PushBack(const AItem: TItem): PNode;
+ function PushFront(const AItem: TItem): PNode;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Remove(Node: PNode);
+ property Count: Integer read FCount;
+ property First: PNode read FFirst;
+ property Last: PNode read FLast;
+ end;
+
+ { TheObjectList }
+
+ generic TheObjectList = class { http://code.google.com/p/fprb/wiki/TheObjectList }
+ public type
+ PNode = ^TNode;
+ TNode = object
+ private
+ FNext: PNode;
+ FPrev: PNode;
+ public
+ Item: TItem;
+ property Next: PNode read FNext;
+ property Prev: PNode read FPrev;
+ end;
+ private type
+ TIterator = record
+ List: TObject;
+ Node: PNode;
+ end;
+ public type
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private type
+ PNode_ = ^TNode_;
+ TNode_ = object
+ public
+ FNext: PNode_;
+ FPrev: PNode_;
+ FItem: TItem;
+ end;
+ private
+ FCount: Integer;
+ FFirst: PNode;
+ FLast: PNode;
+ FOwnObjects: Boolean;
+ function CurrentItem(var Iterator: TIterator): TItem;
+ function InsertAfter_(const After, Node: PNode): PNode;
+ function InsertBack(const Node: PNode): PNode;
+ function InsertBefore_(const Node, Before: PNode): PNode;
+ function InsertFront(const Node: PNode): PNode;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function NewIterator: TIterator;
+ function NewNode(const AItem: TItem): PNode;
+ public
+ constructor Create(const AOwnObjects: Boolean = True);
+ destructor Destroy; override;
+ function Extract(const Node: PNode): PNode;
+ function GetEnumerator: TEnumerator;
+ function InsertAfter(const After: PNode; const AItem: TItem): PNode;
+ function InsertBefore(const AItem: TItem; const Before: PNode): PNode;
+ function MoveAfter(const After, Node: PNode): PNode;
+ function MoveBefore(const Node, Before: PNode): PNode;
+ function MoveToBack(const Node: PNode): PNode;
+ function MoveToFront(const Node: PNode): PNode;
+ function PushBack(const AItem: TItem): PNode;
+ function PushFront(const AItem: TItem): PNode;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ procedure Remove(Node: PNode);
+ property Count: Integer read FCount;
+ property First: PNode read FFirst;
+ property Last: PNode read FLast;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ end;
+
+ { TheBTreeSet }
+
+ generic TheBTreeSet = class { http://code.google.com/p/fprb/wiki/TheBTreeSet }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TItem;
+ end;
+ public type
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TItem;
+ function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetLast: TItem;
+ function GetCurrent(var Iterator: TIterator): TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ public
+ constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Exclude(const Item: TItem): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TItem read GetFirst;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TItem read GetLast;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
+ end;
+
+ { TheCmpBTreeSet }
+
+ generic TheCmpBTreeSet = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeSet }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TItem;
+ end;
+ public type
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TItem;
+ function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetLast: TItem;
+ function GetCurrent(var Iterator: TIterator): TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ public
+ constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract
+ function Exclude(const Item: TItem): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TItem read GetFirst;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TItem read GetLast;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
+ end;
+
+ { TheObjectBTreeSet }
+
+ generic TheObjectBTreeSet = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeSet }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TItem;
+ end;
+ public type
+ TEnumerator = specialize TheEnumerator;
+ TEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FOwnObjects: Boolean;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TItem;
+ function Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+ function GetFirst: TItem;
+ function GetLast: TItem;
+ function GetCurrent(var Iterator: TIterator): TItem;
+ function GetMembership(const Item: TItem): Boolean;
+ function GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SetMembership(const Item: TItem; const AValue: Boolean);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ public
+ constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Compare(const A, B: TItem): Integer; virtual; // abstract
+ function Exclude(const Item: TItem): Boolean;
+ function GetEnumerator: TEnumerator;
+ function Include(const Item: TItem): Boolean;
+ function Reversed: TEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TItem read GetFirst;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TItem read GetLast;
+ property Membership[const Item: TItem]: Boolean read GetMembership write SetMembership; default;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ property Range[const RangeFrom, RangeTo: TItem]: TEnumeratorProvider read GetRange;
+ end;
+
+ { TheBTreeMap }
+
+ generic TheBTreeMap = class { http://code.google.com/p/fprb/wiki/TheBTreeMap }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TItem = packed record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem; // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TKey;
+ end;
+ public type
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TValue;
+ function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+ function GetCurrent(var Iterator: TIterator): TValue;
+ function GetCurrentKey(var Iterator: TIterator): TKey;
+ function GetFirst: TValue;
+ function GetFirstKey: TKey;
+ function GetLast: TValue;
+ function GetLastKey: TKey;
+ function GetMap(const Key: TKey): TValue;
+ function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+ function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SetMap(const Key: TKey; const Value: TValue);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ protected
+ function MissingKeyValue(const Key: TKey): TValue; virtual;
+ public
+ constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Delete(const Key: TKey): Boolean;
+ function Extract(const Key: TKey; out Value: TValue): Boolean;
+ function Get(const Key: TKey; out Value: TValue): Boolean;
+ function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TValue read GetFirst;
+ property FirstKey: TKey read GetFirstKey;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TValue read GetLast;
+ property LastKey: TKey read GetLastKey;
+ property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
+ property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
+ property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
+ end;
+
+ { TheCmpBTreeMap }
+
+ generic TheCmpBTreeMap = class { http://code.google.com/p/fprb/wiki/TheCmpBTreeMap }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TItem = packed record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem; // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TKey;
+ end;
+ public type
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TValue;
+ function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+ function GetCurrent(var Iterator: TIterator): TValue;
+ function GetCurrentKey(var Iterator: TIterator): TKey;
+ function GetFirst: TValue;
+ function GetFirstKey: TKey;
+ function GetLast: TValue;
+ function GetLastKey: TKey;
+ function GetMap(const Key: TKey): TValue;
+ function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+ function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SetMap(const Key: TKey; const Value: TValue);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ protected
+ function MissingKeyValue(const Key: TKey): TValue; virtual;
+ public
+ constructor Create(const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Compare(const A, B: TKey): Integer; virtual; // abstract
+ function Delete(const Key: TKey): Boolean;
+ function Extract(const Key: TKey; out Value: TValue): Boolean;
+ function Get(const Key: TKey; out Value: TValue): Boolean;
+ function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TValue read GetFirst;
+ property FirstKey: TKey read GetFirstKey;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TValue read GetLast;
+ property LastKey: TKey read GetLastKey;
+ property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
+ property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
+ property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
+ end;
+
+ { TheObjectBTreeMap }
+
+ generic TheObjectBTreeMap = class { http://code.google.com/p/fprb/wiki/TheObjectBTreeMap }
+ private type
+ PPage = ^TPage;
+ PData = ^TDataPage;
+ PIndex = ^TIndexPage;
+ TPage = packed record // object
+ Count: Integer;
+ IsIndex: LongBool;
+ end;
+ TIndexPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Index: array[0..1] of record
+ Child: PPage; // ^Index or data page, count in KIndex-1..2*KIndex+2 items except root
+ DataPage: PData; // ^Data page, count in KIndex-1..2*KIndex+1 items except root
+ end;
+ end;
+ TItem = packed record
+ Key: TKey;
+ Value: TValue;
+ end;
+ TDataPage = packed record // object(TPage)
+ Hdr: TPage; // must be first
+ Prev, Next: PData;
+ Data: array[0..1] of TItem; // KData-1..2*KData items
+ end;
+ TIterator = record
+ Page: PData;
+ Index: Integer;
+ UseSentinel: Boolean;
+ Sentinel: TKey;
+ end;
+ public type
+ TKeyEnumerator = specialize TheEnumerator;
+ TValueEnumerator = specialize TheEnumerator;
+ TKeyEnumeratorProvider = specialize TheEnumeratorProvider;
+ TValueEnumeratorProvider = specialize TheEnumeratorProvider;
+ private
+ FCount: Integer;
+ FFirst: PPage;
+ FKData: Integer;
+ FKIndex: Integer;
+ FLast: PPage;
+ FOwnObjects: Boolean;
+ FRoot: PPage;
+ private
+ function ExtractData(const P: PPage; const Index: Integer): TValue;
+ function Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+ function GetCurrent(var Iterator: TIterator): TValue;
+ function GetCurrentKey(var Iterator: TIterator): TKey;
+ function GetFirst: TValue;
+ function GetFirstKey: TKey;
+ function GetLast: TValue;
+ function GetLastKey: TKey;
+ function GetMap(const Key: TKey): TValue;
+ function GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+ function GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+ function Insert(const P: PPage; const Index: Integer): PPage;
+ function Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+ function InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+ function MoveNext(var Iterator: TIterator): Boolean;
+ function MovePrev(var Iterator: TIterator): Boolean;
+ function Page(const IsIndex: Boolean; const LeftmostChild: PPage = nil): PPage;
+ function Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+ procedure CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+ procedure Clear(const P: PPage);
+ procedure Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+ procedure ExtractIndex(const P: PPage; const Index: Integer);
+ procedure MoveLeft(const Left, P: PPage; const N: Integer = 1);
+ procedure MoveRight(const P, Right: PPage; const N: Integer = 1);
+ procedure Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SetMap(const Key: TKey; const Value: TValue);
+ procedure SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+ procedure SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ procedure Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+ procedure Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+ procedure Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+ property Root: PPage Read FRoot;
+ protected
+ function MissingKeyValue(const Key: TKey): TValue; virtual;
+ public
+ constructor Create(const AOwnObjects: Boolean = True; const AKIndex: Integer = 64; const AKData: Integer = 32);
+ destructor Destroy; override;
+ function Compare(const A, B: TKey): Integer; virtual; // abstract
+ function Delete(const Key: TKey): Boolean;
+ function Extract(const Key: TKey; out Value: TValue): Boolean;
+ function Get(const Key: TKey; out Value: TValue): Boolean;
+ function Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean = True): Boolean;
+ function Keys: TKeyEnumeratorProvider;
+ function KeysReversed: TKeyEnumeratorProvider;
+ function Values: TValueEnumeratorProvider;
+ function ValuesReversed: TValueEnumeratorProvider;
+ procedure Clear;
+ property Count: Integer Read FCount;
+ property First: TValue read GetFirst;
+ property FirstKey: TKey read GetFirstKey;
+ property KData: Integer Read FKData;
+ property KIndex: Integer Read FKIndex;
+ property Last: TValue read GetLast;
+ property LastKey: TKey read GetLastKey;
+ property Map[const Key: TKey]: TValue read GetMap write SetMap; default;
+ property Range[const RangeFrom, RangeTo: TKey]: TValueEnumeratorProvider read GetRange;
+ property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
+ property RangeKeys[const RangeFrom, RangeTo: TKey]: TKeyEnumeratorProvider read GetRangeKeys;
+ end;
+
+implementation
+
+uses
+ Math;
+
+{ TheEnumerator }
+
+function TheEnumerator.GetCurrent: TValue;
+begin
+ Result := FGetCurrent(FIterator);
+end;
+
+function TheEnumerator.MoveNext: Boolean;
+begin
+ Result := FMoveNext(FIterator);
+end;
+
+procedure TheEnumerator.Init(const InitialIterator: TIterator; const Mover: TMoveNext; const Getter: TGetCurrent);
+begin
+ Assert(Assigned(Mover));
+ Assert(Assigned(Getter));
+ FIterator := InitialIterator;
+ FMoveNext := Mover;
+ FGetCurrent := Getter;
+end;
+
+{ TheEnumeratorProvider }
+
+function TheEnumeratorProvider.GetEnumerator: TProvidedEnumerator;
+begin
+ Result := FEnumerator;
+end;
+
+{ TheObjectVector }
+
+function TheObjectVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheObjectVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result :=FData[Count - 1];
+end;
+
+function TheObjectVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheObjectVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheObjectVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheObjectVector.SetItems(const Index: Integer; const AValue: TItem);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ FData[Index] := AValue;
+end;
+
+procedure TheObjectVector.Sort(Left, Right: Integer; const Compare: TCompare);
+var
+ L, R: Integer;
+ Pivot: TItem;
+begin
+ repeat
+ L := Left;
+ R := Right;
+ Pivot := FData[(L + R) shr 1];
+ repeat
+ while Compare(Pivot, FData[L]) > 0 do
+ L += 1;
+ while Compare(Pivot, FData[R]) < 0 do
+ R -= 1;
+ if L <= R then begin
+ Swap(L, R);
+ L += 1;
+ R -= 1;
+ end;
+ until L > R;
+ if Left < R then
+ Sort(Left, R, Compare);
+ Left := L;
+ until L >= Right;
+end;
+
+constructor TheObjectVector.Create(const AOwnObjects: Boolean);
+begin
+ inherited Create;
+ OwnObjects := AOwnObjects;
+end;
+
+destructor TheObjectVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectVector.Add(const Item: TItem): Integer;
+begin
+ Result := Count;
+ Inc(FCount);
+ if Result >= Capacity then
+ Capacity := 2 * Count;
+ FData[Result] := Item;
+end;
+
+function TheObjectVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheObjectVector.Find(const Item: TItem; out Index: Integer): Boolean;
+begin
+ Index := IndexOf(Item);
+ Result := Index >= 0;
+end;
+
+function TheObjectVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheObjectVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheObjectVector.IndexOf(const Item: TItem): Integer;
+begin
+ Assert(@Item = @Item); // hint off
+ for Result := 0 to Count - 1 do
+ if FData[Result] = Item then
+ Exit;
+ Result := -1;
+end;
+
+function TheObjectVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheObjectVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result);
+end;
+
+function TheObjectVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+function TheObjectVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Result := FData[ItemAIndex];
+ FData[ItemAIndex] := ItemB;
+end;
+
+procedure TheObjectVector.Clear;
+var I: Integer;
+begin
+ if OwnObjects then
+ for I := 0 to Count - 1 do
+ FData[I].Free;
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheObjectVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheObjectVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ FData[Index] := Item;
+end;
+
+procedure TheObjectVector.Kill;
+begin
+ OwnObjects := False;
+ Free;
+end;
+
+procedure TheObjectVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+procedure TheObjectVector.Sort(const Compare: TCompare);
+begin
+ if Count > 1 then
+ Sort(0, Count - 1, Compare);
+end;
+
+procedure TheObjectVector.Swap(const ItemAIndex, ItemBIndex: Integer);
+var Item: TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
+ Item := FData[ItemAIndex];
+ FData[ItemAIndex] := FData[ItemBIndex];
+ FData[ItemBIndex] := Item;
+end;
+
+procedure TheObjectVector.Wipe;
+begin
+ FCount := 0;
+end;
+
+{ TheVector }
+
+procedure TheVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+procedure TheVector.Sort;
+begin
+ if Count > 1 then
+ Sort(0, Count - 1);
+end;
+
+procedure TheVector.Swap(const ItemAIndex, ItemBIndex: Integer);
+var Item: TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
+ Item := FData[ItemAIndex];
+ FData[ItemAIndex] := FData[ItemBIndex];
+ FData[ItemBIndex] := Item;
+end;
+
+function TheVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheVector.SetItems(const Index: Integer; const AValue: TItem);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ FData[Index] := AValue;
+end;
+
+procedure TheVector.Sort(Left, Right: Integer);
+var
+ L, R: Integer;
+ Pivot: TItem;
+begin
+ Assert(@Pivot = @Pivot); // hint off
+ repeat
+ L := Left;
+ R := Right;
+ Pivot := FData[(L + R) div 2];
+ repeat
+ while Pivot > FData[L] do
+ L += 1;
+ while Pivot < FData[R] do
+ R -= 1;
+ if L <= R then begin
+ Swap(L, R);
+ L += 1;
+ R -= 1;
+ end;
+ until L > R;
+ if Left < R then
+ Sort(Left, R);
+ Left := L;
+ until L >= Right;
+end;
+
+destructor TheVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheVector.Add(const Item: TItem): Integer;
+begin
+ Result := Count;
+ Inc(FCount);
+ if Result >= Capacity then
+ Capacity := 2 * Count;
+ Initialize(FData[Result]);
+ FData[Result] := Item;
+end;
+
+function TheVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheVector.Find(const Item: TItem; out Index: Integer): Boolean;
+begin
+ Index := IndexOf(Item);
+ Result := Index >= 0;
+end;
+
+function TheVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheVector.IndexOf(const Item: TItem): Integer;
+begin
+ Assert(@Item = @Item); // hint off
+ for Result := 0 to Count - 1 do
+ if FData[Result] = Item then
+ Exit;
+ Result := -1;
+end;
+
+function TheVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result);
+end;
+
+function TheVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+function TheVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Result := FData[ItemAIndex];
+ FData[ItemAIndex] := ItemB;
+end;
+
+procedure TheVector.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+{ TheCmpVector }
+
+procedure TheCmpVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+procedure TheCmpVector.Sort;
+begin
+ if Count > 1 then
+ Sort(0, Count - 1);
+end;
+
+procedure TheCmpVector.Swap(const ItemAIndex, ItemBIndex: Integer);
+var Item: TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Assert((ItemBIndex >= 0) and (ItemBIndex < Count));
+ if ItemAIndex = ItemBIndex then
+ Exit;
+ Item := FData[ItemAIndex];
+ FData[ItemAIndex] := FData[ItemBIndex];
+ FData[ItemBIndex] := Item;
+end;
+
+function TheCmpVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheCmpVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheCmpVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheCmpVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheCmpVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheCmpVector.SetItems(const Index: Integer; const AValue: TItem);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ FData[Index] := AValue;
+end;
+
+procedure TheCmpVector.Sort(Left, Right: Integer);
+var
+ L, R: Integer;
+ Pivot: TItem;
+begin
+ repeat
+ L := Left;
+ R := Right;
+ Pivot := FData[(L + R) div 2];
+ repeat
+ while Compare(Pivot, FData[L]) > 0 do
+ L += 1;
+ while Compare(Pivot, FData[R]) < 0 do
+ R -= 1;
+ if L <= R then begin
+ Swap(L, R);
+ L += 1;
+ R -= 1;
+ end;
+ until L > R;
+ if Left < R then
+ Sort(Left, R);
+ Left := L;
+ until L >= Right;
+end;
+
+destructor TheCmpVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpVector.Add(const Item: TItem): Integer;
+begin
+ Result := Count;
+ Inc(FCount);
+ if Result >= Capacity then
+ Capacity := 2 * Count;
+ Initialize(FData[Result]);
+ FData[Result] := Item;
+end;
+
+function TheCmpVector.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheCmpVector.Find(const Item: TItem; out Index: Integer): Boolean;
+begin
+ Index := IndexOf(Item);
+ Result := Index >= 0;
+end;
+
+function TheCmpVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheCmpVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheCmpVector.IndexOf(const Item: TItem): Integer;
+begin
+ for Result := 0 to Count - 1 do
+ if Compare(FData[Result], Item) = 0 then
+ Exit;
+ Result := -1;
+end;
+
+function TheCmpVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheCmpVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result);
+end;
+
+function TheCmpVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+function TheCmpVector.SwapWith(const ItemAIndex: Integer; const ItemB: TItem): TItem;
+begin
+ Assert((ItemAIndex >= 0) and (ItemAIndex < Count));
+ Result := FData[ItemAIndex];
+ FData[ItemAIndex] := ItemB;
+end;
+
+procedure TheCmpVector.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheCmpVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheCmpVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+{ TheSortVector }
+
+procedure TheSortVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+function TheSortVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheSortVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheSortVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheSortVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheSortVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheSortVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheSortVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+destructor TheSortVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheSortVector.Add(const Item: TItem): Integer;
+begin
+ Find(Item, Result);
+ Insert(Result, Item);
+end;
+
+function TheSortVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H: Integer;
+begin
+ Assert(@Item = @Item); // hint off
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ if Item < FData[Index] then
+ H := Index - 1
+ else if Item = FData[Index] then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheSortVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheSortVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheSortVector.IndexOf(const Item: TItem): Integer;
+begin
+ if not Find(Item, Result) then
+ Result := -1;
+end;
+
+function TheSortVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheSortVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheSortVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheSortVector.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheSortVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheSortVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+{ TheCmpSortVector }
+
+procedure TheCmpSortVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+function TheCmpSortVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpSortVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpSortVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheCmpSortVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheCmpSortVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheCmpSortVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheCmpSortVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+destructor TheCmpSortVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpSortVector.Add(const Item: TItem): Integer;
+begin
+ Find(Item, Result);
+ Insert(Result, Item);
+end;
+
+function TheCmpSortVector.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpSortVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheCmpSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(Item, FData[Index]);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheCmpSortVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheCmpSortVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheCmpSortVector.IndexOf(const Item: TItem): Integer;
+begin
+ if not Find(Item, Result) then
+ Result := -1;
+end;
+
+function TheCmpSortVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheCmpSortVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheCmpSortVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheCmpSortVector.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheCmpSortVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheCmpSortVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+{ TheObjectSortVector }
+
+procedure TheObjectSortVector.Pack;
+begin
+ Capacity := Count;
+end;
+
+procedure TheObjectSortVector.Wipe;
+begin
+ FCount := 0;
+end;
+
+function TheObjectSortVector.GetItems(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectSortVector.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectSortVector.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheObjectSortVector.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheObjectSortVector.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheObjectSortVector.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheObjectSortVector.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+constructor TheObjectSortVector.Create(const AOwnObjects: Boolean);
+begin
+ inherited Create;
+ OwnObjects := AOwnObjects;
+end;
+
+destructor TheObjectSortVector.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectSortVector.Add(const Item: TItem): Integer;
+begin
+ Find(Item, Result);
+ Insert(Result, Item);
+end;
+
+function TheObjectSortVector.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheObjectSortVector.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheObjectSortVector.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(Item, FData[Index]);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheObjectSortVector.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheObjectSortVector.Has(const Item: TItem): Boolean;
+begin
+ Result := IndexOf(Item) >= 0;
+end;
+
+function TheObjectSortVector.IndexOf(const Item: TItem): Integer;
+begin
+ if not Find(Item, Result) then
+ Result := -1;
+end;
+
+function TheObjectSortVector.Push(const Item: TItem): TItem;
+begin
+ Add(Item);
+ Result := Item;
+end;
+
+function TheObjectSortVector.Remove(const Item: TItem): Integer;
+begin
+ if Find(Item, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheObjectSortVector.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheObjectSortVector.Clear;
+var I: Integer;
+begin
+ if OwnObjects then
+ for I := 0 to Count - 1 do
+ FData[I].Free;
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheObjectSortVector.Delete(const Index: Integer);
+begin
+ Extract(Index);
+end;
+
+procedure TheObjectSortVector.Kill;
+begin
+ OwnObjects := False;
+ Free;
+end;
+
+procedure TheObjectSortVector.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ FData[Index] := Item;
+end;
+
+{ TheVectorSet }
+
+function TheVectorSet.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H: Integer;
+begin
+ Assert(@Item = @Item); // hint off
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ if Item < FData[Index] then
+ H := Index - 1
+ else if Item = FData[Index] then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheVectorSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheVectorSet.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheVectorSet.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheVectorSet.GetMembership(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+end;
+
+function TheVectorSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+procedure TheVectorSet.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+function TheVectorSet.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheVectorSet.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheVectorSet.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+destructor TheVectorSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheVectorSet.Exclude(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+ if Result then
+ Extract(Index);
+end;
+
+function TheVectorSet.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheVectorSet.Include(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ if Find(Item, Index) then
+ Exit(True);
+ Insert(Index, Item);
+ Result := False;
+end;
+
+function TheVectorSet.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheVectorSet.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheVectorSet.Pack;
+begin
+ Capacity := Count;
+end;
+
+{ TheCmpVectorSet }
+
+function TheCmpVectorSet.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheCmpVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(Item, FData[Index]);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheCmpVectorSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheCmpVectorSet.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpVectorSet.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpVectorSet.GetMembership(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+end;
+
+function TheCmpVectorSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+procedure TheCmpVectorSet.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+function TheCmpVectorSet.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheCmpVectorSet.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheCmpVectorSet.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheCmpVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+destructor TheCmpVectorSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpVectorSet.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpVectorSet.Exclude(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+ if Result then
+ Extract(Index);
+end;
+
+function TheCmpVectorSet.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheCmpVectorSet.Include(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ if Find(Item, Index) then
+ Exit(True);
+ Insert(Index, Item);
+ Result := False;
+end;
+
+function TheCmpVectorSet.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheCmpVectorSet.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheCmpVectorSet.Pack;
+begin
+ Capacity := Count;
+end;
+
+{ TheObjectVectorSet }
+
+function TheObjectVectorSet.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheObjectVectorSet.Find(const Item: TItem; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(Item, FData[Index]);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheObjectVectorSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheObjectVectorSet.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectVectorSet.GetCurrent(var Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectVectorSet.GetMembership(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+end;
+
+function TheObjectVectorSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+procedure TheObjectVectorSet.Insert(const Index: Integer; const Item: TItem);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index] := Item;
+end;
+
+function TheObjectVectorSet.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheObjectVectorSet.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheObjectVectorSet.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheObjectVectorSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+constructor TheObjectVectorSet.Create(const AOwnObjects: Boolean);
+begin
+ inherited Create;
+ FOwnObjects := AOwnObjects;
+end;
+
+destructor TheObjectVectorSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectVectorSet.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheObjectVectorSet.Exclude(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ Result := Find(Item, Index);
+ if Result then
+ Extract(Index);
+end;
+
+function TheObjectVectorSet.GetEnumerator: TEnumerator;
+begin
+ Result.Init(-1, @MoveNext, @GetCurrent);
+end;
+
+function TheObjectVectorSet.Include(const Item: TItem): Boolean;
+var Index: Integer;
+begin
+ if Find(Item, Index) then
+ Exit(True);
+ Insert(Index, Item);
+ Result := False;
+end;
+
+function TheObjectVectorSet.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrent);
+end;
+
+procedure TheObjectVectorSet.Clear;
+var I: Integer;
+begin
+ if OwnObjects then
+ for I := 0 to Count - 1 do
+ FData[I].Free;
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheObjectVectorSet.Kill;
+begin
+ OwnObjects := False;
+ Free;
+end;
+
+procedure TheObjectVectorSet.Pack;
+begin
+ Capacity := Count;
+end;
+
+procedure TheObjectVectorSet.Wipe;
+begin
+ FCount := 0;
+end;
+
+{ TheVectorMap }
+
+function TheVectorMap.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
+var L, H: Integer;
+begin
+ Assert(@AKey = @AKey); // hint off
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ if AKey < FData[Index].Key then
+ H := Index - 1
+ else if AKey = FData[Index].Key then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheVectorMap.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheVectorMap.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheVectorMap.GetMap(const AKey: TKey): TValue;
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ Exit(FData[Index].Value);
+ Result := MissingKeyValue(AKey);
+end;
+
+function TheVectorMap.GetKey(const Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheVectorMap.GetCurrentKey(var Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheVectorMap.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheVectorMap.GetValue(const Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+function TheVectorMap.GetCurrentValue(var Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+procedure TheVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index].Key := AKey;
+ FData[Index].Value := AValue;
+end;
+
+function TheVectorMap.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheVectorMap.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheVectorMap.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ FData[Index].Value := AValue
+ else
+ Insert(Index, AKey, AValue);
+end;
+
+function TheVectorMap.MissingKeyValue(const AKey: TKey): TValue;
+begin
+ Assert(@AKey = @AKey); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+destructor TheVectorMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheVectorMap.Has(const AKey: TKey): Boolean;
+var Index: Integer;
+begin
+ Result := Find(AKey, Index);
+end;
+
+function TheVectorMap.IndexOf(const AKey: TKey): Integer;
+begin
+ if not Find(AKey, Result) then
+ Result := -1;
+end;
+
+function TheVectorMap.Keys: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
+end;
+
+function TheVectorMap.KeysReversed: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
+end;
+
+function TheVectorMap.Remove(const AKey: TKey): Integer;
+begin
+ if Find(AKey, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheVectorMap.Values: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
+end;
+
+function TheVectorMap.ValuesReversed: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
+end;
+
+procedure TheVectorMap.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheVectorMap.Delete(const Index: Integer);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Extract(Index);
+end;
+
+procedure TheVectorMap.Pack;
+begin
+ Capacity := Count;
+end;
+
+{ TheCmpVectorMap }
+
+function TheCmpVectorMap.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index]);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheCmpVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(AKey, FData[Index].Key);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheCmpVectorMap.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheCmpVectorMap.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheCmpVectorMap.GetMap(const AKey: TKey): TValue;
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ Exit(FData[Index].Value);
+ Result := MissingKeyValue(AKey);
+end;
+
+function TheCmpVectorMap.GetKey(const Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheCmpVectorMap.GetCurrentKey(var Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheCmpVectorMap.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheCmpVectorMap.GetValue(const Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+function TheCmpVectorMap.GetCurrentValue(var Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+procedure TheCmpVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index]);
+ FData[Index].Key := AKey;
+ FData[Index].Value := AValue;
+end;
+
+function TheCmpVectorMap.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheCmpVectorMap.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheCmpVectorMap.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheCmpVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ FData[Index].Value := AValue
+ else
+ Insert(Index, AKey, AValue);
+end;
+
+function TheCmpVectorMap.MissingKeyValue(const AKey: TKey): TValue;
+begin
+ Assert(@AKey = @AKey); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+destructor TheCmpVectorMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpVectorMap.Compare(const A, B: TKey): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpVectorMap.Has(const AKey: TKey): Boolean;
+var Index: Integer;
+begin
+ Result := Find(AKey, Index);
+end;
+
+function TheCmpVectorMap.IndexOf(const AKey: TKey): Integer;
+begin
+ if not Find(AKey, Result) then
+ Result := -1;
+end;
+
+function TheCmpVectorMap.Keys: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
+end;
+
+function TheCmpVectorMap.KeysReversed: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
+end;
+
+function TheCmpVectorMap.Remove(const AKey: TKey): Integer;
+begin
+ if Find(AKey, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheCmpVectorMap.Values: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
+end;
+
+function TheCmpVectorMap.ValuesReversed: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
+end;
+
+procedure TheCmpVectorMap.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Finalize(FData[I]);
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheCmpVectorMap.Delete(const Index: Integer);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Extract(Index);
+end;
+
+procedure TheCmpVectorMap.Pack;
+begin
+ Capacity := Count;
+end;
+
+{ TheObjectVectorMap }
+
+function TheObjectVectorMap.Extract(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+ Dec(FCount);
+ Finalize(FData[Index].Key);
+ Move(FData[Index + 1], FData[Index], (Count - Index) * SizeOf(TItem));
+end;
+
+function TheObjectVectorMap.Find(const AKey: TKey; out Index: Integer): Boolean;
+var L, H, Cmp: Integer;
+begin
+ L := 0;
+ H := Count - 1;
+ while L <= H do begin
+ Index := (L + H) shr 1;
+ Cmp := Compare(AKey, FData[Index].Key);
+ if Cmp < 0 then
+ H := Index - 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ L := Index + 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheObjectVectorMap.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[0];
+end;
+
+function TheObjectVectorMap.GetItem(const Index: Integer): TItem;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index];
+end;
+
+function TheObjectVectorMap.GetMap(const AKey: TKey): TValue;
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ Exit(FData[Index].Value);
+ Result := MissingKeyValue(AKey);
+end;
+
+function TheObjectVectorMap.GetKey(const Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheObjectVectorMap.GetCurrentKey(var Index: Integer): TKey;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Key;
+end;
+
+function TheObjectVectorMap.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := FData[Count - 1];
+end;
+
+function TheObjectVectorMap.GetValue(const Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+function TheObjectVectorMap.GetCurrentValue(var Index: Integer): TValue;
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Result := FData[Index].Value;
+end;
+
+procedure TheObjectVectorMap.Insert(const Index: Integer; const AKey: TKey; const AValue: TValue);
+begin
+ Assert((Index >= 0) and (Index <= Count));
+ if Count = Capacity then
+ Capacity := 2 * (Count + 1);
+ Move(FData[Index], FData[Index + 1], (Count - Index) * SizeOf(TItem));
+ Inc(FCount);
+ Initialize(FData[Index].Key);
+ FData[Index].Key := AKey;
+ FData[Index].Value := AValue;
+end;
+
+function TheObjectVectorMap.MoveNext(var Index: Integer): Boolean;
+begin
+ Inc(Index);
+ Result := Index < Count;
+end;
+
+function TheObjectVectorMap.MovePrev(var Index: Integer): Boolean;
+begin
+ Dec(Index);
+ Result := Index >= 0;
+end;
+
+procedure TheObjectVectorMap.SetCapacity(AValue: Integer);
+begin
+ Assert(AValue >= 0);
+ if AValue = Capacity then
+ Exit;
+ if AValue < Count then
+ AValue := Count;
+ ReAllocMem(FData, AValue * SizeOf(FData[0]));
+ FCapacity := AValue;
+end;
+
+procedure TheObjectVectorMap.SetMap(const AKey: TKey; const AValue: TValue);
+var Index: Integer;
+begin
+ if Find(AKey, Index) then
+ FData[Index].Value := AValue
+ else
+ Insert(Index, AKey, AValue);
+end;
+
+function TheObjectVectorMap.MissingKeyValue(const AKey: TKey): TValue;
+begin
+ Assert(@AKey = @AKey); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+constructor TheObjectVectorMap.Create(const AOwnObjects: Boolean);
+begin
+ inherited Create;
+ FOwnObjects := AOwnObjects;
+end;
+
+destructor TheObjectVectorMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectVectorMap.Compare(const A, B: TKey): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheObjectVectorMap.Has(const AKey: TKey): Boolean;
+var Index: Integer;
+begin
+ Result := Find(AKey, Index);
+end;
+
+function TheObjectVectorMap.IndexOf(const AKey: TKey): Integer;
+begin
+ if not Find(AKey, Result) then
+ Result := -1;
+end;
+
+function TheObjectVectorMap.Keys: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentKey);
+end;
+
+function TheObjectVectorMap.KeysReversed: TKeyEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentKey);
+end;
+
+function TheObjectVectorMap.Remove(const AKey: TKey): Integer;
+begin
+ if Find(AKey, Result) then
+ Delete(Result)
+ else
+ Result := -1;
+end;
+
+function TheObjectVectorMap.Values: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(-1, @MoveNext, @GetCurrentValue);
+end;
+
+function TheObjectVectorMap.ValuesReversed: TValueEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(Count, @MovePrev, @GetCurrentValue);
+end;
+
+procedure TheObjectVectorMap.Clear;
+var I: Integer;
+begin
+ for I := 0 to Count - 1 do begin
+ Finalize(FData[I].Key);
+ if OwnObjects then
+ FData[I].Value.Free;
+ end;
+ FCount := 0;
+ Capacity := 0;
+end;
+
+procedure TheObjectVectorMap.Delete(const Index: Integer);
+begin
+ Assert((Index >= 0) and (Index < Count));
+ Extract(Index);
+end;
+
+procedure TheObjectVectorMap.Pack;
+begin
+ Capacity := Count;
+end;
+
+{ TheList }
+
+destructor TheList.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheList.InsertAfter(const After: PNode; const AItem: TItem): PNode;
+begin
+ Result := InsertAfter_(After, NewNode(AItem));
+end;
+
+function TheList.InsertAfter_(const After, Node: PNode): PNode;
+var
+ Node_: PNode_ absolute Node;
+ After_: PNode_ absolute After;
+begin
+ if After^.Next = nil then
+ FLast := Node
+ else
+ After_^.FNext^.FPrev := Node_;
+ Node_^.FNext := After_^.FNext;
+ After_^.FNext := Node_;
+ Node_^.FPrev := After_;
+ Inc(FCount);
+ Result := Node;
+end;
+
+function TheList.InsertBack(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if Last = nil then begin
+ FFirst := Node;
+ FLast := Node;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ FCount := 1;
+ Exit(Node);
+ end;
+ Result := InsertAfter_(Last, Node);
+end;
+
+function TheList.InsertBefore(const AItem: TItem; const Before: PNode): PNode;
+begin
+ Result := InsertBefore_(NewNode(AItem), Before);
+end;
+
+function TheList.InsertBefore_(const Node, Before: PNode): PNode;
+var
+ Node_: PNode_ absolute Node;
+ Before_: PNode_ absolute Before;
+begin
+ if Before_^.FPrev = nil then
+ FFirst := Node
+ else
+ Before_^.FPrev^.FNext := Node_;
+ Node_^.FPrev := Before_^.FPrev;
+ Before_^.FPrev := Node_;
+ Node_^.FNext := Before_;
+ Inc(FCount);
+ Result := Node;
+end;
+
+function TheList.InsertFront(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if First = nil then begin
+ FFirst := Node;
+ FLast := Node;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ FCount := 1;
+ Exit(Node);
+ end;
+ Result := InsertBefore_(Node, First);
+end;
+
+function TheList.MoveToBack(const Node: PNode): PNode;
+begin
+ Result := InsertBack(Extract(Node));
+end;
+
+function TheList.MoveToFront(const Node: PNode): PNode;
+begin
+ Result := InsertFront(Extract(Node));
+end;
+
+function TheList.NewNode(const AItem: TItem): PNode;
+var Node_: PNode_ absolute Result;
+begin
+ New(Result);
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ Result^.Item := AItem;
+end;
+
+function TheList.PushBack(const AItem: TItem): PNode;
+begin
+ Result := InsertBack(NewNode(AItem));
+end;
+
+function TheList.PushFront(const AItem: TItem): PNode;
+begin
+ Result := InsertFront(NewNode(AItem));
+end;
+
+function TheList.Extract(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if Node^.Prev = nil then
+ FFirst := Node^.Next
+ else
+ Node_^.FPrev^.FNext := Node_^.FNext;
+ if Node^.Next = nil then
+ FLast := Node^.Prev
+ else
+ Node_^.FNext^.FPrev := Node_^.FPrev;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ Dec(FCount);
+ Result := Node;
+end;
+
+function TheList.NewIterator: TIterator;
+begin
+ Result.List := Self;
+ Result.Node := nil;
+end;
+
+function TheList.GetEnumerator: TEnumerator;
+begin
+ Result.Init(NewIterator, @MoveNext, @CurrentItem);
+end;
+
+function TheList.CurrentItem(var Iterator: TIterator): TItem;
+begin
+ Result := Iterator.Node^.Item;
+end;
+
+function TheList.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ if Iterator.Node <> nil then begin
+ Iterator.Node := Iterator.Node^.Next;
+ if Iterator.Node <> nil then
+ Exit(True);
+ Iterator.List := nil;
+ Exit(False);
+ end;
+ if Iterator.List <> nil then
+ Iterator.Node := PNode(TheList(Iterator.List).First);
+ Result := Iterator.Node <> nil;
+end;
+
+function TheList.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ if Iterator.Node <> nil then begin
+ Iterator.Node := Iterator.Node^.Prev;
+ if Iterator.Node <> nil then
+ Exit(True);
+ Iterator.List := nil;
+ Exit(False);
+ end;
+ if Iterator.List <> nil then
+ Iterator.Node := PNode(TheList(Iterator.List).Last);
+ Result := Iterator.Node <> nil;
+end;
+
+function TheList.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem);
+end;
+
+function TheList.MoveAfter(const After, Node: PNode): PNode;
+begin
+ Assert(After <> Node);
+ Result := InsertAfter_(After, Extract(Node));
+end;
+
+function TheList.MoveBefore(const Node, Before: PNode): PNode;
+begin
+ Assert(Node <> Before);
+ Result := InsertBefore_(Extract(Node), Before);
+end;
+
+procedure TheList.Remove(Node: PNode);
+begin
+ Extract(Node);
+ Dispose(Node);
+end;
+
+procedure TheList.Clear;
+var Node, Next: PNode;
+begin
+ Node := First;
+ while Node <> nil do begin
+ Next := Node^.Next;
+ Dispose(Node);
+ Node := Next;
+ end;
+ FFirst := nil;
+ FLast := nil;
+ FCount := 0;
+end;
+
+{ TheObjectList }
+
+destructor TheObjectList.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectList.InsertAfter(const After: PNode; const AItem: TItem): PNode;
+begin
+ Result := InsertAfter_(After, NewNode(AItem));
+end;
+
+function TheObjectList.InsertAfter_(const After, Node: PNode): PNode;
+var
+ Node_: PNode_ absolute Node;
+ After_: PNode_ absolute After;
+begin
+ if After^.Next = nil then
+ FLast := Node
+ else
+ After_^.FNext^.FPrev := Node_;
+ Node_^.FNext := After_^.FNext;
+ After_^.FNext := Node_;
+ Node_^.FPrev := After_;
+ Inc(FCount);
+ Result := Node;
+end;
+
+function TheObjectList.InsertBack(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if Last = nil then begin
+ FFirst := Node;
+ FLast := Node;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ FCount := 1;
+ Exit(Node);
+ end;
+ Result := InsertAfter_(Last, Node);
+end;
+
+function TheObjectList.InsertBefore(const AItem: TItem; const Before: PNode): PNode;
+begin
+ Result := InsertBefore_(NewNode(AItem), Before);
+end;
+
+function TheObjectList.InsertBefore_(const Node, Before: PNode): PNode;
+var
+ Node_: PNode_ absolute Node;
+ Before_: PNode_ absolute Before;
+begin
+ if Before_^.FPrev = nil then
+ FFirst := Node
+ else
+ Before_^.FPrev^.FNext := Node_;
+ Node_^.FPrev := Before_^.FPrev;
+ Before_^.FPrev := Node_;
+ Node_^.FNext := Before_;
+ Inc(FCount);
+ Result := Node;
+end;
+
+function TheObjectList.InsertFront(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if First = nil then begin
+ FFirst := Node;
+ FLast := Node;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ FCount := 1;
+ Exit(Node);
+ end;
+ Result := InsertBefore_(Node, First);
+end;
+
+function TheObjectList.MoveToBack(const Node: PNode): PNode;
+begin
+ Result := InsertBack(Extract(Node));
+end;
+
+function TheObjectList.MoveToFront(const Node: PNode): PNode;
+begin
+ Result := InsertFront(Extract(Node));
+end;
+
+function TheObjectList.NewNode(const AItem: TItem): PNode;
+var Node_: PNode_ absolute Result;
+begin
+ New(Result);
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ Result^.Item := AItem;
+end;
+
+function TheObjectList.PushBack(const AItem: TItem): PNode;
+begin
+ Result := InsertBack(NewNode(AItem));
+end;
+
+function TheObjectList.PushFront(const AItem: TItem): PNode;
+begin
+ Result := InsertFront(NewNode(AItem));
+end;
+
+function TheObjectList.Extract(const Node: PNode): PNode;
+var Node_: PNode_ absolute Node;
+begin
+ if Node^.Prev = nil then
+ FFirst := Node^.Next
+ else
+ Node_^.FPrev^.FNext := Node_^.FNext;
+ if Node^.Next = nil then
+ FLast := Node^.Prev
+ else
+ Node_^.FNext^.FPrev := Node_^.FPrev;
+ Node_^.FPrev := nil;
+ Node_^.FNext := nil;
+ Dec(FCount);
+ Result := Node;
+end;
+
+function TheObjectList.NewIterator: TIterator;
+begin
+ Result.List := Self;
+ Result.Node := nil;
+end;
+
+function TheObjectList.GetEnumerator: TEnumerator;
+begin
+ Result.Init(NewIterator, @MoveNext, @CurrentItem);
+end;
+
+function TheObjectList.CurrentItem(var Iterator: TIterator): TItem;
+begin
+ Result := Iterator.Node^.Item;
+end;
+
+function TheObjectList.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ if Iterator.Node <> nil then begin
+ Iterator.Node := Iterator.Node^.Next;
+ if Iterator.Node <> nil then
+ Exit(True);
+ Iterator.List := nil;
+ Exit(False);
+ end;
+ if Iterator.List <> nil then
+ Iterator.Node := PNode(TheObjectList(Iterator.List).First);
+ Result := Iterator.Node <> nil;
+end;
+
+function TheObjectList.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ if Iterator.Node <> nil then begin
+ Iterator.Node := Iterator.Node^.Prev;
+ if Iterator.Node <> nil then
+ Exit(True);
+ Iterator.List := nil;
+ Exit(False);
+ end;
+ if Iterator.List <> nil then
+ Iterator.Node := PNode(TheObjectList(Iterator.List).Last);
+ Result := Iterator.Node <> nil;
+end;
+
+function TheObjectList.Reversed: TEnumeratorProvider;
+begin
+ Result.FEnumerator.Init(NewIterator, @MovePrev, @CurrentItem);
+end;
+
+function TheObjectList.MoveAfter(const After, Node: PNode): PNode;
+begin
+ Assert(After <> Node);
+ Result := InsertAfter_(After, Extract(Node));
+end;
+
+function TheObjectList.MoveBefore(const Node, Before: PNode): PNode;
+begin
+ Assert(Node <> Before);
+ Result := InsertBefore_(Extract(Node), Before);
+end;
+
+procedure TheObjectList.Remove(Node: PNode);
+begin
+ Extract(Node);
+ if OwnObjects then
+ Node^.Item.Free;
+ Dispose(Node);
+end;
+
+constructor TheObjectList.Create(const AOwnObjects: Boolean);
+begin
+ inherited Create;
+ FOwnObjects := AOwnObjects;
+end;
+
+procedure TheObjectList.Clear;
+var Node, Next: PNode;
+begin
+ Node := First;
+ while Node <> nil do begin
+ if OwnObjects then
+ Node^.Item.Free;
+ Next := Node^.Next;
+ Dispose(Node);
+ Node := Next;
+ end;
+ FFirst := nil;
+ FLast := nil;
+ FCount := 0;
+end;
+
+// BTrees section, keep last ===================================================
+
+{$R- do not remove, required for BTrees implementation}
+
+{ TheBTreeSet }
+
+procedure TheBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheBTreeSet.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheBTreeSet.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else
+ for I := 0 to P^.Count - 1 do
+ Finalize(PData(P)^.Data[I]);
+ FreeMem(P);
+end;
+
+procedure TheBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheBTreeSet.Create(const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+destructor TheBTreeSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheBTreeSet.Exclude(const Item: TItem): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Item, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheBTreeSet.GetEnumerator: TEnumerator;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheBTreeSet.Include(const Item: TItem): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ if Find(P, Item, Index) then // Key found
+ Exit(True);
+
+ if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Item)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Item);
+ Exit(False);
+ end;
+ until False
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Item);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheBTreeSet.Reversed: TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
+begin
+ Result := PData(P)^.Data[Index];
+ Finalize(PData(P)^.Data[Index]);
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+type PItem = ^TItem;
+var
+ L, H: Integer;
+ MidItem: PItem;
+ Mid: Integer absolute Index;
+begin
+ Assert(@Item = @Item); // hint off
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
+ else
+ MidItem := @PData(P)^.Data[Mid];
+ if Item > MidItem^ then
+ L := Mid + 1
+ else if Item = MidItem^ then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheBTreeSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0];
+end;
+
+function TheBTreeSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1];
+end;
+
+function TheBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index];
+end;
+
+function TheBTreeSet.GetMembership(const Item: TItem): Boolean;
+var
+ P: PData;
+ Index: Integer;
+begin
+ Result := Seek(Item, P, Index);
+end;
+
+function TheBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if RangeFrom <= RangeTo then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+begin
+ Result := Insert(P, Index);
+ Initialize(PData(P)^.Data[Index]);
+ PData(P)^.Data[Index] := Item;
+ Inc(FCount);
+end;
+
+function TheBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] <= Iterator.Sentinel));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index] >= Iterator.Sentinel));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Item);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Item)
+ end else
+ InsertItem(Right, 0, Item);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Item);
+end;
+
+procedure TheBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+function TheBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Item, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+procedure TheBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Item)
+ else
+ InsertItem(P, Index, Item);
+end;
+
+procedure TheBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+{ TheBTreeMap }
+
+procedure TheBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheBTreeMap.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheBTreeMap.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else
+ for I := 0 to P^.Count - 1 do
+ Finalize(PData(P)^.Data[I]);
+ FreeMem(P);
+end;
+
+procedure TheBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheBTreeMap.Create(const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+function TheBTreeMap.Delete(const Key: TKey): Boolean;
+var Dummy: TValue;
+begin
+ Result := Extract(Key, Dummy);
+end;
+
+destructor TheBTreeMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
+begin
+ Result := PData(P)^.Data[Index].Value;
+ Finalize(PData(P)^.Data[Index]);
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ Value := ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ Value := ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+type PKey = ^TKey;
+var
+ L, H: Integer;
+ MidKey: PKey;
+ Mid: Integer absolute Index;
+begin
+ Assert(@Key = @Key); // hint offf
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
+ else
+ MidKey := @PData(P)^.Data[Mid].Key;
+ if Key > MidKey^ then
+ L := Mid + 1
+ else if Key = MidKey^ then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Value;
+end;
+
+function TheBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Key;
+end;
+
+function TheBTreeMap.GetFirst: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Value;
+end;
+
+function TheBTreeMap.GetFirstKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Key;
+end;
+
+function TheBTreeMap.GetLast: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
+end;
+
+function TheBTreeMap.GetLastKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
+end;
+
+function TheBTreeMap.GetMap(const Key: TKey): TValue;
+begin
+ if not Get(Key, Result) then
+ Result := MissingKeyValue(Key);
+end;
+
+function TheBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if RangeFrom <= RangeTo then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if RangeFrom <= RangeTo then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
+var
+ P: PPage;
+ Index: Integer;
+begin
+ Result := False;
+ P := Root;
+ if P <> nil then // tree is non empty
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
+ else
+ Value := PData(P)^.Data[Index].Value
+ else if P^.IsIndex then
+ P := PIndex(P)^.Index[Index].Child
+ else
+ break; // give up
+ until Result;
+end;
+
+function TheBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+begin
+ Result := Insert(P, Index);
+ Initialize(PData(P)^.Data[Index]);
+ PData(P)^.Data[Index].Key := Key;
+ PData(P)^.Data[Index].Value := Value;
+ Inc(FCount);
+end;
+
+procedure TheBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+function TheBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key <= Iterator.Sentinel));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Iterator.Page^.Data[Iterator.Index].Key >= Iterator.Sentinel));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Key, Value);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Key, Value)
+ end else
+ InsertItem(Right, 0, Key, Value);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Key, Value);
+end;
+
+procedure TheBTreeMap.SetMap(const Key: TKey; const Value: TValue);
+begin
+ Put(Key, Value);
+end;
+
+function TheBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Key, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+function TheBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
+var Dummy: TValue;
+begin
+ Result := Put(Key, Value, Dummy, CanOverwrite);
+end;
+
+function TheBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
+ else
+ Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
+ else if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Key, Value)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Key, Value);
+ break;
+ end;
+ until Result
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Key, Value);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheBTreeMap.Keys: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+end;
+
+function TheBTreeMap.KeysReversed: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheBTreeMap.Values: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheBTreeMap.ValuesReversed: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+procedure TheBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Key, Value)
+ else
+ InsertItem(P, Index, Key, Value);
+end;
+
+procedure TheBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+begin
+ Prev := Dest;
+ if CanOverwrite then
+ Dest := Value;
+end;
+
+procedure TheBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+function TheBTreeMap.MissingKeyValue(const Key: TKey): TValue;
+begin
+ Assert(@Key = @Key); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+{ TheCmpBTreeSet }
+
+procedure TheCmpBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheCmpBTreeSet.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheCmpBTreeSet.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else
+ for I := 0 to P^.Count - 1 do
+ Finalize(PData(P)^.Data[I]);
+ FreeMem(P);
+end;
+
+procedure TheCmpBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheCmpBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheCmpBTreeSet.Create(const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+destructor TheCmpBTreeSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpBTreeSet.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpBTreeSet.Exclude(const Item: TItem): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Item, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheCmpBTreeSet.GetEnumerator: TEnumerator;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheCmpBTreeSet.Include(const Item: TItem): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ if Find(P, Item, Index) then // Key found
+ Exit(True);
+
+ if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Item)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Item);
+ Exit(False);
+ end;
+ until False
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Item);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheCmpBTreeSet.Reversed: TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheCmpBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
+begin
+ Result := PData(P)^.Data[Index];
+ Finalize(PData(P)^.Data[Index]);
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheCmpBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheCmpBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+type PItem = ^TItem;
+var
+ L, H, Cmp: Integer;
+ MidItem: PItem;
+ Mid: Integer absolute Index;
+begin
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
+ else
+ MidItem := @PData(P)^.Data[Mid];
+ Cmp := Compare(Item, MidItem^);
+ if Cmp > 0 then
+ L := Mid + 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheCmpBTreeSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0];
+end;
+
+function TheCmpBTreeSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1];
+end;
+
+function TheCmpBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index];
+end;
+
+function TheCmpBTreeSet.GetMembership(const Item: TItem): Boolean;
+var
+ P: PData;
+ Index: Integer;
+begin
+ Result := Seek(Item, P, Index);
+end;
+
+function TheCmpBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheCmpBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheCmpBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+begin
+ Result := Insert(P, Index);
+ Initialize(PData(P)^.Data[Index]);
+ PData(P)^.Data[Index] := Item;
+ Inc(FCount);
+end;
+
+function TheCmpBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheCmpBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheCmpBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheCmpBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheCmpBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Item);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Item)
+ end else
+ InsertItem(Right, 0, Item);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Item);
+end;
+
+procedure TheCmpBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+function TheCmpBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheCmpBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Item, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+procedure TheCmpBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Item)
+ else
+ InsertItem(P, Index, Item);
+end;
+
+procedure TheCmpBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheCmpBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheCmpBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+{ TheObjectBTreeSet }
+
+procedure TheObjectBTreeSet.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheObjectBTreeSet.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheObjectBTreeSet.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else if OwnObjects then
+ for I := 0 to P^.Count - 1 do
+ PData(P)^.Data[I].Free;
+ FreeMem(P);
+end;
+
+procedure TheObjectBTreeSet.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheObjectBTreeSet.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheObjectBTreeSet.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FOwnObjects := AOwnObjects;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+destructor TheObjectBTreeSet.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectBTreeSet.Compare(const A, B: TItem): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheObjectBTreeSet.Exclude(const Item: TItem): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Item, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheObjectBTreeSet.GetEnumerator: TEnumerator;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheObjectBTreeSet.Include(const Item: TItem): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ if Find(P, Item, Index) then // Key found
+ Exit(True);
+
+ if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Item)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Item);
+ Exit(False);
+ end;
+ until False
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Item);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheObjectBTreeSet.Reversed: TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheObjectBTreeSet.ExtractData(const P: PPage; const Index: Integer): TItem;
+begin
+ Result := PData(P)^.Data[Index];
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheObjectBTreeSet.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheObjectBTreeSet.Find(const P: PPage; const Item: TItem; out Index: Integer): Boolean;
+type PItem = ^TItem;
+var
+ L, H, Cmp: Integer;
+ MidItem: PItem;
+ Mid: Integer absolute Index;
+begin
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidItem := @PIndex(P)^.Index[Mid].DataPage^.Data[0]
+ else
+ MidItem := @PData(P)^.Data[Mid];
+ Cmp := Compare(Item, MidItem^);
+ if Cmp > 0 then
+ L := Mid + 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheObjectBTreeSet.GetFirst: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0];
+end;
+
+function TheObjectBTreeSet.GetLast: TItem;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1];
+end;
+
+function TheObjectBTreeSet.GetCurrent(var Iterator: TIterator): TItem;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index];
+end;
+
+function TheObjectBTreeSet.GetMembership(const Item: TItem): Boolean;
+var
+ P: PData;
+ Index: Integer;
+begin
+ Result := Seek(Item, P, Index);
+end;
+
+function TheObjectBTreeSet.GetRange(const RangeFrom, RangeTo: TItem): TEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheObjectBTreeSet.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheObjectBTreeSet.InsertItem(const P: PPage; const Index: Integer; const Item: TItem): PPage;
+begin
+ Result := Insert(P, Index);
+ PData(P)^.Data[Index] := Item;
+ Inc(FCount);
+end;
+
+function TheObjectBTreeSet.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) <= 0));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheObjectBTreeSet.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index], Iterator.Sentinel) >= 0));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheObjectBTreeSet.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheObjectBTreeSet.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheObjectBTreeSet.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Item);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Item)
+ end else
+ InsertItem(Right, 0, Item);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Item);
+end;
+
+procedure TheObjectBTreeSet.SetMembership(const Item: TItem; const AValue: Boolean);
+begin
+ if AValue then
+ Include(Item)
+ else
+ Exclude(Item);
+end;
+
+function TheObjectBTreeSet.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheObjectBTreeSet.Seek(const Item: TItem; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Item, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+procedure TheObjectBTreeSet.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Item: TItem);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Item)
+ else
+ InsertItem(P, Index, Item);
+end;
+
+procedure TheObjectBTreeSet.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheObjectBTreeSet.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheObjectBTreeSet.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+{ TheCmpBTreeMap }
+
+procedure TheCmpBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheCmpBTreeMap.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheCmpBTreeMap.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else
+ for I := 0 to P^.Count - 1 do
+ Finalize(PData(P)^.Data[I]);
+ FreeMem(P);
+end;
+
+procedure TheCmpBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheCmpBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheCmpBTreeMap.Create(const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+function TheCmpBTreeMap.Delete(const Key: TKey): Boolean;
+var Dummy: TValue;
+begin
+ Result := Extract(Key, Dummy);
+end;
+
+destructor TheCmpBTreeMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheCmpBTreeMap.Compare(const A, B: TKey): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheCmpBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
+begin
+ Result := PData(P)^.Data[Index].Value;
+ Finalize(PData(P)^.Data[Index]);
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheCmpBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheCmpBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ Value := ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ Value := ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheCmpBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+type PKey = ^TKey;
+var
+ L, H, Cmp: Integer;
+ MidKey: PKey;
+ Mid: Integer absolute Index;
+begin
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
+ else
+ MidKey := @PData(P)^.Data[Mid].Key;
+ Cmp := Compare(Key, Midkey^);
+ if Cmp > 0 then
+ L := Mid + 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheCmpBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Value;
+end;
+
+function TheCmpBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Key;
+end;
+
+function TheCmpBTreeMap.GetFirst: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Value;
+end;
+
+function TheCmpBTreeMap.GetFirstKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Key;
+end;
+
+function TheCmpBTreeMap.GetLast: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
+end;
+
+function TheCmpBTreeMap.GetLastKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
+end;
+
+function TheCmpBTreeMap.GetMap(const Key: TKey): TValue;
+begin
+ if not Get(Key, Result) then
+ Result := MissingKeyValue(Key);
+end;
+
+function TheCmpBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheCmpBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheCmpBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
+var
+ P: PPage;
+ Index: Integer;
+begin
+ Result := False;
+ P := Root;
+ if P <> nil then // tree is non empty
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
+ else
+ Value := PData(P)^.Data[Index].Value
+ else if P^.IsIndex then
+ P := PIndex(P)^.Index[Index].Child
+ else
+ break; // give up
+ until Result;
+end;
+
+function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheCmpBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheCmpBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+begin
+ Result := Insert(P, Index);
+ Initialize(PData(P)^.Data[Index]);
+ PData(P)^.Data[Index].Key := Key;
+ PData(P)^.Data[Index].Value := Value;
+ Inc(FCount);
+end;
+
+procedure TheCmpBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+function TheCmpBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheCmpBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheCmpBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheCmpBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Key, Value);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Key, Value)
+ end else
+ InsertItem(Right, 0, Key, Value);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Key, Value);
+end;
+
+procedure TheCmpBTreeMap.SetMap(const Key: TKey; const Value: TValue);
+begin
+ Put(Key, Value);
+end;
+
+function TheCmpBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheCmpBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Key, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
+var Dummy: TValue;
+begin
+ Result := Put(Key, Value, Dummy, CanOverwrite);
+end;
+
+function TheCmpBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
+ else
+ Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
+ else if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Key, Value)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Key, Value);
+ break;
+ end;
+ until Result
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Key, Value);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheCmpBTreeMap.Keys: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+end;
+
+function TheCmpBTreeMap.KeysReversed: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheCmpBTreeMap.Values: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheCmpBTreeMap.ValuesReversed: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+procedure TheCmpBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Key, Value)
+ else
+ InsertItem(P, Index, Key, Value);
+end;
+
+procedure TheCmpBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheCmpBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+begin
+ Prev := Dest;
+ if CanOverwrite then
+ Dest := Value;
+end;
+
+procedure TheCmpBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheCmpBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+function TheCmpBTreeMap.MissingKeyValue(const Key: TKey): TValue;
+begin
+ Assert(@Key = @Key); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+{ TheObjectBTreeMap }
+
+procedure TheObjectBTreeMap.CheckSiblings(const Parent: PPage; const ParentIndex: Integer; out Left, Right: PPage);
+begin
+ Left := nil;
+ Right := nil;
+ if ParentIndex >= 0 then begin
+ if ParentIndex > 0 then
+ Left := PIndex(Parent)^.Index[ParentIndex - 1].Child;
+ if ParentIndex < Parent^.Count then
+ Right := PIndex(Parent)^.Index[ParentIndex + 1].Child;
+ end;
+end;
+
+procedure TheObjectBTreeMap.Clear;
+begin
+ if Root <> nil then begin
+ Clear(Root);
+ FCount := 0;
+ FFirst := nil;
+ FLast := nil;
+ FRoot := nil;
+ end;
+end;
+
+procedure TheObjectBTreeMap.Clear(const P: PPage);
+var I: Integer;
+begin
+ if P^.IsIndex then
+ for I := 0 to P^.Count do // Count=n Ch0 Med0 ... Chn-1 Medn-1 Chn
+ Clear(PIndex(P)^.Index[I].Child)
+ else begin
+ for I := 0 to P^.Count - 1 do
+ Finalize(PData(P)^.Data[I].Key);
+ if OwnObjects then
+ for I := 0 to P^.Count - 1 do
+ PData(P)^.Data[I].Value.Free;
+ end;
+ FreeMem(P);
+end;
+
+procedure TheObjectBTreeMap.Concat(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ MoveLeft(P, Right, Right^.Count);
+ if PData(Right)^.Next <> nil then
+ PData(Right)^.Next^.Prev := PData(P)
+ else
+ FLast := P;
+ PData(P)^.Next := PData(Right)^.Next;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ ExtractIndex(Parent, ParentIndex);
+ PIndex(Parent)^.Index[ParentIndex].Child := P;
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+procedure TheObjectBTreeMap.ConcatIndex(const Parent, P, Right: PPage; const ParentIndex: Integer);
+begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ Move(PIndex(Right)^.Index[0], PIndex(P)^.Index[P^.Count + 1], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ P^.Count += Right^.Count + 1;
+ FreeMem(Right);
+ if Parent^.Count > 1 then begin
+ Parent^.Count -= 1;
+ if ParentIndex < Parent^.Count then
+ Move(
+ PIndex(Parent)^.Index[ParentIndex + 1].DataPage,
+ PIndex(Parent)^.Index[ParentIndex].DataPage,
+ 2 * (Parent^.Count - ParentIndex) * SizeOf(Pointer)
+ );
+ end else begin
+ FreeMem(Root);
+ FRoot := P;
+ end;
+end;
+
+constructor TheObjectBTreeMap.Create(const AOwnObjects: Boolean; const AKIndex: Integer; const AKData: Integer);
+begin
+ inherited Create;
+ FOwnObjects := AOwnObjects;
+ FKIndex := Max(AKIndex, 2);
+ FKData := Max(AKData, 1);
+end;
+
+function TheObjectBTreeMap.Delete(const Key: TKey): Boolean;
+var Dummy: TValue;
+begin
+ Result := Extract(Key, Dummy);
+end;
+
+destructor TheObjectBTreeMap.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function TheObjectBTreeMap.Compare(const A, B: TKey): Integer;
+begin
+ Result := 0; // hint off
+ Assert(@A = @A); // hint off
+ Assert(@B = @B); // hint off
+ raise EAbstractError.Create(Format('%s.Compare', [ClassName]));
+end;
+
+function TheObjectBTreeMap.ExtractData(const P: PPage; const Index: Integer): TValue;
+begin
+ Result := PData(P)^.Data[Index].Value;
+ Finalize(PData(P)^.Data[Index].Key);
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PData(P)^.Data[Index + 1], PData(P)^.Data[Index], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ FCount -=1;
+end;
+
+procedure TheObjectBTreeMap.ExtractIndex(const P: PPage; const Index: Integer);
+begin
+ P^.Count -= 1;
+ if Index < P^.Count then
+ Move(PIndex(P)^.Index[Index + 1], PIndex(P)^.Index[Index], ((P^.Count - Index) * 2 + 1) * SizeOf(Pointer));
+end;
+
+function TheObjectBTreeMap.Extract(const Key: TKey; out Value: TValue): Boolean;
+var
+ Parent, P, DataPage: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then begin
+ DataPage := PPage(PIndex(P)^.Index[Index].DataPage);
+ if DataPage^.Count > KData then
+ Value := ExtractData(DataPage, 0)
+ else begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index + 1;
+ Parent := P;
+ P := PIndex(P)^.Index[ParentIndex].Child;
+ Result := False;
+ end;
+ end else begin
+ Value := ExtractData(P, Index);
+ if P^.Count < KData then
+ if P <> Root then
+ Underflow(Parent, P, ParentIndex)
+ else if Count = 0 then
+ Clear;
+ end
+ else if P^.IsIndex then begin
+ if (P^.Count < KIndex) and (P <> Root) then
+ Underflow(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child;
+ end else
+ break; // give up
+ until Result
+end;
+
+function TheObjectBTreeMap.Find(const P: PPage; const Key: TKey; out Index: Integer): Boolean;
+type PKey = ^TKey;
+var
+ L, H, Cmp: Integer;
+ MidKey: PKey;
+ Mid: Integer absolute Index;
+begin
+ L := 0;
+ H := P^.Count - 1;
+ while L <= H do begin
+ Mid := (L + H) shr 1;
+ if P^.IsIndex then
+ MidKey := @PIndex(P)^.Index[Mid].DataPage^.Data[0].Key
+ else
+ MidKey := @PData(P)^.Data[Mid].Key;
+ Cmp := Compare(Key, Midkey^);
+ if Cmp > 0 then
+ L := Mid + 1
+ else if Cmp = 0 then
+ Exit(True)
+ else
+ H := Mid - 1;
+ end;
+ Index := L;
+ Result := False;
+end;
+
+function TheObjectBTreeMap.GetCurrent(var Iterator: TIterator): TValue;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Value;
+end;
+
+function TheObjectBTreeMap.GetCurrentKey(var Iterator: TIterator): TKey;
+begin
+ Result := Iterator.Page^.Data[Iterator.Index].Key;
+end;
+
+function TheObjectBTreeMap.GetFirst: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Value;
+end;
+
+function TheObjectBTreeMap.GetFirstKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FFirst)^.Data[0].Key;
+end;
+
+function TheObjectBTreeMap.GetLast: TValue;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Value;
+end;
+
+function TheObjectBTreeMap.GetLastKey: TKey;
+begin
+ Assert(Count <> 0);
+ Result := PData(FLast)^.Data[FLast^.Count - 1].Key;
+end;
+
+function TheObjectBTreeMap.GetMap(const Key: TKey): TValue;
+begin
+ if not Get(Key, Result) then
+ Result := MissingKeyValue(Key);
+end;
+
+function TheObjectBTreeMap.GetRange(const RangeFrom, RangeTo: TKey): TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+function TheObjectBTreeMap.GetRangeKeys(const RangeFrom, RangeTo: TKey): TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.UseSentinel := True;
+ Iterator.Sentinel := RangeTo;
+
+ if Compare(RangeFrom, RangeTo) <= 0 then begin
+ Seek(RangeFrom, Iterator.Page, Iterator.Index);
+ Dec(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+ Exit;
+ end;
+
+ // RangeFrom > RangeTo
+ if Seek(RangeFrom, Iterator.Page, Iterator.Index) and (Iterator.Index < PPage(Iterator.Page)^.Count) then
+ Inc(Iterator.Index);
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheObjectBTreeMap.Get(const Key: TKey; out Value: TValue): Boolean;
+var
+ P: PPage;
+ Index: Integer;
+begin
+ Result := False;
+ P := Root;
+ if P <> nil then // tree is non empty
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Value := PIndex(P)^.Index[Index].DataPage^.Data[0].Value
+ else
+ Value := PData(P)^.Data[Index].Value
+ else if P^.IsIndex then
+ P := PIndex(P)^.Index[Index].Child
+ else
+ break; // give up
+ until Result;
+end;
+
+function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer): PPage;
+begin
+ if Index < P^.Count then
+ if P^.IsIndex then
+ Move(PIndex(P)^.Index[Index].DataPage, PIndex(P)^.Index[Index + 1].DataPage, (P^.Count - Index) * 2 * SizeOf(Pointer))
+ else
+ Move(PData(P)^.Data[Index], PData(P)^.Data[Index + 1], (P^.Count - Index) * SizeOf(PData(P)^.Data[0]));
+ Inc(P^.Count);
+ Result := P;
+end;
+
+function TheObjectBTreeMap.Insert(const P: PPage; const Index: Integer; const DataPage, Child: PPage): PPage;
+begin
+ Result := Insert(P, Index);
+ PIndex(Result)^.Index[Index].DataPage := PData(DataPage);
+ PIndex(Result)^.Index[Index + 1].Child := Child;
+end;
+
+function TheObjectBTreeMap.InsertItem(const P: PPage; const Index: Integer; const Key: TKey; const Value: TValue): PPage;
+begin
+ Result := Insert(P, Index);
+ Initialize(PData(P)^.Data[Index].Key);
+ PData(P)^.Data[Index].Key := Key;
+ PData(P)^.Data[Index].Value := Value;
+ Inc(FCount);
+end;
+
+procedure TheObjectBTreeMap.MoveLeft(const Left, P: PPage; const N: Integer);
+begin
+ Move(PData(P)^.Data[0], PData(Left)^.Data[Left^.Count], N * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[N], PData(P)^.Data[0], (P^.Count - N) * SizeOf(PData(P)^.Data[0]));
+ Left^.Count += N;
+ P^.Count -= N;
+end;
+
+function TheObjectBTreeMap.MoveNext(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Inc(Iterator.Index);
+ if Iterator.Index < PPage(Iterator.Page)^.Count then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) <= 0));
+ Iterator.Page := Iterator.Page^.Next;
+ Iterator.Index := -1;
+ end;
+ Result := False;
+end;
+
+function TheObjectBTreeMap.MovePrev(var Iterator: TIterator): Boolean;
+begin
+ while Iterator.Page <> nil do begin
+ Dec(Iterator.Index);
+ if Iterator.Index >= 0 then
+ Exit(not Iterator.UseSentinel or (Compare(Iterator.Page^.Data[Iterator.Index].Key, Iterator.Sentinel) >= 0));
+ Iterator.Page := Iterator.Page^.Prev;
+ if Iterator.Page <> nil then
+ Iterator.Index := PPage(Iterator.Page)^.Count;
+ end;
+ Result := False;
+end;
+
+procedure TheObjectBTreeMap.MoveRight(const P, Right: PPage; const N: Integer);
+begin
+ Move(PData(Right)^.Data[0], PData(Right)^.Data[N], Right^.Count * SizeOf(PData(P)^.Data[0]));
+ Move(PData(P)^.Data[P^.Count - N], PData(Right)^.Data[0], N * SizeOf(PData(P)^.Data[0]));
+ Right^.Count += N;
+ P^.Count -= N;
+end;
+
+procedure TheObjectBTreeMap.Overflow(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count < 2 * KData) then begin
+ MoveLeft(Left, P);
+ InsertItem(P, Index - 1, Key, Value);
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count < 2 * KData) then begin
+ if Index < 2 * KData then begin
+ MoveRight(P, Right);
+ InsertItem(P, Index, Key, Value)
+ end else
+ InsertItem(Right, 0, Key, Value);
+ Exit;
+ end;
+
+ SplitData(Parent, P, ParentIndex, Index, Key, Value);
+end;
+
+procedure TheObjectBTreeMap.SetMap(const Key: TKey; const Value: TValue);
+begin
+ Put(Key, Value);
+end;
+
+function TheObjectBTreeMap.Page(const IsIndex: Boolean; const LeftmostChild: PPage): PPage;
+begin
+ if IsIndex then begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + (4 * KIndex + 3) * SizeOf(Pointer));
+ PIndex(Result)^.Index[0].Child := LeftmostChild;
+ end else begin
+ GetMem(Result, SizeOf(TPage.Count) + SizeOf(TPage.IsIndex) + 2 * SizeOf(Pointer) + 2 * KData * SizeOf(TDataPage.Data[0]));
+ PData(Result)^.Prev := nil;
+ PData(Result)^.Next := nil;
+ end;
+ Result^.IsIndex := IsIndex;
+ Result^.Count := 0;
+end;
+
+function TheObjectBTreeMap.Seek(const Key: TKey; out P: PData; out Index: Integer): Boolean;
+begin
+ Result := False;
+ P := PData(Root);
+ if P <> nil then begin // tree is non empty
+ repeat
+ Result := Find(PPage(P), Key, Index);
+ if Result then begin // Key found
+ if PPage(P)^.IsIndex then begin
+ P := PIndex(P)^.Index[Index].DataPage;
+ Index := 0;
+ end;
+ end else if PPage(P)^.IsIndex then
+ P := PData(PIndex(P)^.Index[Index].Child)
+ else
+ break;
+ until Result;
+ end;
+end;
+
+function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; const CanOverwrite: Boolean): Boolean;
+var Dummy: TValue;
+begin
+ Result := Put(Key, Value, Dummy, CanOverwrite);
+end;
+
+function TheObjectBTreeMap.Put(const Key: TKey; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean): Boolean;
+var
+ P, Parent: PPage;
+ Index, ParentIndex: Integer;
+begin
+ Result := False;
+ ParentIndex := -1;
+ Parent := nil;
+ P := Root;
+ if P <> nil then
+ repeat
+ Result := Find(P, Key, Index);
+ if Result then // Key found
+ if P^.IsIndex then
+ Swap(PIndex(P)^.Index[Index].DataPage^.Data[0].Value, Value, Prev, CanOverwrite)
+ else
+ Swap(PData(P)^.Data[Index].Value, Value, Prev, CanOverwrite)
+ else if P^.IsIndex then begin
+ if P^.Count > 2 * KIndex then
+ SplitIndex(Parent, P, ParentIndex, Index);
+ ParentIndex := Index;
+ Parent := P;
+ P := PIndex(P)^.Index[Index].Child
+ end else begin
+ if P^.Count < 2 * KData then // page is not full
+ InsertItem(P, Index, Key, Value)
+ else // page is full
+ Overflow(Parent, P, ParentIndex, Index, Key, Value);
+ break;
+ end;
+ until Result
+ else begin // tree is empty
+ FRoot := InsertItem(Page(False), 0, Key, Value);
+ FFirst := Root;
+ FLast := Root;
+ end;
+end;
+
+function TheObjectBTreeMap.Keys: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrentKey);
+end;
+
+function TheObjectBTreeMap.KeysReversed: TKeyEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrentKey);
+end;
+
+function TheObjectBTreeMap.Values: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FFirst);
+ Iterator.Index := -1;
+ Iterator.UseSentinel := False;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MoveNext, @GetCurrent);
+end;
+
+function TheObjectBTreeMap.ValuesReversed: TValueEnumeratorProvider;
+var Iterator: TIterator;
+begin
+ Iterator.Page := PData(FLast);
+ Iterator.UseSentinel := False;
+ if FLast <> nil then
+ Iterator.Index := FLast^.Count;
+ Assert(Iterator.Page = Iterator.Page); // hint off
+ Result.FEnumerator.Init(Iterator, @MovePrev, @GetCurrent);
+end;
+
+procedure TheObjectBTreeMap.SplitData(const Parent, P: PPage; const ParentIndex, Index: Integer; const Key: TKey; const Value: TValue);
+var Right: PPage;
+begin
+ Right := Page(False);
+ if PData(P)^.Next <> nil then begin // P was not last
+ PData(Right)^.Next := PData(P)^.Next;
+ PData(Right)^.Next^.Prev := PData(Right);
+ end else // P was last
+ FLast := Right;
+ PData(P)^.Next := PData(Right);
+ PData(Right)^.Prev := PData(P);
+ Move(PData(P)^.Data[KData], PData(Right)^.Data[0], KData * SizeOf(PData(P)^.Data[0]));
+ P^.Count := KData;
+ Right^.Count := KData;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, Right, Right)
+ else
+ FRoot := Insert(Page(True, P), 0, Right, Right);
+ if Index > KData then
+ InsertItem(Right, Index - KData, Key, Value)
+ else
+ InsertItem(P, Index, Key, Value);
+end;
+
+procedure TheObjectBTreeMap.SplitIndex(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Right: PPage;
+begin
+ Right := Page(True);
+ Move(PIndex(P)^.Index[KIndex + 1], PIndex(Right)^.Index[0], (2 * KIndex + 1) * SizeOf(Pointer));
+ P^.Count := KIndex;
+ Right^.Count := KIndex;
+ if ParentIndex >= 0 then
+ Insert(Parent, ParentIndex, PPage(PIndex(P)^.Index[KIndex].DataPage), Right)
+ else
+ FRoot := Insert(Page(True, P), 0, PPage(PIndex(P)^.Index[KIndex].DataPage), Right);
+ if Index > KIndex then begin
+ P := Right;
+ Index -= KIndex + 1;
+ end;
+end;
+
+procedure TheObjectBTreeMap.Swap(var Dest: TValue; const Value: TValue; out Prev: TValue; const CanOverwrite: Boolean);
+begin
+ Prev := Dest;
+ if CanOverwrite then
+ Dest := Value;
+end;
+
+procedure TheObjectBTreeMap.Underflow(const Parent, P: PPage; const ParentIndex: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+ if (Left <> nil) and (Left^.Count + P^.Count >= 2 * KData) then
+ MoveRight(Left, P)
+ else if (Right <> nil) and (P^.Count + Right^.Count >= 2 * KData) then
+ MoveLeft(P, Right)
+ else if Left <> nil then
+ Concat(Parent, Left, P, ParentIndex - 1)
+ else
+ Concat(Parent, P, Right, ParentIndex);
+end;
+
+procedure TheObjectBTreeMap.Underflow(const Parent: PPage; var P: PPage; const ParentIndex: Integer; var Index: Integer);
+var Left, Right: PPage;
+begin
+ CheckSiblings(Parent, ParentIndex, Left, Right);
+
+ if (Left <> nil) and (Left^.Count > KIndex) then begin
+ Move(PIndex(P)^.Index[0], PIndex(P)^.Index[1], (2 * P^.Count + 1) * SizeOf(Pointer));
+ PIndex(P)^.Index[0].Child := PIndex(Left)^.Index[Left^.Count].Child;
+ PIndex(P)^.Index[0].DataPage := PIndex(Parent)^.Index[ParentIndex - 1].DataPage;
+ P^.Count += 1;
+ Index += 1;
+ Left^.Count -= 1;
+ PIndex(Parent)^.Index[ParentIndex - 1].DataPage := PIndex(Left)^.Index[Left^.Count].DataPage;
+ Exit;
+ end;
+
+ if (Right <> nil) and (Right^.Count > KIndex) then begin
+ PIndex(P)^.Index[P^.Count].DataPage := PIndex(Parent)^.Index[ParentIndex].DataPage;
+ P^.Count += 1;
+ PIndex(P)^.Index[P^.Count].Child := PIndex(Right)^.Index[0].Child;
+ PIndex(Parent)^.Index[ParentIndex].DataPage := PIndex(Right)^.Index[0].DataPage;
+ Move(PIndex(Right)^.Index[1], PIndex(Right)^.Index[0], (2 * Right^.Count + 1) * SizeOf(Pointer));
+ Right^.Count -= 1;
+ Exit;
+ end;
+
+ if Left <> nil then begin
+ Index += Left^.Count + 1;
+ ConcatIndex(Parent, Left, P, ParentIndex - 1);
+ P := Left;
+ Exit;
+ end;
+
+ ConcatIndex(Parent, P, Right, ParentIndex);
+end;
+
+function TheObjectBTreeMap.MissingKeyValue(const Key: TKey): TValue;
+begin
+ Assert(@Key = @Key); // hint off
+ Initialize(Result); // hint off
+ raise EMapKeyNotFound.Create(ClassName);
+end;
+
+end.
+