You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

212 line
7.3 KiB

  1. unit uutlListBase;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils,
  6. uutlArrayContainer, uutlInterfaces, uutlEnumerator;
  7. type
  8. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  9. generic TutlListBase<T> = class(
  10. specialize TutlArrayContainer<T>
  11. , specialize IEnumerable<T>
  12. , specialize IutlEnumerable<T>)
  13. public type
  14. IEnumerator = specialize IEnumerator<T>;
  15. IutlEnumerator = specialize IutlEnumerator<T>;
  16. private type
  17. TEnumerator = class(
  18. specialize TutlMemoryEnumerator<T>
  19. , IEnumerator
  20. , IutlEnumerator)
  21. private
  22. fOwner: TutlListBase;
  23. public { IEnumerator }
  24. procedure InternalReset; override;
  25. public
  26. constructor Create(const aOwner: TutlListBase); reintroduce;
  27. end;
  28. strict private
  29. fCount: Integer;
  30. protected
  31. function GetCount: Integer; override;
  32. procedure SetCount(const aValue: Integer); override;
  33. function GetItem (const aIndex: Integer): T; virtual;
  34. procedure SetItem (const aIndex: Integer; aValue: T); virtual;
  35. procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
  36. procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;
  37. public { IEnumerable }
  38. function GetEnumerator: IEnumerator;
  39. public { IutlEnumerable }
  40. function GetUtlEnumerator: IutlEnumerator;
  41. public
  42. property Count;
  43. property IsEmpty;
  44. property Capacity;
  45. property CanShrink;
  46. property CanExpand;
  47. property OwnsItems;
  48. procedure Clear; virtual;
  49. procedure ShrinkToFit;
  50. constructor Create(const aOwnsItems: Boolean);
  51. destructor Destroy; override;
  52. end;
  53. implementation
  54. uses
  55. uutlCommon;
  56. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  57. //TutlListBase.TEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  58. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  59. procedure TutlListBase.TEnumerator.InternalReset;
  60. begin
  61. First := 0;
  62. Last := fOwner.Count-1;
  63. if (Last >= First)
  64. then Memory := fOwner.GetInternalItem(0)
  65. else Memory := nil;
  66. inherited InternalReset;
  67. end;
  68. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  69. constructor TutlListBase.TEnumerator.Create(const aOwner: TutlListBase);
  70. begin
  71. if not Assigned(aOwner) then
  72. raise EArgumentNilException.Create('aOwner');
  73. fOwner := aOwner;
  74. inherited Create(nil, 0);
  75. end;
  76. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  77. //TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  78. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  79. function TutlListBase.GetCount: Integer;
  80. begin
  81. result := fCount;
  82. end;
  83. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  84. procedure TutlListBase.SetCount(const aValue: Integer);
  85. begin
  86. if (aValue < Capacity) then
  87. Capacity := aValue;
  88. fCount := aValue;
  89. end;
  90. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  91. function TutlListBase.GetItem(const aIndex: Integer): T;
  92. begin
  93. if (aIndex < 0) or (aIndex >= Count) then
  94. raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  95. result := GetInternalItem(aIndex)^;
  96. end;
  97. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  98. procedure TutlListBase.SetItem(const aIndex: Integer; aValue: T);
  99. var
  100. p: PT;
  101. begin
  102. if (aIndex < 0) or (aIndex >= Count) then
  103. raise EOutOfRangeException.Create(aIndex, 0, Count-1);
  104. p := GetInternalItem(aIndex);
  105. Release(p^, true);
  106. p^ := aValue;
  107. end;
  108. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  109. procedure TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
  110. var
  111. p: PT;
  112. begin
  113. if (aIndex < 0) or (aIndex > fCount) then
  114. raise EOutOfRangeException.Create(aIndex, 0, fCount);
  115. if (fCount = Capacity) then
  116. Expand;
  117. p := GetInternalItem(aIndex);
  118. if (aIndex < fCount) then
  119. System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
  120. p^ := aValue;
  121. inc(fCount);
  122. end;
  123. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  124. procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
  125. var
  126. p: PT;
  127. begin
  128. if (aIndex < 0) or (aIndex >= fCount) then
  129. raise EOutOfRangeException.Create(aIndex, 0, fCount-1);
  130. dec(fCount);
  131. p := GetInternalItem(aIndex);
  132. Release(p^, aFreeItem);
  133. System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
  134. if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used
  135. SetCapacity(Capacity shr 1); // set to 50% Capacity
  136. FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
  137. end;
  138. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  139. function TutlListBase.GetEnumerator: IEnumerator;
  140. begin
  141. result := TEnumerator.Create(self);
  142. end;
  143. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  144. function TutlListBase.GetUtlEnumerator: specialize IutlEnumerator<T>;
  145. begin
  146. result := TEnumerator.Create(self);
  147. end;
  148. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  149. procedure TutlListBase.Clear;
  150. begin
  151. while (Count > 0) do begin
  152. dec(fCount);
  153. Release(GetInternalItem(fCount)^, true);
  154. end;
  155. fCount := 0;
  156. if CanShrink then
  157. ShrinkToFit;
  158. end;
  159. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  160. procedure TutlListBase.ShrinkToFit;
  161. begin
  162. Shrink(true);
  163. end;
  164. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  165. constructor TutlListBase.Create(const aOwnsItems: Boolean);
  166. begin
  167. inherited Create(aOwnsItems);
  168. fCount := 0;
  169. end;
  170. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  171. destructor TutlListBase.Destroy;
  172. begin
  173. Clear;
  174. inherited Destroy;
  175. end;
  176. end.