Changeset 312 for Generics/TemplateGenerics/Generic

Timestamp:

Jan 9, 2012, 2:22:31 PM (12 years ago)

Author:

chronos

Message:

• Modified: TGStream is now implemented. TMemoryStreamByte have additional methods usable for byte streams.
• Added: Few other missing methods in TGList.

Location:

Generics/TemplateGenerics/Generic

Files:

• GenericList.inc (modified) (7 diffs)
• GenericListObject.inc (modified) (1 diff)
• GenericListString.inc (modified) (1 diff)
• GenericQueue.inc (modified) (4 diffs)
• GenericStream.inc (modified) (2 diffs)

Generics/TemplateGenerics/Generic/GenericList.inc

@@ -1 +1 @@
 {$IFDEF INTERFACE}
+
+  // TGList implemented using templates
+  // - item operations (Add, Insert, ReplaceArray, Get, Set, IndexOf,
+  //   Extract, Delete, Exchange)
+  // - item range operations (DeleteItems, InsertItems, ReplaceItems,
+  //   Move, Fill)
+  // - other TGList operations (AddList, InsertList,
+  //   ReplaceList, GetList, IndexOfList)
+  // - dynamic array operations (AddArray, InsertArray,
+  //   ReplaceArray, GetArray, IndexOfArray)
+  // - all items operations (Clear, Reverse, Sort)
 
   TGList = class;
@@ -41 +52 @@
     property First: TGListItem read GetFirst write SetFirst;
     procedure Fill(Start, Count: TGListIndex; Value: TGListItem);
-    function GetArray: TGListItemArray;
+    function GetArray(Index, ACount: TGListIndex): TGListItemArray;
+    procedure GetList(List: TGList; Index, ACount: TGListIndex);
     function Implode(Separator: string; Converter: TGListToStringConverter): string;
     function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual;
     function IndexOfList(List: TGList; Start: TGListIndex = 0): TGListIndex;
+    function IndexOfArray(Values: array of TGListItem; Start: TGListIndex = 0): TGListIndex;
     procedure Insert(Index: TGListIndex; Item: TGListItem);
     procedure InsertList(Index: TGListIndex; List: TGList);
     procedure InsertArray(Index: TGListIndex; Values: array of TGListItem);
+    procedure InsertCount(Index: TGListIndex; ACount: TGListIndex);
     procedure Move(CurIndex, NewIndex: TGListIndex);
     procedure MoveItems(CurIndex, NewIndex, Count: TGListIndex);
     function Remove(Item: TGListItem): TGListIndex;
     procedure Reverse;
+    procedure ReplaceArray(Index: TGListIndex; Values: array of TGListItem);
     procedure ReplaceList(Index: TGListIndex; Source: TGList);
     procedure ReplaceListPart(Index: TGListIndex; Source: TGList;
@@ -83 +98 @@
 end;
 
+procedure TGList.ReplaceArray(Index: TGListIndex; Values: array of TGListItem);
+var
+  I: TGListIndex;
+begin
+  I := 0;
+  while I < Length(Values) do begin
+    Items[Index + I] := Values[I];
+    I := I + 1;
+  end;
+end;
+
 procedure TGList.ReplaceList(Index: TGListIndex; Source: TGList);
 var
@@ -165 +191 @@
 end;
 
-function TGList.GetArray: TGListItemArray;
+function TGList.GetArray(Index, ACount: TGListIndex): TGListItemArray;
 var
   I: Integer;
 begin
-  SetLength(Result, Count);
+  SetLength(Result, ACount);
   I := 0;
   while I < Count do begin
-    Result[I] := FItems[I];
-    I := I + 1;
-  end;
+    Result[I] := FItems[Index + I];
+    I := I + 1;
+  end;
+end;
+
+procedure TGList.GetList(List: TGList; Index, ACount: TGListIndex);
+begin
+  List.Clear;
+  List.AddListPart(Self, Index, ACount);
 end;
 
@@ -258 +290 @@
 procedure TGList.Insert(Index: TGListIndex; Item: TGListItem);
 begin
-  if (Index < 0) or (Index > FCount ) then
+  if (Index < 0) or (Index > FCount) then
     raise EListError.CreateFmt(SListIndexError, [Index]);
-  if FCount = Capacity then SetCapacityOptimized(Capacity + 1);
+  InsertCount(Index, 1);
+  FItems[Index] := Item;
+end;
+
+procedure TGList.InsertList(Index: TGListIndex; List: TGList);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  InsertCount(Index, List.Count);
+  ReplaceList(Index, List);
+end;
+
+procedure TGList.InsertArray(Index: TGListIndex; Values: array of TGListItem);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  InsertCount(Index, Length(Values));
+  ReplaceArray(Index, Values);
+end;
+
+procedure TGList.InsertCount(Index: TGListIndex; ACount: TGListIndex);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  Count := Count + ACount;
   if Index < FCount then
-    System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TGListItem));
-  FItems[Index] := Item;
-  FCount := FCount + 1;
-end;
-
-procedure TGList.InsertList(Index: TGListIndex; List: TGList);
-var
-  I: TGListIndex;
-begin
-  I := 0;
-  while (I < List.Count) do begin
-    Insert(Index + I, List[I]);
-    I := I + 1;
-  end;
+    System.Move(FItems[Index], FItems[Index + ACount], (FCount - ACount - Index) * SizeOf(TGListItem));
 end;
 
@@ -297 +340 @@
 end;
 
+function TGList.IndexOfArray(Values: array of TGListItem; Start: TGListIndex): TGListIndex;
+var
+  I: TGListIndex;
+begin
+  if Length(Values) > 0 then begin
+    Result := IndexOf(Values[0], Start);
+    if Result <> -1 then begin
+      I := 1;
+      while I < Length(Values) do begin
+        if not CompareMem(Addr(FItems[Result + I]), Addr(Values[I]), SizeOf(TGListItem)) then begin
+          Result := -1;
+          Break;
+        end;
+        I := I + 1;
+      end;
+    end;
+  end else Result := -1;
+end;
+
 function TGList.GetLast: TGListItem;
 begin
@@ -438 +500 @@
 end;
 
-procedure TGList.InsertArray(Index: TGListIndex; Values: array of TGListItem);
-var
-  I: TGListIndex;
-begin
-  I := 0;
-  while I <= High(Values) do begin
-    Insert(Index + I, Values[I]);
-    I := I + 1;
-  end;
-end;
-
 function TGList.Implode(Separator: string; Converter: TGListToStringConverter): string;
 var

Generics/TemplateGenerics/Generic/GenericListObject.inc

@@ -22 +22 @@
     procedure Clear; override;
     procedure Assign(Source: TGList); override;
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
   end;

Generics/TemplateGenerics/Generic/GenericListString.inc

@@ -19 +19 @@
     procedure Assign(Source: TGList); override;
     function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; override;
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
   end;

Generics/TemplateGenerics/Generic/GenericQueue.inc

@@ -11 +11 @@
 {$I 'GenericList.inc'}
 
-  // TGQueue<TSetIndex, TSetItem> = class(TGList)
+  // TGQueue<TQueueIndex, TQueueItem> = class(TGList)
   TGQueue = class
   private
     FList: TGList;
+    function GetCount: TGQueueIndex;
   public
     procedure Enqueue(Value: TGQueueItem);
+    procedure EnqueueArray(Values: array of TGQueueItem);
+    procedure EnqueueList(List: TGList);
     function Dequeue: TGQueueItem;
     function Peek: TGQueueItem;
@@ -22 +25 @@
     destructor Destroy; override;
     property List: TGList read FList;
+    property Count: TGQueueIndex read GetCount;
   end;
 
@@ -54 +58 @@
 end;
 
+procedure TGQueue.EnqueueArray(Values: array of TGQueueItem);
+begin
+  FList.AddArray(Values);
+end;
+
+procedure TGQueue.EnqueueList(List: TGList);
+begin
+  FList.AddList(List);
+end;
+
 function TGQueue.Peek: TGQueueItem;
 begin
@@ -75 +89 @@
 end;
 
+function TGQueue.GetCount: TGQueueIndex;
+begin
+  Result := FList.Count;
+end;
+
 {$UNDEF IMPLEMENTATION}
 {$ENDIF}

Generics/TemplateGenerics/Generic/GenericStream.inc

@@ -1 +1 @@
 {$IFDEF INTERFACE}
 
-TGStreamDataEvent = procedure (Item: TGStreamItem) of object;
+TGStreamItemArray = array of TGStreamItem;
 
-// TGStream<TStreamItem> = class
+// TGStream<TGStreamIndex, TGStreamItem> = class
 TGStream = class
-  FOnData: TGStreamDataEvent;
-  procedure Write(Item: TStreamItem);
-  property OnData: TGStreamDataEvent read FOnData write FOnData;
+  procedure SetSize(AValue: TGStreamIndex);
+  function GetSize: TGStreamIndex;
+  procedure SetPosition(AValue: TGStreamIndex);
+  function GetPosition: TGStreamIndex;
+public
+  procedure Assign(Source: TGStream); virtual;
+  procedure Write(Item: TGStreamItem); virtual; abstract;
+  procedure WriteArray(Item: array of TGStreamItem); virtual; abstract;
+  function Read: TGStreamItem; virtual; abstract;
+  function ReadArray(Count: TGStreamIndex): TGStreamItemArray; virtual; abstract;
+  function Insert(Count: TGStreamIndex): TGStreamIndex; virtual; abstract;
+  function Remove(Count: TGStreamIndex): TGStreamIndex; virtual; abstract;
+  function Seek(Offset: TGStreamIndex; Origin: TSeekOrigin = soCurrent):
+    TGStreamIndex; virtual; abstract;
+  constructor Create; virtual;
+  property Position: TGStreamIndex read GetPosition write SetPosition;
+  property Size: TGStreamIndex read GetSize write SetSize;
 end;
 
@@ -15 +29 @@
 {$IFDEF IMPLEMENTATION}
 
-procedure TGStream.Write(Item: TGStreamItem);
+procedure TGStream.Assign(Source: TGStream);
 begin
-  if Assigned(FOnData) then
-    FOnData(Item);
 end;
 
+procedure TGStream.SetPosition(AValue: TGStreamIndex);
+begin
+  Seek(AValue, soBegin);
+end;
+
+function TGStream.GetPosition: TGStreamIndex;
+begin
+  Result := Seek(0, soCurrent);
+end;
+
+procedure TGStream.SetSize(AValue: TGStreamIndex);
+var
+  StreamSize: TGStreamIndex;
+  OldPosition: TGStreamIndex;
+begin
+  OldPosition := Seek(0, soCurrent);
+  StreamSize := Size;
+  if AValue > StreamSize then begin
+    Seek(StreamSize, soBegin);
+    Insert(AValue - StreamSize);
+  end else
+  if AValue < StreamSize then begin
+    Seek(AValue, soBegin);
+    Remove(StreamSize - AValue);
+  end;
+  Position := OldPosition;
+end;
+
+function TGStream.GetSize: TGStreamIndex;
+var
+  OldPosition: Integer;
+begin
+  OldPosition := Position;
+  Result := Seek(0, soEnd);
+  Position := OldPosition;
+end;
+
+constructor TGStream.Create;
+begin
+  inherited;
+end;
 
 {$UNDEF IMPLEMENTATION}