source: trunk/Demos/Generics/List.pas

unit List;

interface

type
  TList<TItem, TIndex = NativeInt> = class
  public
    type
      TSortCompare = function(const Item1, Item2: TItem): Integer of object;
      TStringConverter = function(Item: TItem): string;
  private
    FItems: array of TItem;
    FCount: TIndex;
    function Get(Index: TIndex): TItem;
    function GetCapacity: TIndex;
    function GetLast: TItem;
    function GetFirst: TItem;
    procedure SetCapacity(const AValue: TIndex);
    procedure SetLast(AValue: TItem);
    procedure SetFirst(AValue: TItem);
    procedure Put(Index: TIndex; const AValue: TItem); virtual;
    procedure SetCount(const AValue: TIndex);
    procedure QuickSort(L, R : TIndex; Compare: TSortCompare);
  public
    function Add(Item: TItem): TIndex;
    procedure AddArray(Values: array of TItem);
    procedure AddList(List: TList);
    procedure Assign(List: TList);
    procedure Clear; virtual;
    procedure Contract;
    procedure Delete(Index: TIndex); virtual;
    procedure DeleteItems(Index, Count: TIndex);
    function Equals(List: TList): Boolean;
    procedure Expand;
    function Extract(Item: TItem): TItem;
    procedure Exchange(Index1, Index2: TIndex);
    property First: TItem read GetFirst write SetFirst;
    procedure Fill(Start, Count: TIndex; Value: TItem);
    function Implode(Separator: string; Converter: TStringConverter): string;
    function IndexOf(Item: TItem; Start: TIndex = 0): TIndex;
    function IndexOfList(List: TList; Start: TIndex = 0): TIndex;
    procedure Insert(Index: TIndex; Item: TItem);
    procedure InsertList(Index: TIndex; List: TList);
    procedure InsertArray(Index: TIndex; Values: array of TItem);
    procedure Move(CurIndex, NewIndex: TIndex);
    procedure MoveItems(CurIndex, NewIndex, Count: TIndex);
    function Remove(Item: TItem): TIndex;
    procedure Reverse;
    procedure Sort(Compare: TSortCompare);
    procedure SetArray(Values: array of TItem);
    property Count: TIndex read FCount write SetCount;
    property Capacity: TIndex read GetCapacity write SetCapacity;
    property Items[Index: TIndex]: TItem read Get write Put; default;
    property Last: TItem read GetLast write SetLast;
  end;
  
implementation

function TList.GetCapacity: TIndex;
begin
  Result := Length(FItems);
end;

procedure TList.SetCapacity(const AValue: TIndex);
begin
  SetLength(FItems, AValue);
end;

function TList.Get(Index: TIndex): TItem;
begin
  Result := FItems[Index];
end;

procedure TList.Put(Index: TIndex; const AValue: TItem);
begin
  FItems[Index] := AValue;
end;

procedure TList.SetCount(const AValue: TIndex);
begin
  SetLength(FItems, AValue);
  FCount := AValue;
end;

procedure TList.QuickSort(L, R: TIndex; Compare: TSortCompare);
var
  I, J: TIndex;
  P, Q: TItem;
begin
 repeat
   I := L;
   J := R;
   P := FItems[ (L + R) div 2 ];
   repeat
     while Compare(P, FItems[I]) > 0 do
       I := I + 1;
     while Compare(P, FItems[J]) < 0 do
       J := J - 1;
     If I <= J then
     begin
       Q := FItems[I];
       FItems[I] := FItems[J];
       FItems[J] := Q;
       I := I + 1;
       J := J - 1;
     end;
   until I > J;
   if L < J then
     QuickSort(L, J, Compare);
   L := I;
  until I >= R;
end;

procedure TList.Assign(List: TList);
var
  I: Integer;
begin
  Count := List.Count;
  I := 0;
  while I < Count do begin
    Items[I] := List[I];
    I := I + 1;
  end;
end;

procedure TList.Expand;
var
  IncSize: TIndex;
begin
  if FCount = Capacity then begin
    IncSize := 4;
    if Capacity > 3 then IncSize := IncSize + 4;
    if Capacity > 8 then IncSize := IncSize + 8;
    if Capacity > 63 then IncSize := IncSize + Capacity shr 2;
    Capacity := Capacity + IncSize;
  end;
end;

procedure TList.Contract;
begin
  if (Capacity > 256) and (FCount < Capacity shr 2) then
  begin
    Capacity := Capacity shr 1;
  end;
end;

function TList.Extract(Item: TItem): TItem;
var
  I: TIndex;
begin
  I := IndexOf(Item);
  if I >= 0 then begin
    Result := Item;
    Delete(I);
  end else
    raise EListError.CreateFmt(SListIndexError, [0]);
end;

function TList.IndexOf(Item: TItem; Start: TIndex): TIndex;
begin
  Result := Start;
  while (Result < FCount) and
  not CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TItem)) do
    Result := Result + 1;
  if Result = FCount then Result := -1;
end;

procedure TList.Insert(Index: TIndex; Item: TItem);
begin
  if (Index < 0) or (Index > FCount ) then
    raise EListError.CreateFmt(SListIndexError, [Index]);
  if FCount = Capacity then Expand;
  if Index < FCount then
    System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TItem));
  FItems[Index] := Item;
  FCount := FCount + 1;
end;

procedure TList.InsertList(Index: TIndex; List: TList);
var
  I: TIndex;
begin
  I := 0;
  while (I < List.Count) do begin
    Insert(Index + I, List[I]);
    I := I + 1;
  end;
end;

function TList.IndexOfList(List: TList; Start: TIndex): TIndex;
var
  I: TIndex;
begin
  if List.Count > 0 then begin
    Result := IndexOf(List[0], Start);
    if Result <> -1 then begin
      I := 1;
      while I < List.Count do begin
        if not CompareMem(Addr(FItems[Result + I]), Addr(List.FItems[I]), SizeOf(TItem)) then begin
          Result := -1;
          Break;
        end;
        I := I + 1;
      end;
    end;
  end else Result := -1;
end;

function TList.GetLast: TItem;
begin
  if FCount = 0 then
    raise EListError.CreateFmt(SListIndexError, [0])
  else
    Result := Items[FCount - 1];
end;

procedure TList.SetLast(AValue: TItem);
begin
  if FCount = 0 then
    raise EListError.CreateFmt(SListIndexError, [0])
  else
    Items[FCount - 1] := AValue;
end;

function TList.GetFirst: TItem;
begin
  if FCount = 0 then
    raise EListError.CreateFmt(SListIndexError, [0])
  else
    Result := Items[0];
end;

procedure TList.SetFirst(AValue: TItem);
begin
  if FCount = 0 then
    raise EListError.CreateFmt(SListIndexError, [0])
  else
    Items[0] := AValue;
end;

procedure TList.Move(CurIndex, NewIndex: TIndex);
var
  Temp: TItem;
begin
  if ((CurIndex < 0) or (CurIndex > Count - 1)) then
    raise EListError.CreateFmt(SListIndexError, [CurIndex]);
  if ((NewIndex < 0) or (NewIndex > Count -1)) then
    raise EListError.CreateFmt(SlistIndexError, [NewIndex]);
  Temp := FItems[CurIndex];
  if NewIndex > CurIndex then begin
    System.Move(FItems[CurIndex + 1], FItems[CurIndex], (NewIndex - CurIndex) * SizeOf(TItem));
  end else
  if NewIndex < CurIndex then begin
    System.Move(FItems[NewIndex], FItems[NewIndex + 1], (CurIndex - NewIndex) * SizeOf(TItem));
  end;
  FItems[NewIndex] := Temp;
  //Delete(CurIndex);
  //Insert(NewIndex, Temp);
end;

procedure TList.MoveItems(CurIndex, NewIndex, Count: TIndex);
var
  S: Integer;
  D: Integer;
begin
  if CurIndex < NewIndex then begin
    S := CurIndex + Count - 1;
    D := NewIndex + Count - 1;
    while S >= CurIndex do begin
      Move(S, D);
      S := S - 1;
      D := D - 1;
    end;
  end else
  if CurIndex > NewIndex then begin
    S := CurIndex;
    D := NewIndex;
    while S < (CurIndex + Count) do begin
      Move(S, D);
      S := S + 1;
      D := D + 1;
    end;
  end;
end;

function TList.Remove(Item: TItem): TIndex;
begin
  Result := IndexOf(Item);
  if Result <> -1 then
    Delete(Result);
end;

function TList.Equals(List: TList): Boolean;
var
  I: TIndex;
begin
  Result := Count = List.Count;
  if Result then begin
    I := 0;
    while I < Count do begin
      if not CompareMem(Addr(FItems[I]), Addr(List.FItems[I]), SizeOf(TItem)) then begin
        Result := False;
        Break;
      end;
      I := I + 1;
    end;
  end;
end;

procedure TList.Reverse;
var
  I: TIndex;
begin
  I := 0;
  while I < (Count div 2) do begin
    Exchange(I, Count - 1 - I);
    I := I + 1;
  end;
end;

procedure TList.Sort(Compare: TSortCompare);
begin
  if FCount > 1 then
    QuickSort(0, FCount - 1, Compare);
end;

procedure TList.AddArray(Values: array of TItem);
var
  I: TIndex;
begin
  I := 0;
  while I <= High(Values) do begin
    Add(Values[I]);
    I := I + 1;
  end;
end;

procedure TList.SetArray(Values: array of TItem);
var
  I: TIndex;
begin
  Clear;
  I := 0;
  while I <= High(Values) do begin
    Add(Values[I]);
    I := I + 1;
  end;
end;

procedure TList.InsertArray(Index: TIndex; Values: array of TItem);
var
  I: TIndex;
begin
  I := 0;
  while I <= High(Values) do begin
    Insert(Index + I, Values[I]);
    I := I + 1;
  end;
end;

function TList.Implode(Separator: string; Converter: TStringConverter): string;
var
  I: TIndex;
begin
  Result := '';
  I := 0;
  while I < Count do begin
    Result := Result + Converter(Items[I]);
    if I < (Count - 1) then
      Result := Result + Separator;
    I := I + 1;
  end;
end;

function TList.Add(Item: TItem): TIndex;
begin
  if FCount = Capacity then
    Self.Expand;
  FItems[FCount] := Item;
  Result := FCount;
  FCount := FCount + 1;
end;

procedure TList.AddList(List: TList);
var
  I: TIndex;
begin
  I := 0;
  while I < List.Count do begin
    Add(List[I]);
    I := I + 1;
  end;
end;

procedure TList.Clear;
begin
  Count := 0;
  Capacity := 0;
end;

procedure TList.Delete(Index: TIndex);
begin
  if (Index < 0) or (Index >= FCount) then
    raise EListError.CreateFmt(SListIndexError, [Index]);
  FCount := FCount - 1;
  System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TItem));
  Contract;
end;

procedure TList.DeleteItems(Index, Count: TIndex);
var
  I: TIndex;
begin
  I := Index;
  while I < (Index + Count) do begin
    Delete(Index);
    I := I + 1;
  end;
end;

procedure TList.Fill(Start, Count: TIndex; Value: TItem);
begin
  while Count > 0 do begin
    Items[Start] := Value;
    Count := Count - 1;
    Start := Start + 1;
  end;
end;

procedure TList.Exchange(Index1, Index2: TIndex);
var
  Temp: TItem;
begin
  if ((Index1 >= FCount) or (Index1 < 0)) then
    raise EListError.CreateFmt(SListIndexError, [Index1]);
  if ((Index2 >= FCount) or (Index2 < 0)) then
    raise EListError.CreateFmt(SListIndexError, [Index2]);
  Temp := FItems[Index1];
  FItems[Index1] := FItems[Index2];
  FItems[Index2] := Temp;
end;

end.