{ *********************************************************************** }
{                                                                         }
{ Delphi Runtime Library                                                  }
{                                                                         }
{ Copyright (c) 1995-2001 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Contnrs;

interface

uses
  SysUtils, Classes;

type

{ TObjectList class }

  TObjectList = class(TList)
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    function GetItem(Index: Integer): TObject;
    procedure SetItem(Index: Integer; AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AOwnsObjects: Boolean); overload;

    function Add(AObject: TObject): Integer;
    function Extract(Item: TObject): TObject;
    function Remove(AObject: TObject): Integer;
    function IndexOf(AObject: TObject): Integer;
    function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer;
    procedure Insert(Index: Integer; AObject: TObject);
    function First: TObject;
    function Last: TObject;
    property OwnsObjects: Boolean;
    property Items[Index: Integer]: TObject; default;
  end;

{ TComponentList class }

  TComponentList = class(TObjectList)
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    function GetItems(Index: Integer): TComponent;
    procedure SetItems(Index: Integer; AComponent: TComponent);
    procedure HandleFreeNotify(Sender: TObject; AComponent: TComponent);
  public
    destructor Destroy; override;

    function Add(AComponent: TComponent): Integer;
    function Extract(Item: TComponent): TComponent;
    function Remove(AComponent: TComponent): Integer;
    function IndexOf(AComponent: TComponent): Integer;
    function First: TComponent;
    function Last: TComponent;
    procedure Insert(Index: Integer; AComponent: TComponent);
    property Items[Index: Integer]: TComponent; default;
  end;

{ TClassList class }

  TClassList = class(TList)
  protected
    function GetItems(Index: Integer): TClass;
    procedure SetItems(Index: Integer; AClass: TClass);
  public
    function Add(AClass: TClass): Integer;
    function Extract(Item: TClass): TClass;
    function Remove(AClass: TClass): Integer;
    function IndexOf(AClass: TClass): Integer;
    function First: TClass;
    function Last: TClass;
    procedure Insert(Index: Integer; AClass: TClass);
    property Items[Index: Integer]: TClass; default;
  end;

{ TOrdered class }

  TOrderedList = class(TObject)
  protected
    procedure PushItem(AItem: Pointer); virtual; abstract;
    function PopItem: Pointer; virtual;
    function PeekItem: Pointer; virtual;
    property List: TList;
  public
    constructor Create;
    destructor Destroy; override;

    function Count: Integer;
    function AtLeast(ACount: Integer): Boolean;
    function Push(AItem: Pointer): Pointer;
    function Pop: Pointer;
    function Peek: Pointer;
  end;

{ TStack class }

  TStack = class(TOrderedList)
  protected
    procedure PushItem(AItem: Pointer); override;
  end;

{ TObjectStack class }

  TObjectStack = class(TStack)
  public
    function Push(AObject: TObject): TObject;
    function Pop: TObject;
    function Peek: TObject;
  end;

{ TQueue class }

  TQueue = class(TOrderedList)
  protected
    procedure PushItem(AItem: Pointer); override;
  end;

{ TObjectQueue class }

  TObjectQueue = class(TQueue)
  public
    function Push(AObject: TObject): TObject;
    function Pop: TObject;
    function Peek: TObject;
  end;

{ TBucketList, Hashed associative list }

  TCustomBucketList = class;

  TBucketItem = record
    Item, Data: Pointer;
  end;
  TBucketItemArray = array of TBucketItem;

  TBucket = record
    Count: Integer;
    Items: TBucketItemArray;
  end;
  TBucketArray = array of TBucket;

  TBucketProc = procedure(AInfo, AItem, AData: Pointer; out AContinue: Boolean);

  TCustomBucketList = class(TObject)
  protected
    property Buckets: TBucketArray;
    property BucketCount: Integer;

    function BucketFor(AItem: Pointer): Integer; virtual; abstract;

    function FindItem(AItem: Pointer; out ABucket, AIndex: Integer): Boolean; virtual;
    function AddItem(ABucket: Integer; AItem, AData: Pointer): Pointer; virtual;
    function DeleteItem(ABucket: Integer; AIndex: Integer): Pointer; virtual;
  public
    destructor Destroy; override;
    procedure Clear;

    function Add(AItem, AData: Pointer): Pointer;
    function Remove(AItem: Pointer): Pointer;

    function ForEach(AProc: TBucketProc; AInfo: Pointer = nil): Boolean;
    procedure Assign(AList: TCustomBucketList);

    function Exists(AItem: Pointer): Boolean;
    function Find(AItem: Pointer; out AData: Pointer): Boolean;
    property Data[AItem: Pointer]: Pointer; default;
  end;

{ TBucketList }

  TBucketListSizes = (bl2, bl4, bl8, bl16, bl32, bl64, bl128, bl256);

  TBucketList = class(TCustomBucketList)
  protected
    function BucketFor(AItem: Pointer): Integer; override;
  public
    constructor Create(ABuckets: TBucketListSizes = bl16);
  end;

{ TObjectBucketList }

  TObjectBucketList = class(TBucketList)
  protected
    function GetData(AItem: TObject): TObject;
    procedure SetData(AItem: TObject; const AData: TObject);
  public
    function Add(AItem, AData: TObject): TObject;
    function Remove(AItem: TObject): TObject;

    property Data[AItem: TObject]: TObject; default;
  end;

{ Easy access error message }

procedure RaiseListError(const ATemplate: string; const AData: array of const);

implementation
