utils/uutlListBase.pas

unit uutlListBase;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uutlArrayContainer, uutlInterfaces, uutlEnumerator;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  generic TutlListBase<T> = class(
    specialize TutlArrayContainer<T>
    , specialize IEnumerable<T>
    , specialize IutlEnumerable<T>)

  public type
    IEnumerator = specialize IEnumerator<T>;
    IutlEnumerator = specialize IutlEnumerator<T>;

  private type
    TEnumerator = class(
      specialize TutlMemoryEnumerator<T>
      , IEnumerator
      , IutlEnumerator)
    private
      fOwner: TutlListBase;

    protected { IEnumerator }
      procedure InternalReset; override;

    {$IFDEF UTL_ENUMERATORS}
    public { IutlEnumerator }
      function Reverse: IutlEnumerator; override;
    {$ENDIF}

    public
      constructor Create(const aOwner: TutlListBase; const aReversed: Boolean); reintroduce;
    end;

  strict private
    fCount: Integer;

  protected
    function  GetCount: Integer; override;
    procedure SetCount(const aValue: Integer); override;

    function  GetItem     (const aIndex: Integer): T; virtual;
    procedure SetItem     (const aIndex: Integer; aValue: T); virtual;

    procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
    procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;

  public { IEnumerable }
    function GetEnumerator: IEnumerator;

  public { IutlEnumerable }
    function GetUtlEnumerator: IutlEnumerator;

  public
    property Count;
    property IsEmpty;
    property Capacity;
    property CanShrink;
    property CanExpand;
    property OwnsItems;

    procedure Clear; virtual;
    procedure ShrinkToFit;

    constructor Create(const aOwnsItems: Boolean);
    destructor Destroy; override;
  end;

implementation

uses
  uutlCommon;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase.TEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.TEnumerator.InternalReset;
begin
  First  := 0;
  Last   := fOwner.Count-1;
  if (Last >= First)
    then Memory := fOwner.GetInternalItem(0)
    else Memory := nil;
  inherited InternalReset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{$IFDEF UTL_ENUMERATORS}
function TutlListBase.TEnumerator.Reverse: IutlEnumerator;
begin
  result := TEnumerator.Create(fOwner, not Reversed);
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.TEnumerator.Create(const aOwner: TutlListBase; const aReversed: Boolean);
begin
  if not Assigned(aOwner) then
    raise EArgumentNilException.Create('aOwner');
  fOwner := aOwner;
  inherited Create(nil, aReversed, 0, -1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetCount: Integer;
begin
  result := fCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetCount(const aValue: Integer);
begin
  if (aValue < Capacity) then
    Capacity := aValue;
  fCount := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetItem(const aIndex: Integer): T;
begin
  if (aIndex < 0) or (aIndex >= Count) then
    raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  result := GetInternalItem(aIndex)^;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.SetItem(const aIndex: Integer; aValue: T);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex >= Count) then
    raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  p := GetInternalItem(aIndex);
  Release(p^, true);
  p^ := aValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex > fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount);
  if (fCount = Capacity) then
    Expand;
  p := GetInternalItem(aIndex);
  if (aIndex < fCount) then
    System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
  p^ := aValue;
  inc(fCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
  p: PT;
begin
  if (aIndex < 0) or (aIndex >= fCount) then
    raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  dec(fCount);
  p := GetInternalItem(aIndex);
  Release(p^, aFreeItem);
  System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
  if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then  // only 25% used
    SetCapacity(Capacity shr 1);                                        // set to 50% Capacity
  FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetEnumerator: IEnumerator;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlListBase.GetUtlEnumerator: specialize IutlEnumerator<T>;
begin
  result := TEnumerator.Create(self, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.Clear;
begin
  while (Count > 0) do begin
    dec(fCount);
    Release(GetInternalItem(fCount)^, true);
  end;
  fCount := 0;
  if CanShrink then
    ShrinkToFit;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListBase.ShrinkToFit;
begin
  Shrink(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlListBase.Create(const aOwnsItems: Boolean);
begin
  inherited Create(aOwnsItems);
  fCount := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlListBase.Destroy;
begin
  Clear;
  inherited Destroy;
end;

end.