unit DoubleLinkedList;

{ V této unitě se nachází implementace dvojitě zřetězeného seznamu, zapouzdřená
  do třídy kompatibilní se standardním Delpháckým TListem. Tento seznam může být
  využit ve třídě TEnv jako seznam organismů.

  Původní cíl byl napsat rychlejší seznam, než je TList, to se ale (zatím)
  nepodařilo, práce na této unitě jsem (zatím) zanechal a spokojil se se
  standardním TListem.

  Kód je možno akivovat zapnutím volby kompilátoru UseDoubleLinkedList
  v unitě VLFObjecs.

  Kód je nutno považovat za NEDODĚLANÝ a EXPERIMENÁLNÍ. Neručím za to, že
  po jeho aktivaci vše bude fungovat. }

interface

type
  PDLLItem = ^TDLLItem;
  TDLLItem = record
    Data: Pointer;
    Prev, Next: PDLLItem;
  end;

  { OPT: head & tail }
  { OPT: assembler kde to půjde }
  TDoubleLinkedList = class
  private
    FCount: Integer;

    First: PDLLItem;
    Last: PDLLItem;

    RecentIndex: Integer;
    RecentItem: PDLLItem;

    function GetItems(index: Integer): Pointer;
    procedure SetItems(index: Integer; Value: Pointer);

    function GetDLLItem(index: Integer): PDLLItem;
    procedure InvalidateCache;
  public
    property Count: Integer read FCount;
    property Items[index: Integer]: Pointer read GetItems write SetItems; default;

    procedure Add(Item: Pointer);
    procedure Delete(index: Integer);
    procedure Clear;
    function IndexOf(Item: Pointer): Integer;
    procedure Pack;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  Classes;

function TDoubleLinkedList.GetItems(index: Integer): Pointer;
begin
  Result := GetDLLItem(index)^.Data;
end;

procedure TDoubleLinkedList.SetItems(index: Integer; Value: Pointer);
begin
  GetDLLItem(index)^.Data := Value;
end;

function TDoubleLinkedList.GetDLLItem(index: Integer): PDLLItem;
var
  I: Integer;
  P: PDLLItem;
begin
  Assert(index >= 0);
  Assert(index < FCount);
  if index = RecentIndex + 1 then
  begin
    Inc(RecentIndex);
    RecentItem := RecentItem^.Next;
    Result := RecentItem;
    Exit;
  end;
  if index = RecentIndex - 1 then
  begin
    Dec(RecentIndex);
    RecentItem := RecentItem^.Prev;
    Result := RecentItem;
    Exit;
  end;
  if index = RecentIndex then
  begin
    Result := RecentItem;
    Exit;
  end;
  P := First;
  for I := 0 to index - 1 do
    P := P^.Next;
  RecentIndex := index;
  RecentItem := P;
  Result := P;
end;

procedure TDoubleLinkedList.InvalidateCache;
begin
  RecentIndex := - 10;
  RecentItem := nil;
end;

procedure TDoubleLinkedList.Add(Item: Pointer);
var
  P: PDLLItem;
begin
  New(P);
  with P^ do
  begin
    Data := Item;
    Prev := Last;
    Next := nil;
  end;
  if Last <> nil then
    Last^.Next := P
  else
    First := P;
  Last := P;
  Inc(FCount);
end;

procedure TDoubleLinkedList.Delete(index: Integer);
var
  P: PDLLItem;
begin
  P := GetDLLItem(index);
  if P^.Prev <> nil then
    P^.Prev^.Next := P^.Next
  else
    First := P^.Next;
  if P^.Next <> nil then
    P^.Next^.Prev := P^.Prev
  else
    Last := P^.Prev;
  Dispose(P);
  if index = RecentIndex then InvalidateCache;
  Dec(FCount);
end;

procedure TDoubleLinkedList.Clear;
var
  P: PDLLItem;
begin
  P := First;
  while P <> nil do
  begin
    First := P^.Next;
    Dispose(P);
    P := First;
  end;
  FCount := 0;
  First := nil;
  Last := nil;
end;

{ OPT: Použít cache. }
function TDoubleLinkedList.IndexOf(Item: Pointer): Integer;
var
  P: PDLLItem;
  I: Integer;
begin
  Result := - 1;
  P := First;
  I := 0;
  while P <> nil do
  begin
    if P^.Data = Item then
    begin
      Result := I;
      Break;
    end;
    P := P^.Next;
    Inc(I);
  end;
end;

procedure TDoubleLinkedList.Pack;
var
  P, NextP: PDLLItem;
begin
  P := First;
  while P <> nil do
    if P^.Data = nil then
    begin
      if P^.Prev <> nil then
        P^.Prev^.Next := P^.Next
      else
        First := P^.Next;
      if P^.Next <> nil then
        P^.Next^.Prev := P^.Prev
      else
        Last := P^.Prev;
      NextP := P^.Next;
      Dispose(P);
      P := NextP;
      Dec(FCount);
    end
    else
      P := P^.Next;
  InvalidateCache; // pro jistotu, nevíme co jsme vlastně přesně odebrali
end;

constructor TDoubleLinkedList.Create;
begin
  inherited Create;
  FCount := 0;
  First := nil;
  Last := nil;
  InvalidateCache;
end;

destructor TDoubleLinkedList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

end.
