|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332 |
- unit uutlListBase;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils,
- uutlArrayContainer, uutlInterfaces, uutlEnumerator;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlListBase<T> = class(
- specialize TutlArrayContainer<T>
- , specialize IEnumerable<T>
- , specialize IutlEnumerable<T>)
-
- public type
- IEnumerator = specialize IEnumerator<T>;
- IutlEnumerator = specialize IutlEnumerator<T>;
-
- private type
- TEnumeratorAction = (
- eaAdded,
- eaRemoved,
- eaReallocated
- );
-
- TEnumerator = class(
- specialize TutlMemoryEnumerator<T>
- , 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.
-
|