// READY to use
{$MODE OBJFPC}
unit darray;

interface

uses
  ddefaultallocator;

type
TDefaultAllocator = ddefaultallocator.TDefaultAllocator;

generic TArrayCustom<TElement, TAllocator> = object
public type
  TPtr = ^TArrayCustom;
  PElement = ^TElement;
private
  FFirst: PElement;
  FLength: SizeUInt;
  FCapacity: SizeUInt;
  FAllocator: TAllocator;
public
  procedure Init(AllocatorData: Pointer = nil);
  procedure Done;
  procedure Reinit;

  procedure Swap(var Other: TArrayCustom);
  procedure Clear; inline;

  function Reserve(NewCapacity: SizeUInt): Boolean;

  function IncLength(Delta: LongInt = 1): Boolean;
  procedure DecLength(Delta: LongInt = 1);
  function SetLength(NewLength: SizeUInt): Boolean;

  function Capacity: SizeUInt; inline;
  function Length: SizeUInt; inline;
  function High: LongInt; inline;
  function Last: PElement; inline;
  function Add: PElement;
  function Get(Index: LongInt): PElement; inline;
  property Items[Index: LongInt]: PElement read Get; default;
end;

generic TArray<TElement> = object(specialize TArrayCustom<TElement, TDefaultAllocator>)
end;

implementation

procedure TArrayCustom.Init(AllocatorData: Pointer);
begin
  FFirst := nil;
  FLength := 0;
  FCapacity := 0;
  FAllocator.Init(AllocatorData);
end;

procedure TArrayCustom.Done;
begin
  if FCapacity > 0 then
    DecLength(FLength);
  FAllocator.Done;
end;

procedure TArrayCustom.Reinit;
begin
  Done;
  Init;
end;

procedure TArrayCustom.Swap(var Other: TArrayCustom);
var
  Temp: TArrayCustom;
begin
  Temp := Self;
  Self := Other;
  Other := Temp;
end;

procedure TArrayCustom.Clear;
begin
  DecLength(FLength);
end;

function TArrayCustom.Reserve(NewCapacity: SizeUInt): Boolean;
var
  Temp: PElement;
begin
  if NewCapacity <= FCapacity then
    Exit(True);
  Temp := FAllocator.ReAlloc(FFirst, FCapacity * SizeOf(TElement), NewCapacity * SizeOf(TElement));
  Result := Temp <> nil;
  if Result then begin
    FFirst := Temp;
    FCapacity := NewCapacity;
  end;
end;

function TArrayCustom.IncLength(Delta: LongInt): Boolean;
var
  I: SizeUInt;
begin
  if FLength + Delta > FCapacity then begin
    I := FCapacity * 2;
    while FLength + Delta > I do
      I := I * 2;
    Result := Reserve(I);
    if not Result then
      Exit;
  end else
    Result := True;
  for I := FLength to FLength + Delta - 1 do
    Initialize(FFirst[I]);
  Inc(FLength, Delta);
end;

procedure TArrayCustom.DecLength(Delta: LongInt);
var
  I: LongInt;
begin
  for I := FLength - Delta to FLength - 1 do
    Finalize(FFirst[I]);
  Dec(FLength, Delta);
  if FLength = 0 then begin // special case
    FAllocator.DeAllocate(FFirst, FCapacity * SizeOf(TElement));
    FFirst := nil;
    FCapacity := 0;
  end;
end;

function TArrayCustom.SetLength(NewLength: SizeUInt): Boolean;
begin
  if NewLength >= FLength then begin
    Result := IncLength(NewLength - FLength);
  end else begin
    DecLength(FLength - NewLength);
    Result := True;
  end;
end;

function TArrayCustom.Capacity: SizeUInt;
begin
  Result := FCapacity;
end;

function TArrayCustom.Length: SizeUInt;
begin
  Result := FLength;
end;

function TArrayCustom.High: LongInt;
begin
  Result := FLength - 1;
end;

function TArrayCustom.Last: PElement;
begin
  Result := @FFirst[FLength - 1];
end;

function TArrayCustom.Add: PElement;
begin
  if IncLength(1) then begin
    Result := Last;
  end else
    Result := nil;
end;

function TArrayCustom.Get(Index: LongInt): PElement;
begin
  Result := FFirst + Index;
end;

end.
