ezdsldbl.pas

Eazy Data Structures library for Delphi.

  Cursor : TListCursor;
begin
  if not IsEmpty then begin
    Cursor := Next(SetBeforeFirst);
    while not IsAfterLast(Cursor) do
      Cursor := Erase(Cursor);
  end;
  if acInDone then begin
    if Assigned(dlBF) then
      acDisposeNode(dlBF);
    if Assigned(dlAL) then
      acDisposeNode(dlAL);
  end;
end;
{--------}
function TDList.Erase(Cursor : TListCursor) : TListCursor;
begin
  if IsDataOwner then
    DisposeData(Examine(Cursor));
  Result := Delete(Cursor);
end;
{--------}
function TDList.Examine(Cursor : TListCursor) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascExamineEdges);
  {$ENDIF}
  Result := PNode(Cursor)^.Data;
end;
{--------}
procedure TDList.InsertAfter(Cursor : TListCursor; aData : pointer);
var
  Node : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsSorted, ascIsSortedList);
  EZAssert(not IsAfterLast(Cursor), ascInsertEdges);
  {$ENDIF}
  Node := acNewNode(aData);
  Node^.FLink := PNode(Cursor)^.FLink;
  Node^.BLink:= PNode(Cursor);
  PNode(Cursor)^.FLink := Node;
  Node^.FLink^.BLink := Node;
end;
{--------}
procedure TDList.InsertBefore(Cursor : TListCursor; aData : pointer);
begin
  {$IFDEF DEBUG}
  EZAssert(not IsSorted, ascIsSortedList);
  EZAssert(not IsBeforeFirst(Cursor), ascInsertEdges);
  {$ENDIF}
  dlInsertBeforePrim(Cursor, aData);
end;
{--------}
procedure TDList.InsertSorted(aData : pointer);
var
  Walker    : TListCursor;
begin
  {$IFDEF DEBUG}
  EZAssert(IsSorted, ascIsNotSortedList);
  {$ENDIF}
  if Search(Walker, aData) then
    RaiseError(escInsertDup);
  dlInsertBeforePrim(Walker, aData);
end;
{--------}
function TDList.IsAfterLast(Cursor : TListCursor) : boolean;
begin
  Result := (PNode(Cursor) = dlAL);
end;
{--------}
function TDList.IsBeforeFirst(Cursor : TListCursor) : boolean;
begin
  Result := (PNode(Cursor) = dlBF);
end;
{--------}
function TDList.Iterate(Action : TIterator; Backwards : boolean;
                         ExtraData : pointer) : pointer;
var
  Walker : TListCursor;
begin
  if Backwards then begin
    Walker := Prev(SetAfterLast);
    while not IsBeforeFirst(Walker) do
      if Action(Self, Examine(Walker), ExtraData) then
        Walker := Prev(Walker)
      else begin
        Result := Examine(Walker);
        Exit;
      end;
  end
  else {not Backwards} begin
    Walker := Next(SetBeforeFirst);
    while not IsAfterLast(Walker) do
      if Action(Self, Examine(Walker), ExtraData) then
        Walker := Next(Walker)
      else begin
        Result := Examine(Walker);
        Exit;
      end;
  end;
  Result := nil;
end;
{--------}
procedure TDList.Join(Cursor : TListCursor; List : TDList);
var
  Walker : TListCursor;
  Data   : pointer;
begin
  if not Assigned(List) then Exit;

  {$IFDEF DEBUG}
  EZAssert(not IsAfterLast(Cursor), ascCannotJoinHere);
  EZAssert(List.IsDataOwner = IsDataOwner, ascCannotJoinData);
  {$ENDIF}

  if not List.IsEmpty then begin
    {if we are sorted, add new nodes in sorted order}
    if {Self.}IsSorted then begin
      Walker := List.Next(List.SetBeforeFirst);
      while not List.IsAfterLast(Walker) do begin
        Data := List.Examine(Walker);
        Walker := List.Delete(Walker);
        InsertSorted(Data);
      end;
    end
    else begin
      List.dlAL^.BLink^.FLink := PNode(Cursor)^.FLink;
      PNode(Cursor)^.FLink^.BLink := List.dlAL^.BLink;
      PNode(Cursor)^.FLink := List.dlBF^.FLink;
      PNode(Cursor)^.FLink^.BLink := PNode(Cursor);
      inc(acCount, List.Count);
      {patch up List to be empty}
      with List do begin
        dlBF^.FLink := dlAL;
        dlAL^.BLink := dlBF;
        acCount := 0;
      end;
    end;
  end;
  List.Free;
end;
{--------}
function TDList.Next(Cursor : TListCursor) : TListCursor;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsAfterLast(Cursor), ascAlreadyAtEnd);
  {$ENDIF}
  Result := TListCursor(PNode(Cursor)^.FLink);
end;
{--------}
function TDList.Prev(Cursor : TListCursor) : TListCursor;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsBeforeFirst(Cursor), ascAlreadyAtStart);
  {$ENDIF}
  Result := TListCursor(PNode(Cursor)^.BLink);
end;
{--------}
function TDList.Replace(Cursor : TListCursor; aData : pointer) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascReplaceEdges);
  {$ENDIF}
  if IsSorted then begin
    Result := Examine(Cursor);
    Delete(Cursor);
    InsertSorted(aData);
  end
  else with PNode(Cursor)^ do begin
    Result := Data;
    Data := aData;
  end;
end;
{--------}
function TDList.Search(var Cursor : TListCursor; aData : pointer) : boolean;
var
  Walker       : TListCursor;
  CompResult   : integer;
  StillLooking : boolean;
  Found        : boolean;
  i            : longint;
  L, R, M      : longint;
  CursorNumber : longint;
  StartNumber  : longint;
  TempCursor   : PNode;
  StartCursor  : PNode;
begin
  Walker := SetBeforeFirst;
  if IsSorted then begin
    if (Count = 0) then begin
      Result := false;
      Cursor := SetAfterLast;
      Exit;
    end;
    L := 0;
    R := pred(Count);
    CursorNumber := -1;
    StartNumber := -1;
    StartCursor := dlBF;
    TempCursor := dlBF;
    while (L <= R) do begin
      M := (L + R) shr 1;
      if (CursorNumber <= M) then begin
        StartCursor := TempCursor;
        StartNumber := CursorNumber;
      end
      else {CursorNumber > M} begin
        TempCursor := StartCursor;
      end;
      for i := 1 to (M - StartNumber) do
        TempCursor := TempCursor^.FLink;
      CursorNumber := M;
      CompResult := Compare(aData, TempCursor^.Data);
      if (CompResult < 0) then
        R := pred(M)
      else if (CompResult > 0) then
        L := succ(M)
      else begin
        Result := true;
        Cursor := TListCursor(TempCursor);                     {!!.02}
        Exit;
      end;
    end;
    Result := false;
    Cursor := TListCursor(TempCursor);
    if (L > CursorNumber) then
      Cursor := Next(Cursor)
    else if (L < CursorNumber) then
      Cursor := Prev(Cursor);
  end
  else {the list is not sorted} begin
    StillLooking := true;
    Found := false;
    while StillLooking and (not Found) do begin
      Walker := Next(Walker);
      if IsAfterLast(Walker) then
        StillLooking := false
      else
        Found := (Compare(aData, Examine(Walker)) = 0);
    end;
    Cursor := Walker;
    Result := Found;
  end;
end;
{--------}
function TDList.SetBeforeFirst : TListCursor;
begin
  Result := TListCursor(dlBF);
end;
{--------}
function TDList.SetAfterLast : TListCursor;
begin
  Result := TListCursor(dlAL);
end;
{--------}
function TDList.Split(Cursor : TListCursor) : TDList;
var
  TempCount : longint;
  NewList   : TDList;
  Walker    : TListCursor;
  LastNodeLeftBehind,
  JoinNode,
  LastNode  : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascSplitEdges);
  {$ENDIF}
  NewList := TDList(TAbstractContainerClass(ClassType).Create(IsDataOwner));
  NewList.Compare := Compare;
  NewList.DupData := DupData;
  NewList.DisposeData := DisposeData;
  NewList.IsSorted := IsSorted;
  Result := NewList;

  LastNodeLeftBehind := PNode(Cursor)^.BLink;

  TempCount := 0;
  Walker := Cursor;
  JoinNode := PNode(Walker);
  while not IsAfterLast(Walker) do begin
    inc(TempCount);
    Walker := Next(Walker);
  end;

  LastNode := PNode(Prev(Walker));

  JoinNode^.BLink := NewList.dlBF;
  NewList.dlBF^.FLink := JoinNode;
  LastNode^.FLink := NewList.dlAL;
  NewList.dlAL^.BLink := LastNode;
  NewList.acCount := TempCount;

  dec(acCount, TempCount);
  LastNodeLeftBehind^.FLink := dlAL;
  dlAL^.BLink := LastNodeLeftBehind;
end;
{====================================================================}


{$IFDEF ThreadsExist}
{===TThreadsafeDList=================================================}
constructor TThreadsafeDList.Create(aDataOwner : boolean);
begin
  inherited Create;
  dlResLock := TezResourceLock.Create;
  dlDList := TDList.Create(aDataOwner);
end;
{--------}
destructor TThreadsafeDList.Destroy;
begin
  dlDList.Free;
  dlResLock.Free;
  inherited Destroy;
end;
{--------}
function TThreadsafeDList.AcquireAccess : TDList;
begin
  dlResLock.Lock;
  Result := dlDList;
end;
{--------}
procedure TThreadsafeDList.ReleaseAccess;
begin
  dlResLock.Unlock;
end;
{====================================================================}
{$ENDIF}

end.