unit uutlListBase; {$mode objfpc}{$H+} interface uses Classes, SysUtils, uutlArrayContainer, uutlInterfaces, uutlEnumerator; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlListBase = class( specialize TutlArrayContainer , specialize IEnumerable , specialize IutlEnumerable) public type IEnumerator = specialize IEnumerator; IutlEnumerator = specialize IutlEnumerator; private type TEnumeratorAction = ( eaAdded, eaRemoved, eaReallocated ); TEnumerator = class( specialize TutlMemoryEnumerator , IEnumerator , IutlEnumerator) private fOwner: TutlListBase; fCurrentIsInvalid: Boolean; fNext: TEnumerator; fPrev: TEnumerator; public { IEnumerator } function GetCurrent: T; override; function InternalMoveNext: Boolean; override; procedure InternalReset; override; {$IFDEF UTL_ENUMERATORS} public { IutlEnumerator } function Reverse: IutlEnumerator; override; {$ENDIF} public procedure Update(const aIndex: Integer; const aAction: TEnumeratorAction); constructor Create(const aOwner: TutlListBase; const aReversed: Boolean); reintroduce; destructor Destroy; override; end; strict private fCount: Integer; fFirstEnumerator: TEnumerator; fLastEnumerator: TEnumerator; procedure UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction); protected function GetCount: Integer; override; procedure SetCount(const aValue: Integer); override; function GetItem (const aIndex: Integer): T; virtual; procedure SetItem (const aIndex: Integer; aValue: T); virtual; procedure SetCapacity (const aValue: integer); override; procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual; public { IEnumerable } function GetEnumerator: IEnumerator; public { IutlEnumerable } function GetUtlEnumerator: IutlEnumerator; public property Count; property IsEmpty; property Capacity; property CanShrink; property CanExpand; property OwnsItems; procedure Clear; virtual; procedure ShrinkToFit; constructor Create(const aOwnsItems: Boolean); destructor Destroy; override; end; implementation uses uutlCommon; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlListBase.TEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.TEnumerator.GetCurrent: T; begin if fCurrentIsInvalid then raise EInvalidOperation.Create('current item was deleted, move on with ''MoveNext'' before accessing ''Current'''); result := inherited GetCurrent; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.TEnumerator.InternalMoveNext: Boolean; begin result := inherited InternalMoveNext; fCurrentIsInvalid := false; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.TEnumerator.InternalReset; begin First := 0; Last := fOwner.Count-1; if (Last >= First) then Memory := fOwner.GetInternalItem(0) else Memory := nil; inherited InternalReset; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// {$IFDEF UTL_ENUMERATORS} function TutlListBase.TEnumerator.Reverse: IutlEnumerator; begin result := TEnumerator.Create(fOwner, not Reversed); end; {$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.TEnumerator.Update(const aIndex: Integer; const aAction: TEnumeratorAction); begin case aAction of eaAdded: begin if (aIndex <= Current) then Current := Current + 1; Last := Last + 1; end; eaRemoved: begin fCurrentIsInvalid := (aIndex = Current); if (aIndex < Current) or ( (aIndex = Current) and not Reversed) then Current := Current - 1; Last := Last - 1; end; eaReallocated: begin if (fOwner.Count > 0) then Memory := fOwner.GetInternalItem(0) else Memory := nil; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlListBase.TEnumerator.Create(const aOwner: TutlListBase; const aReversed: Boolean); begin if not Assigned(aOwner) then raise EArgumentNilException.Create('aOwner'); fOwner := aOwner; if not Assigned(fOwner.fLastEnumerator) then begin fPrev := nil; fNext := nil; fOwner.fFirstEnumerator := self; fOwner.fLastEnumerator := self; end else begin fPrev := fOwner.fLastEnumerator; fNext := nil; fOwner.fLastEnumerator.fNext := self; fOwner.fLastEnumerator := self; end; inherited Create(nil, aReversed, 0, -1); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlListBase.TEnumerator.Destroy; begin if (fOwner.fFirstEnumerator = self) then fOwner.fFirstEnumerator := fNext; if (fOwner.fLastEnumerator = self) then fOwner.fLastEnumerator := fPrev; if Assigned(fPrev) then fPrev.fNext := fNext; if Assigned(fNext) then fNext.fPrev := fPrev; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.UpdateEnumerator(const aIndex: Integer; const aAction: TEnumeratorAction); var e: TEnumerator; begin e := fFirstEnumerator; while Assigned(e) do begin e.Update(aIndex, aAction); e := e.fNext; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.GetCount: Integer; begin result := fCount; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.SetCount(const aValue: Integer); begin if (aValue > Capacity) then Capacity := aValue; fCount := aValue; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.GetItem(const aIndex: Integer): T; begin if (aIndex < 0) or (aIndex >= Count) then raise EOutOfRangeException.Create(aIndex, 0, Count-1); result := GetInternalItem(aIndex)^; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.SetItem(const aIndex: Integer; aValue: T); var p: PT; begin if (aIndex < 0) or (aIndex >= Count) then raise EOutOfRangeException.Create(aIndex, 0, Count-1); p := GetInternalItem(aIndex); Release(p^, true); p^ := aValue; end; procedure TutlListBase.SetCapacity(const aValue: integer); begin inherited SetCapacity(aValue); UpdateEnumerator(0, eaReallocated); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T); var p: PT; begin if (aIndex < 0) or (aIndex > fCount) then raise EOutOfRangeException.Create(aIndex, 0, fCount); if (fCount = Capacity) then Expand; p := GetInternalItem(aIndex); if (aIndex < fCount) then System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T)); FillByte(p^, SizeOf(T), 0); // zero new item (to suppress _release call if it's an interface) p^ := aValue; inc(fCount); UpdateEnumerator(aIndex, eaAdded); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var p: PT; begin if (aIndex < 0) or (aIndex >= fCount) then raise EOutOfRangeException.Create(aIndex, 0, fCount-1); dec(fCount); p := GetInternalItem(aIndex); Release(p^, aFreeItem); System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex)); if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used SetCapacity(Capacity shr 1); // set to 50% Capacity FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0); UpdateEnumerator(aIndex, eaRemoved); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.GetEnumerator: IEnumerator; begin result := TEnumerator.Create(self, false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.GetUtlEnumerator: IutlEnumerator; begin result := TEnumerator.Create(self, false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.Clear; begin while (Count > 0) do begin dec(fCount); Release(GetInternalItem(fCount)^, true); end; fCount := 0; if CanShrink then ShrinkToFit; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.ShrinkToFit; begin Shrink(true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlListBase.Create(const aOwnsItems: Boolean); begin inherited Create(aOwnsItems); fCount := 0; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlListBase.Destroy; begin Clear; inherited Destroy; end; end.