diff --git a/Client/ULightManager.pas b/Client/ULightManager.pas index 5a5d932..3b434e6 100644 --- a/Client/ULightManager.pas +++ b/Client/ULightManager.pas @@ -32,7 +32,7 @@ interface uses Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases, - ImagingOpenGL, GL, GLu, GLext, Math, heContnrs, ULandscape, UWorldItem, + ImagingOpenGL, GL, GLu, GLext, Math, fgl, ULandscape, UWorldItem, UCacheManager, DOM, XMLRead; const @@ -85,7 +85,7 @@ type property Material: TLightMaterial read FMaterial; end; - TLightSources = specialize TheObjectVector; + TLightSources = specialize TFPGObjectList; { TLightManager } diff --git a/UContnrExt.pas b/UContnrExt.pas deleted file mode 100644 index 7035866..0000000 --- a/UContnrExt.pas +++ /dev/null @@ -1,54 +0,0 @@ -(* - * 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 2b1a8dc..40d88a5 100644 --- a/UOLib/UMap.pas +++ b/UOLib/UMap.pas @@ -30,7 +30,7 @@ unit UMap; interface uses - SysUtils, Classes, heContnrs, UWorldItem; + SysUtils, Classes, fgl, UWorldItem; const MapCellSize = 3; @@ -60,7 +60,7 @@ type procedure Write(AData: TStream); override; end; - TMapCellList = specialize TheObjectVector; + TMapCellList = specialize TFPGObjectList; { TMapBlock } diff --git a/UOLib/UStatics.pas b/UOLib/UStatics.pas index ef6b94a..e39cd65 100644 --- a/UOLib/UStatics.pas +++ b/UOLib/UStatics.pas @@ -30,7 +30,7 @@ unit UStatics; interface uses - SysUtils, Classes, heContnrs, UGenericIndex, UWorldItem, UTiledata; + SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata; type { TStaticItem } @@ -56,7 +56,7 @@ type procedure Write(AData: TStream); override; end; - TStaticItemList = specialize TheObjectVector; + TStaticItemList = specialize TFPGObjectList; { TStaticBlock} diff --git a/UOLib/UWorldItem.pas b/UOLib/UWorldItem.pas index b56c89c..e03c5bc 100644 --- a/UOLib/UWorldItem.pas +++ b/UOLib/UWorldItem.pas @@ -30,7 +30,7 @@ unit UWorldItem; interface uses - Classes, heContnrs, UMulBlock; + Classes, fgl, UMulBlock; type TWorldBlock = class; @@ -81,7 +81,7 @@ type property RawZ: ShortInt read FZ; end; - TWorldItemList = specialize TheObjectVector; + TWorldItemList = specialize TFPGObjectList; { TWorldBlock } diff --git a/heContnrs.pas b/heContnrs.pas deleted file mode 100644 index b570d30..0000000 --- a/heContnrs.pas +++ /dev/null @@ -1,7370 +0,0 @@ -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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@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. -