Ignore:
Timestamp:
Oct 28, 2010, 4:52:53 PM (14 years ago)
Author:
george
Message:
  • Added: Generic class TGDictionary and TGPair. Specialized class TDictionaryString.
Location:
Generics/TemplateGenerics/Generic
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Generics/TemplateGenerics/Generic/DictionaryImplementation.tpl

    r71 r72  
    1 uses
    2   RtlConsts;
    31
    4 // Used instead of System.Move form because of error: Identifier "System" not found
    5 procedure SystemMove(const Source; var Dest; Count: SizeInt);
     2{$INCLUDE 'ListImplementation.tpl'}
     3function TGDictionary.GetKey(Index: TDictionaryIndex): TDictionaryKey;
    64begin
    7   Move(Source, Dest, Count);
     5  Result := Items[Index].Key;
    86end;
    97
    10 { TGList }
    11 
    12 function TGList.GetCapacity: TListIndex;
     8function TGDictionary.GetValue(Key: TDictionaryKey): TDictionaryValue;
    139begin
    14   Result := Length(FItems);
     10  Result := Items[SearchKey(Key)].Value;
    1511end;
    1612
    17 procedure TGList.SetCapacity(const AValue: TListIndex);
     13procedure TGDictionary.PutKey(Index: TDictionaryIndex;
     14  const AValue: TDictionaryKey);
     15var
     16  Item: TGPair;
    1817begin
    19   SetLength(FItems, AValue);
     18  //Items[Index].Key := AValue;
     19  Item := Items[Index];
     20  Item.Key := AValue;
     21  Items[Index] := Item;
    2022end;
    2123
    22 function TGList.Get(Index: TListIndex): TListItem;
     24procedure TGDictionary.PutValue(Key: TDictionaryKey;
     25  const AValue: TDictionaryValue);
     26var
     27  Item: TGPair;
     28  Index: TDictionaryIndex;
    2329begin
    24   Result := FItems[Index];
     30  //Items[SearchKey(Index)].Value := AValue;
     31  Index := SearchKey(Key);
     32  Item := Items[Index];
     33  Item.Value := AValue;
     34  Items[Index] := Item;
    2535end;
    2636
    27 function TGList.GetCount: TListIndex;
     37function TGDictionary.SearchKey(Key: TDictionaryKey): TDictionaryIndex;
    2838begin
    29   Result := FCount;
    30 end;
    31 
    32 procedure TGList.Put(Index: TListIndex; const AValue: TListItem);
    33 begin
    34   FItems[Index] := AValue;
    35 end;
    36 
    37 procedure TGList.SetCount(const AValue: TListIndex);
    38 begin
    39   SetLength(FItems, AValue);
    40   FCount := AValue;
    41 end;
    42 
    43 procedure TGList.QuickSort(L, R: TListIndex; Compare: TGListSortCompare);
    44 var
    45   I, J: TListIndex;
    46   P, Q: TListItem;
    47 begin
    48  repeat
    49    I := L;
    50    J := R;
    51    P := FItems[ (L + R) div 2 ];
    52    repeat
    53      while Compare(P, FItems[I]) > 0 do
    54        I := I + 1;
    55      while Compare(P, FItems[J]) < 0 do
    56        J := J - 1;
    57      If I <= J then
    58      begin
    59        Q := FItems[I];
    60        FItems[I] := FItems[J];
    61        FItems[J] := Q;
    62        I := I + 1;
    63        J := J - 1;
    64      end;
    65    until I > J;
    66    if L < J then
    67      QuickSort(L, J, Compare);
    68    L := I;
    69   until I >= R;
    70 end;
    71 
    72 procedure TGList.Assign(List: TGList);
    73 var
    74   I: Integer;
    75 begin
    76   Count := List.Count;
    77   I := 0;
    78   while I < Count do begin
    79     Items[I] := List[I];
    80     I := I + 1;
     39  Result := 0;
     40  while Result < Count do begin
     41    if Items[Result].Key = Key then begin
     42      Break;
     43    end;
     44    Result := Result + 1;
    8145  end;
    8246end;
    8347
    84 procedure TGList.Expand;
     48procedure TGDictionary.Add(Key: TDictionaryKey; Value: TDictionaryValue);
    8549var
    86   IncSize: TListIndex;
     50  NewPair: TGPair;
    8751begin
    88   if FCount = Capacity then begin
    89     IncSize := 4;
    90     if Capacity > 3 then IncSize := IncSize + 4;
    91     if Capacity > 8 then IncSize := IncSize + 8;
    92     if Capacity > 63 then IncSize := IncSize + Capacity shr 2;
    93     Capacity := Capacity + IncSize;
    94   end;
     52  NewPair.Key := Key;
     53  NewPair.Value := Value;
     54  inherited Add(NewPair);
    9555end;
    96 
    97 function TGList.Extract(Item: TListItem): TListItem;
    98 var
    99   I: TListIndex;
    100 begin
    101   I := IndexOf(Item);
    102   if I >= 0 then begin
    103     Result := Item;
    104     Delete(I);
    105   end else
    106     raise EListError.CreateFmt(SListIndexError, [0]);
    107 end;
    108 
    109 function TGList.First: TListItem;
    110 begin
    111   if FCount = 0 then
    112     raise EListError.CreateFmt(SListIndexError, [0])
    113   else
    114     Result := Items[0];
    115 end;
    116 
    117 function TGList.IndexOf(Item: TListItem): TListIndex;
    118 begin
    119   Result := 0;
    120   while (Result < FCount) and (FItems[Result] <> Item) do
    121     Result := Result + 1;
    122   if Result = FCount then Result := -1;
    123 end;
    124 
    125 procedure TGList.Insert(Index: TListIndex; Item: TListItem);
    126 begin
    127   if (Index < 0) or (Index > FCount ) then
    128     raise EListError.CreateFmt(SListIndexError, [Index]);
    129   if FCount = Capacity then Expand;
    130   if Index < FCount then
    131     SystemMove(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TListItem));
    132   FItems[Index] := Item;
    133   FCount := FCount + 1;
    134 end;
    135 
    136 procedure TGList.InsertList(Index: TListIndex; List: TGList);
    137 var
    138   I: TListIndex;
    139 begin
    140   I := 0;
    141   while (I < List.Count) do begin
    142     Insert(Index + I, List[I]);
    143     I := I + 1;
    144   end;
    145 end;
    146 
    147 function TGList.Last: TListItem;
    148 begin
    149   if FCount = 0 then
    150     raise EListError.CreateFmt(SListIndexError, [0])
    151   else
    152     Result := Items[FCount - 1];
    153 end;
    154 
    155 procedure TGList.Move(CurIndex, NewIndex: TListIndex);
    156 var
    157   Temp: TListItem;
    158 begin
    159   if ((CurIndex < 0) or (CurIndex > Count - 1)) then
    160     raise EListError.CreateFmt(SListIndexError, [CurIndex]);
    161   if ((NewIndex < 0) or (NewIndex > Count -1)) then
    162     raise EListError.CreateFmt(SlistIndexError, [NewIndex]);
    163   Temp := FItems[CurIndex];
    164   Delete(CurIndex);
    165   Insert(NewIndex, Temp);
    166 end;
    167 
    168 procedure TGList.MoveItems(CurIndex, NewIndex, Count: TListIndex);
    169 var
    170   S: Integer;
    171   D: Integer;
    172 begin
    173   if CurIndex < NewIndex then begin
    174     S := CurIndex + Count - 1;
    175     D := NewIndex + Count - 1;
    176     while S >= CurIndex do begin
    177       Move(S, D);
    178       S := S - 1;
    179       D := D - 1;
    180     end;
    181   end else
    182   if CurIndex > NewIndex then begin
    183     S := CurIndex;
    184     D := NewIndex;
    185     while S < (CurIndex + Count) do begin
    186       Move(S, D);
    187       S := S + 1;
    188       D := D + 1;
    189     end;
    190   end;
    191 end;
    192 
    193 procedure TGList.Swap(Index1, Index2: TListIndex);
    194 var
    195   Temp: TListItem;
    196 begin
    197   Temp := Items[Index1];
    198   Items[Index1] := Items[Index2];
    199   Items[Index2] := Temp;
    200 end;
    201 
    202 function TGList.Remove(Item: TListItem): TListIndex;
    203 begin
    204   Result := IndexOf(Item);
    205   if Result <> -1 then
    206     Delete(Result);
    207 end;
    208 
    209 (*function TGList.Equals(Obj: TObject): Boolean;
    210 var
    211   I: TListIndex;
    212 begin
    213   Result := Count = (Obj as TGList).Count;
    214   if Result then begin
    215     I := 0;
    216     while I < Count do begin
    217       if Items[I] <> (Obj as TGList)[I] then begin
    218         Result := False;
    219         Break;
    220       end;
    221       I := I + 1;
    222     end;
    223   end;
    224 end;*)
    225 
    226 procedure TGList.Reverse;
    227 var
    228   I: TListIndex;
    229 begin
    230   I := 0;
    231   while I < (Count div 2) do begin
    232     Swap(I, Count - 1 - I);
    233     I := I + 1;
    234   end;
    235 end;
    236 
    237 procedure TGList.Sort(Compare: TGListSortCompare);
    238 begin
    239   if FCount > 1 then
    240     QuickSort(0, FCount - 1, Compare);
    241 end;
    242 
    243 procedure TGList.SetArray(Values: array of TListItem);
    244 var
    245   I: TListIndex;
    246 begin
    247   Clear;
    248   I := 0;
    249   while I <= High(Values) do begin
    250     Add(Values[I]);
    251     I := I + 1;
    252   end;
    253 end;
    254 
    255 function TGList.Implode(Separator: string; Converter: TGListStringConverter): string;
    256 var
    257   I: TListIndex;
    258 begin
    259   Result := '';
    260   I := 0;
    261   while I < Count do begin
    262     Result := Result + Converter(Items[I]);
    263     if I < (Count - 1) then
    264       Result := Result + Separator;
    265     I := I + 1;
    266   end;
    267 end;
    268 
    269 function TGList.Add(Item: TListItem): TListIndex;
    270 begin
    271   if FCount = Capacity then
    272     Self.Expand;
    273   FItems[FCount] := Item;
    274   Result := FCount;
    275   FCount := FCount + 1;
    276 end;
    277 
    278 procedure TGList.AddList(List: TGList);
    279 var
    280   I: TListIndex;
    281 begin
    282   I := 0;
    283   while I < List.Count do begin
    284     Add(List[I]);
    285     I := I + 1;
    286   end;
    287 end;
    288 
    289 procedure TGList.Clear;
    290 begin
    291   Count := 0;
    292   Capacity := 0;
    293 end;
    294 
    295 procedure TGList.Delete(Index: TListIndex);
    296 begin
    297   if (Index < 0) or (Index >= FCount) then
    298     raise EListError.CreateFmt(SListIndexError, [Index]);
    299   FCount := FCount - 1;
    300   SystemMove(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TListItem));
    301   // Shrink the list if appropriate
    302   if (Capacity > 256) and (FCount < Capacity shr 2) then
    303   begin
    304     Capacity := Capacity shr 1;
    305   end;
    306 end;
    307 
    308 procedure TGList.DeleteItems(Index, Count: TListIndex);
    309 var
    310   I: TListIndex;
    311 begin
    312   I := 0;
    313   while I < Count do begin
    314     Delete(I);
    315     I := I + 1;
    316   end;
    317 end;
    318 
    319 procedure TGList.Exchange(Index1, Index2: TListIndex);
    320 var
    321   Temp: TListItem;
    322 begin
    323   if ((Index1 >= FCount) or (Index1 < 0)) then
    324     raise EListError.CreateFmt(SListIndexError, [Index1]);
    325   if ((Index2 >= FCount) or (Index2 < 0)) then
    326     raise EListError.CreateFmt(SListIndexError, [Index2]);
    327   Temp := FItems[Index1];
    328   FItems[Index1] := FItems[Index2];
    329   FItems[Index2] := Temp;
    330 end;

  • Generics/TemplateGenerics/Generic/DictionaryInterface.tpl

    r71 r72  
    11
    2   TGListSortCompare = function(const Item1, Item2: TListItem): Integer of object;
    3   TGListStringConverter = function(Item: TListItem): string;
    4   //TGListNotification = (lnAdded, lnExtracted, lnDeleted);
     2  TGDictionary = class;
    53
    6   // TGList<TListIndex, TListItem> = class
    7   TGList = class
     4  TGPair = record
     5    Key: TDictionaryKey;
     6    Value: TDictionaryValue;
     7  end;
     8
     9  TListIndex = TDictionaryIndex;
     10  TListItem = TGPair;
     11  {$INCLUDE 'ListInterface.tpl'}
     12
     13  // TGDictionary<TDictionaryIndex, TDictionaryKey, TDictionaryValue> = class(TGList)
     14  TGDictionary = class(TGList)
    815  private
    9     FItems: array of TListItem;
    10     FCount: TListIndex;
    11     function Get(Index: TListIndex): TListItem;
    12     function GetCount: TListIndex;
    13     function GetCapacity: TListIndex;
    14     procedure SetCapacity(const AValue: TListIndex);
    15     procedure Put(Index: TListIndex; const AValue: TListItem);
    16     procedure SetCount(const AValue: TListIndex);
    17     procedure QuickSort(L, R : TListIndex; Compare: TGListSortCompare);
    18     property Capacity: TListIndex read GetCapacity write SetCapacity;
     16    function GetKey(Index: TDictionaryIndex): TDictionaryKey;
     17    function GetValue(Key: TDictionaryKey): TDictionaryValue;
     18    procedure PutKey(Index: TDictionaryIndex; const AValue: TDictionaryKey);
     19    procedure PutValue(Key: TDictionaryKey; const AValue: TDictionaryValue);
    1920  public
    20     // All items
    21     procedure Reverse;
    22     procedure Clear;
    23     procedure Expand;
    24     procedure Sort(Compare: TGListSortCompare);
    25     function Implode(Separator: string; Converter: TGListStringConverter): string;
    26     // Many items
    27     procedure MoveItems(CurIndex, NewIndex, Count: TListIndex);
    28     procedure Swap(Index1, Index2: TListIndex);
    29     // One item
    30     function Add(Item: TListItem): TListIndex;
    31     procedure Delete(Index: TListIndex);
    32     procedure Exchange(Index1, Index2: TListIndex);
    33     function Extract(Item: TListItem): TListItem;
    34     function First: TListItem;
    35     function IndexOf(Item: TListItem): TListIndex;
    36     procedure Insert(Index: TListIndex; Item: TListItem);
    37     function Last: TListItem;
    38     procedure Move(CurIndex, NewIndex: TListIndex);
    39     function Remove(Item: TListItem): TListIndex;
    40     property Items[Index: TListIndex]: TListItem read Get write Put; default;
    41     // List
    42     procedure AddList(List: TGList);
    43     procedure Assign(List: TGList);
    44     procedure DeleteItems(Index, Count: TListIndex);
    45     //function Equals(Obj: TObject): Boolean; override;
    46     procedure InsertList(Index: TListIndex; List: TGList);
    47     // Other
    48     property Count: TListIndex read GetCount write SetCount;
    49     // Additional
    50     procedure SetArray(Values: array of TListItem);
     21    function SearchKey(Key: TDictionaryKey): TDictionaryIndex;
     22    procedure Add(Key: TDictionaryKey; Value: TDictionaryValue);
     23    property Values[Index: TDictionaryKey]: TDictionaryValue
     24      read GetValue write PutValue;
     25    property Keys[Index: TDictionaryIndex]: TDictionaryKey
     26      read GetKey write PutKey;
    5127  end;

  • Generics/TemplateGenerics/Generic/ListImplementation.tpl

    r71 r72  
    118118begin
    119119  Result := 0;
    120   while (Result < FCount) and (FItems[Result] <> Item) do
     120  while (Result < FCount) and CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TListItem)) do
    121121    Result := Result + 1;
    122122  if Result = FCount then Result := -1;
    … …  
    191191end;
    192192
    193 procedure TGList.Swap(Index1, Index2: TListIndex);
    194 var
    195   Temp: TListItem;
    196 begin
    197   Temp := Items[Index1];
    198   Items[Index1] := Items[Index2];
    199   Items[Index2] := Temp;
    200 end;
    201 
    202193function TGList.Remove(Item: TListItem): TListIndex;
    203194begin
    … …  
    230221  I := 0;
    231222  while I < (Count div 2) do begin
    232     Swap(I, Count - 1 - I);
     223    Exchange(I, Count - 1 - I);
    233224    I := I + 1;
    234225  end;
    … …  
    241232end;
    242233
    243 procedure TGList.SetArray(Values: array of TListItem);
    244 var
    245   I: TListIndex;
    246 begin
    247   Clear;
     234procedure TGList.AddArray(Values: array of TListItem);
     235var
     236  I: TListIndex;
     237begin
    248238  I := 0;
    249239  while I <= High(Values) do begin

  • Generics/TemplateGenerics/Generic/ListInterface.tpl

    r71 r72  
    2626    // Many items
    2727    procedure MoveItems(CurIndex, NewIndex, Count: TListIndex);
    28     procedure Swap(Index1, Index2: TListIndex);
     28    procedure Exchange(Index1, Index2: TListIndex);
    2929    // One item
    3030    function Add(Item: TListItem): TListIndex;
    3131    procedure Delete(Index: TListIndex);
    32     procedure Exchange(Index1, Index2: TListIndex);
    3332    function Extract(Item: TListItem): TListItem;
    3433    function First: TListItem;
    … …  
    4847    property Count: TListIndex read GetCount write SetCount;
    4948    // Additional
    50     procedure SetArray(Values: array of TListItem);
     49    procedure AddArray(Values: array of TListItem);
    5150  end;
Note: See TracChangeset for help on using the changeset viewer.