unit dllist;

interface

uses SysUtils;

type

  EDLListError = class( Exception );
  EStackUnderflow = class( EDLListError );
  EQueueUnderflow = class( EDLListError );

  //----------------------------------------------------------------------------

  TDLNode = class( TObject )
    private
      FPred   : TDLNode;
      FSucc   : TDLNode;
      FData   : TObject;

      constructor CreateListHead;
      constructor Create( AData : TObject; APred, ASucc : TDLNode );

      function Detach : TDLNode;

      function InsertAfter( AData : TObject ) : TDLNode;
      function InsertBefore( AData : TObject ) : TDLNode;
    public
      property Succ : TDLNode read FSucc;
      property Pred : TDLNode read FPred;
      property Data : TObject read FData write FData;
  end;

  //----------------------------------------------------------------------------

  TDLIterator = class;

  //----------------------------------------------------------------------------

  TDLListForEachProc = function ( Node : TDLNode; Param : Pointer ) : Boolean;

  TDLList = class( TObject )
    private
      FCount  : Longint;
      FNode   : TDLNode;
    public
      constructor Create;
      destructor Destroy; override;

      // Inserts the given object at the head of the list
      procedure InsertFirst( Data : TObject );

      // Inserts the given object at the tail of the list
      procedure InsertLast( Data : TObject );

      // Removes the first object in the list
      // If list is empty, EDLListError will be raised
      function RemoveFirst : TObject;

      // Removes the last object in the list
      // If list is empty, EDLListError will be raised
      function RemoveLast : TObject;

      // Returns true if the list is empty
      function IsEmpty : Boolean;

      // Returns an instance of a TDLIterator for this list
      // Caller is responsible for freeing the iterator when
      // finished with it
      function GetIterator : TDLIterator;

      // Removes all the items from the list
      procedure Clear;

      // Removes all the items from the list and
      // destroys the associated objects.
      // Does not perform checking for nil, if any item in the list is
      // nil, it will fail
      procedure ClearAndDestroy;

      // Returns the number of items in the list
      property Count : Longint read FCount;

      // Finds the given object, if not found returns nil
      function FindObject( Data : TObject ) : TObject;

      // Removes the given object from the list,
      // if it was found, the function returns a pointer to the object
      // otherwise, it returns nil
      function RemoveObject( Data : TObject ) : TObject;

      // Removes the given Node from the list
      // The node is also destroyed
      // The return value is the object attached to the node
      function RemoveNode( Node : TDLNode ) : TObject;

      // Inserts the given object after the given node
      // Returns a pointer to the new node
      function InsertAfter( Node : TDLNode ; Data : TObject ) : TDLNode;

      // Inserts the given object before the given node
      // Returns a pointer to the new node
      function InsertBefore( Node : TDLNode ; Data : TObject ) : TDLNode;

      // This function will call the given procedure for each element
      // in the list, the param pointer is user specific and will be
      // passed to the proc as well
      function ForEach( Proc : TDLListForEachProc; Param : Pointer ) : Boolean;
  end;

  //----------------------------------------------------------------------------

  TDLIterator = class( TObject )
    private
      FList   : TDLList;
      FNode   : TDLNode;
    public
      // Constructs an iterator for the given list
      // and initializes it to point to the first item
      constructor Create( List : TDLList );

      // Initializes the Iterator to point to the first item in the list
      procedure First;

      // Initializes the Iterator to point to the last item in the list
      procedure Last;

      // Returns true if the iterator is at the beginning of the list
      function AtBeginning : Boolean;

      // Returns true if the iterator is at the end of the list
      function AtEnd : Boolean;

      // Returns th eprevious object in the list
      function Pred : TObject;

      // Returns the next object in the list
      function Succ : TObject;

      // Returns the current NODE
      function CurrentNode : TDLNode;
  end;

  //----------------------------------------------------------------------------

  TStack = class( TObject )
    private
      FList     : TDLList;
    public
      constructor Create;
      destructor Destroy; override;

      procedure Push( Data : TObject );
      function Pop : TObject;
      function Peek : TObject;
      function IsEmpty : Boolean;
      function Count : Longint;
      function GetIterator : TDLIterator;
      procedure Clear;
      procedure ClearAndDestroy;
  end;

  //----------------------------------------------------------------------------

  TQueue = class( TObject )
    private
      FList     : TDLList;
    public
      constructor Create;
      destructor Destroy; override;

      procedure Add( Data : TObject );
      function Remove : TObject;
      function Peek : TObject;
      function IsEmpty : Boolean;
      function Count : Longint;
      function GetIterator : TDLIterator;
      procedure Clear;
      procedure ClearAndDestroy;
  end;

  //----------------------------------------------------------------------------

implementation

//------------------------------------------------------------------------------
// TDLNode

constructor TDLNode.Create( AData : TObject; APred, ASucc : TDLNode );
begin
  inherited Create;
  FPred := APred;
  FSucc := ASucc;
  FData := AData;
end;

constructor TDLNode.CreateListHead;
begin
  inherited Create;
  FPred := Self;
  FSucc := Self;
  FData := nil;
end;

function TDLNode.InsertAfter( AData : TObject ) : TDLNode;
begin
  Result := TDLNode.Create( AData , Self , FSucc );
  FSucc.FPred := Result;
  FSucc := Result;
end;

function TDLNode.InsertBefore( AData : TObject ) : TDLNode;
begin
  Result := TDLNode.Create( AData , FPred , Self );
  FPred.FSucc := Result;
  FPred := Result;
end;

function TDLNode.Detach : TDLNode;
begin
  FPred.FSucc := FSucc;
  FSucc.FPred := FPred;
  Result := Self;
end;

//------------------------------------------------------------------------------
// TDLList

constructor TDLList.Create;
begin
  inherited Create;
  FNode := TDLNode.CreateListHead;
  FCount := 0;
end;

destructor TDLList.Destroy;
begin
  Clear;
  FNode.Free;
  inherited Destroy;
end;

function TDLList.IsEmpty : Boolean;
begin
  Result := FCount = 0;
end;

function TDLList.RemoveNode( Node : TDLNode ) : TObject;
begin
  Result := Node.Data;
  Node.Detach.Free;
  Dec( FCount );
end;

function TDLList.InsertAfter( Node : TDLNode; Data : TObject ) : TDLNode;
begin
  Result := Node.InsertAfter( Data );
  Inc( FCount );
end;

function TDLList.InsertBefore( Node : TDLNode; Data : TObject ) : TDLNode;
begin
  Result := Node.InsertBefore( Data );
  Inc( FCount );
end;

procedure TDLList.InsertFirst( Data : TObject );
begin
  InsertAfter( FNode , Data );
end;

procedure TDLList.InsertLast( Data : TObject );
begin
  InsertBefore( FNode , Data );
end;

function TDLList.RemoveFirst : TObject;
begin
  if IsEmpty then
    raise EDLListError.Create( 'Cannot remove from empty DLList' );
  Result := RemoveNode( FNode.Succ );
end;

function TDLList.RemoveLast : TObject;
begin
  if IsEmpty then
    raise EDLListError.Create( 'Cannot remove from empty DLList' );
  Result := RemoveNode( Fnode.Pred );
end;

function TDLList.GetIterator : TDLIterator;
begin
  Result := TDLIterator.Create( Self );
end;

procedure TDLList.Clear;
begin
  while not IsEmpty do
    RemoveFirst;
end;

procedure TDLList.ClearAndDestroy;
begin
  while not IsEmpty do
    RemoveFirst.Free;
end;

function TDLList.FindObject( Data : TObject ) : TObject;
var
  IT : TDLIterator;
begin
  Result := nil;
  IT := GetIterator;
  try
    while not IT.AtEnd do
      if IT.Succ = Data then
        begin
          Result := Data;
          break;
        end;
  finally
    IT.Free;
  end;
end;

function TDLList.RemoveObject( Data : TObject ) : TObject;
var
  IT : TDLIterator;
begin
  Result := nil;
  IT := GetIterator;
  try
    while not IT.AtEnd do
      if IT.CurrentNode.Data = Data then
        begin
          Result := RemoveNode( IT.CurrentNode );
          break;
        end
      else
        IT.Succ;
  finally
    IT.Free;
  end;
end;

function TDLList.ForEach( Proc : TDLListForEachProc; Param : Pointer ) : Boolean;
var
  IT : TDLIterator;
begin
  IT := GetIterator;
  try
    while not IT.AtEnd do
      if not Proc( IT.CurrentNode , Param ) then
        Break
      else
        IT.Succ;
  finally
    Result := IT.AtEnd;
    IT.Free;
  end;
end;

//------------------------------------------------------------------------------
// TDLIterator

constructor TDLIterator.Create( List : TDLList );
begin
  inherited Create;
  FList := List;
  First;
end;

procedure TDLIterator.First;
begin
  FNode := FList.FNode.Succ;
end;

procedure TDLIterator.Last;
begin
  FNode := FList.FNode.Pred;
end;

function TDLIterator.AtBeginning : Boolean;
begin
  Result := FNode = FList.FNode;
end;

function TDLIterator.AtEnd : Boolean;
begin
  Result := FNode = FList.FNode;
end;

function TDLIterator.Pred : TObject;
begin
  Result := FNode.Data;
  FNode := FNode.Pred;
end;

function TDLIterator.Succ : TObject;
begin
  Result := FNode.Data;
  FNode := FNode.Succ;
end;

function TDLIterator.CurrentNode : TDLNode;
begin
  Result := FNode;
end;

//------------------------------------------------------------------------------

constructor TStack.Create;
begin
  inherited Create;
  FList := TDLList.Create;
end;

destructor TStack.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TStack.Push( Data : TObject );
begin
  FList.InsertFirst( Data );
end;

function TStack.Pop : TObject;
begin
  if IsEmpty then
    raise EStackUnderflow.Create( 'Cannot pop from empty stack' );
  Result := FList.RemoveFirst;
end;

function TStack.Peek : TObject;
begin
  if IsEmpty then
    raise EStackUnderflow.Create( 'Cannot peek empty stack' );
  Result := FList.FNode.Succ.Data;
end;

function TStack.IsEmpty : Boolean;
begin
  Result := FList.IsEmpty;
end;

function TStack.Count : Longint;
begin
  Result := FList.Count;
end;

function TStack.GetIterator : TDLIterator;
begin
  Result := TDLIterator.Create( FList );
end;

procedure TStack.Clear;
begin
  FList.Clear;
end;

procedure TStack.ClearAndDestroy;
begin
  FList.ClearAndDestroy;
end;

//------------------------------------------------------------------------------
// TQueue

constructor TQueue.Create;
begin
  inherited Create;
  FList := TDLList.Create;
end;

destructor TQueue.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TQueue.Add( Data : TObject );
begin
  FList.InsertLast( Data );
end;

function TQueue.Remove : TObject;
begin
  if IsEmpty then
    raise EQueueUnderflow.Create( 'Cannot remove from empty queue.' );
  Result := FList.RemoveFirst;
end;

function TQueue.Peek : TObject;
begin
  if IsEmpty then
    raise EQueueUnderflow.Create( 'Cannot remove from empty queue.' );
  Result := FList.FNode.Succ.Data;
end;

function TQueue.IsEmpty : Boolean;
begin
  Result := FList.IsEmpty;
end;

function TQueue.Count : Longint;
begin
  Result := FList.Count;
end;

function TQueue.GetIterator : TDLIterator;
begin
  Result := TDLIterator.Create( FList );
end;

procedure TQueue.Clear;
begin
  FList.Clear;
end;

procedure TQueue.ClearAndDestroy;
begin
  FList.ClearAndDestroy;
end;

end.