Doubly Linked List

unit DoublyLinkedList;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils;

{==============================================================================}

type
  TData = Cardinal;

  PElement = ^TElement;
  TElement = record
    Data : TData;
    Next : PElement;
    Prev : PElement;
  end;

  TDoublyLinkedList = class
    private
      FFirst : PElement;
      FLast  : PElement;
      FCount : Cardinal;
    private
      procedure CreateElement(AData: TData; out AElement: PElement);
      function GetElementByIndex(AIndex : Cardinal) : PElement;
      function GetCapacity : Cardinal;
    public
      constructor Create;
      destructor Destroy; override;
    public
      procedure Add(AElement : TData);
      procedure Insert(AElement : TData; AIndex : Cardinal);
      procedure Delete(AIndex : Cardinal);
      procedure Clear;
    public
      function Get(AIndex : Cardinal) : TData;
    public
      procedure SaveToFile(AFileName : String);
      procedure LoadFromFile(AFileName : String);
      procedure Print;
    public
      property Count : Cardinal read fCount;
      property Capacity : LongWord read GetCapacity;
  end;

{------------------------------------------------------------------------------}

const
  ELEMENT_DATA_SIZE = SizeOf(TData);

{==============================================================================}

implementation

{==============================================================================}

{-- TDoublyLinkedList class ---------------------------------------------------}
{-- constructor/destructor ----------------------------------------------------}
constructor TDoublyLinkedList.Create;
begin
  inherited Create;
  FFirst := nil;
  FLast := nil;
  FCount := 0;
end;

destructor TDoublyLinkedList.Destroy;
begin
  Clear;
  Inherited Destroy;
end;

{-- private -------------------------------------------------------------------}

procedure TDoublyLinkedList.CreateElement(AData: TData; out AElement: PElement);
begin
  New(AElement);
  AElement^.Next := nil;
  AElement^.Prev := nil;
  AElement^.Data := AData;
end;

function TDoublyLinkedList.GetElementByIndex(AIndex : Cardinal) : PElement;
var
  ToSearch : PElement;
  tmpIndex : Word;
begin
  if FCount shr 1 < AIndex then
  begin
    ToSearch := FFirst;
    while AIndex > 0 do
    begin
      ToSearch := ToSearch^.Next;
      Dec(AIndex);
    end;
  end
  else
  begin
    ToSearch := FLast;
    tmpIndex := FCount - 1 - AIndex;
    while tmpIndex > 0 do
    begin
      ToSearch := ToSearch^.Prev;
      Dec(tmpIndex);
    end;
  end;
  Result := ToSearch;
end;

function TDoublyLinkedList.GetCapacity : Cardinal;
begin
  Result := FCount * ELEMENT_DATA_SIZE;
end;

{-- public --------------------------------------------------------------------}

procedure TDoublyLinkedList.Add(AElement : TData);
var
  NewOne : PElement;
begin
  CreateElement(AElement, NewOne);

  NewOne^.Prev := FLast;
  FLast := NewOne;

  if NewOne^.Prev = nil then
    FFirst := NewOne
  else
    NewOne^.Prev^.Next := NewOne;

  Inc(FCount);
end;

procedure TDoublyLinkedList.Insert(AElement : TData; AIndex : Cardinal);
var
  NewOne, ToSearch :  PElement;
begin
  if AIndex >= FCount then
    Add(AElement)
  else
  begin
    CreateElement(AElement, NewOne);

    ToSearch := GetElementByIndex(AIndex);

    NewOne^.Next := ToSearch;
    If ToSearch^.Prev <> nil then
    begin
      NewOne^.Prev := ToSearch^.Prev;
      ToSearch^.Prev^.Next := NewOne;
    end
    else
      FFirst := NewOne;

    ToSearch^.Prev := NewOne;

    Inc(FCount);
  end;
end;

procedure TDoublyLinkedList.Delete(AIndex : Cardinal);
var
  ToDelete :  PElement;
begin
  if FCount <> 0 then
  begin
    ToDelete := GetElementByIndex(AIndex);

    if ToDelete^.Prev <> nil then
      ToDelete^.Prev^.Next := ToDelete^.Next
    else
      FFirst := ToDelete^.Next;

    if ToDelete^.Next <> nil then
      ToDelete^.Next^.Prev := ToDelete^.Prev
    else
      FLast := ToDelete^.Prev;

    Dispose(ToDelete);
    Dec(FCount);
  end;
end;

procedure TDoublyLinkedList.Clear;
var
  ToDelete : PElement;
begin
  while FFirst <> nil do
  begin
    ToDelete := FFirst;
    FFirst := FFirst^.Next;
    Dispose(ToDelete);
  end;
  FCount := 0;
  FLast := nil;
end;

function TDoublyLinkedList.Get(AIndex : Cardinal) : TData;
var
  ToGet : PElement;
begin
  if AIndex >= FCount then
    Result := FLast^.Data
  else
  begin
    ToGet := GetElementByIndex(AIndex);
    Result := ToGet^.Data;
  end;
end;

procedure TDoublyLinkedList.SaveToFile(AFileName : String);
var
  SaveFile : TFileStream;
  ToSave   : PElement;
begin
  SaveFile := TFileStream.Create(AFileName, fmCreate);
  ToSave := FFirst;
  try
    while ToSave <> nil do
    begin
      SaveFile.WriteBuffer(ToSave^.Data, ELEMENT_DATA_SIZE);
      ToSave := ToSave^.Next;
    end;
  finally
    FreeAndNil(SaveFile);
  end;
end;

procedure TDoublyLinkedList.LoadFromFile(AFileName : String);
var
  LoadFile : TFileStream;
  ToLoad   : TData;
begin
  LoadFile := TFileStream.Create(AFileName, fmOpenRead);
  try
    while LoadFile.Position < LoadFile.Size do
    begin
      LoadFile.ReadBuffer(ToLoad, ELEMENT_DATA_SIZE);
      Add(ToLoad);
    end;
  finally
    FreeAndNil(LoadFile);
  end;
end;

procedure TDoublyLinkedList.Print;
var
  ToPrint : PElement;
  Index   : Word;
begin
  ToPrint := FFirst;
  Index := 0;

  Writeln('Count: ',FCount);
  while ToPrint <> nil do
  begin
    Writeln('Index: ', Index, ' Data: ', ToPrint^.Data);
    ToPrint := ToPrint^.Next;
    Inc(Index);
  end;
end;

{-- end TDoublyLinkedList -----------------------------------------------------}
{==============================================================================}

end.