PageRenderTime 51ms CodeModel.GetById 46ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

/donations/dcl/JclQueue.pas

https://github.com/the-Arioch/jcl
Pascal | 323 lines | 224 code | 31 blank | 68 comment | 15 complexity | f7f7dbc5a4a9f0f9f822d1ef496c2f08 MD5 | raw file
Possible License(s): BSD-3-Clause
  1{**************************************************************************************************}
  2{                                                                                                  }
  3{ Project JEDI Code Library (JCL)                                                                  }
  4{                                                                                                  }
  5{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
  6{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
  7{ License at http://www.mozilla.org/MPL/                                                           }
  8{                                                                                                  }
  9{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
 10{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
 11{ and limitations under the License.                                                               }
 12{                                                                                                  }
 13{ The Original Code is Queue.pas.                                                                  }
 14{                                                                                                  }
 15{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by  }
 16{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com)          }
 17{ All rights reserved.                                                                             }
 18{                                                                                                  }
 19{**************************************************************************************************}
 20{                                                                                                  }
 21{ The Delphi Container Library                                                                     }
 22{                                                                                                  }
 23{**************************************************************************************************}
 24
 25// Last modified: $Date$
 26// For history see end of file
 27
 28unit JclQueue;
 29
 30{$I jcl.inc}
 31
 32interface
 33
 34uses
 35  JclBase, JclAbstractContainer, JclDCL_intf, JclDCLUtil;
 36
 37type
 38  TJclIntfQueue = class(TJclAbstractContainer, IIntfQueue)
 39  private
 40    FCapacity: Integer;
 41    FElements: TDynIInterfaceArray;
 42    FHead: Integer;
 43    FTail: Integer;
 44  protected
 45    { IIntfQueue }
 46    function Contains(AInterface: IInterface): Boolean;
 47    function Dequeue: IInterface;
 48    function Empty: Boolean;
 49    procedure Enqueue(AInterface: IInterface);
 50    function Size: Integer;
 51  public
 52    constructor Create(Capacity: Integer = DCLDefaultCapacity);
 53  end;
 54
 55  TJclStrQueue = class(TJclAbstractContainer, IStrQueue)
 56  private
 57    FCapacity: Integer;
 58    FElements: TDynStringArray;
 59    FHead: Integer;
 60    FTail: Integer;
 61  protected
 62    { IStrQueue }
 63    function Contains(const AString: string): Boolean;
 64    function Dequeue: string;
 65    function Empty: Boolean;
 66    procedure Enqueue(const AString: string);
 67    function Size: Integer;
 68  public
 69    constructor Create(Capacity: Integer = DCLDefaultCapacity);
 70  end;
 71
 72  TJclQueue = class(TJclAbstractContainer, IQueue)
 73  private
 74    FCapacity: Integer;
 75    FElements: TDynObjectArray;
 76    FHead: Integer;
 77    FTail: Integer;
 78  protected
 79    { IQueue }
 80    function Contains(AObject: TObject): Boolean;
 81    function Dequeue: TObject;
 82    function Empty: Boolean;
 83    procedure Enqueue(AObject: TObject);
 84    function Size: Integer;
 85  public
 86    constructor Create(Capacity: Integer = DCLDefaultCapacity);
 87  end;
 88
 89implementation
 90
 91//=== { TJclIntfQueue } ======================================================
 92
 93constructor TJclIntfQueue.Create(Capacity: Integer = DCLDefaultCapacity);
 94begin
 95  inherited Create;
 96  FHead := 0;
 97  FTail := 0;
 98  FCapacity := Capacity;
 99  SetLength(FElements, FCapacity);
100end;
101
102function TJclIntfQueue.Contains(AInterface: IInterface): Boolean;
103var
104  I: Integer;
105  {$IFDEF THREADSAFE}
106  CS: IInterface;
107  {$ENDIF THREADSAFE}
108begin
109  {$IFDEF THREADSAFE}
110  CS := EnterCriticalSection;
111  {$ENDIF THREADSAFE}
112  Result := False;
113  if AInterface = nil then
114    Exit;
115  I := FHead;
116  while I <> FTail do
117  begin
118    if FElements[I] = AInterface then
119    begin
120      Result := True;
121      Break;
122    end;
123    I := (I + 1) mod FCapacity;
124  end;
125end;
126
127function TJclIntfQueue.Dequeue: IInterface;
128{$IFDEF THREADSAFE}
129var
130  CS: IInterface;
131{$ENDIF THREADSAFE}
132begin
133  {$IFDEF THREADSAFE}
134  CS := EnterCriticalSection;
135  {$ENDIF THREADSAFE}
136  Result := nil;
137  if FTail = FHead then
138    Exit;
139  Result := FElements[FHead];
140  FElements[FHead] := nil;
141  FHead := (FHead + 1) mod FCapacity;
142end;
143
144function TJclIntfQueue.Empty: Boolean;
145begin
146  Result := FTail = FHead;
147end;
148
149procedure TJclIntfQueue.Enqueue(AInterface: IInterface);
150{$IFDEF THREADSAFE}
151var
152  CS: IInterface;
153{$ENDIF THREADSAFE}
154begin
155  {$IFDEF THREADSAFE}
156  CS := EnterCriticalSection;
157  {$ENDIF THREADSAFE}
158  if AInterface = nil then
159    Exit;
160  FElements[FTail] := AInterface;
161  FTail := (FTail + 1) mod FCapacity;
162end;
163
164function TJclIntfQueue.Size: Integer;
165begin
166  Result := FTail - FHead;
167end;
168
169//=== { TJclStrQueue } =======================================================
170
171constructor TJclStrQueue.Create(Capacity: Integer = DCLDefaultCapacity);
172begin
173  inherited Create;
174  FHead := 0;
175  FTail := 0;
176  FCapacity := Capacity;
177  SetLength(FElements, FCapacity);
178end;
179
180function TJclStrQueue.Contains(const AString: string): Boolean;
181var
182  I: Integer;
183  {$IFDEF THREADSAFE}
184  CS: IInterface;
185  {$ENDIF THREADSAFE}
186begin
187  {$IFDEF THREADSAFE}
188  CS := EnterCriticalSection;
189  {$ENDIF THREADSAFE}
190  Result := False;
191  if AString = '' then
192    Exit;
193  I := FHead;
194  while I <> FTail do
195  begin
196    if FElements[I] = AString then
197    begin
198      Result := True;
199      Break;
200    end;
201    I := (I + 1) mod FCapacity;
202  end;
203end;
204
205function TJclStrQueue.Dequeue: string;
206{$IFDEF THREADSAFE}
207var
208  CS: IInterface;
209{$ENDIF THREADSAFE}
210begin
211  {$IFDEF THREADSAFE}
212  CS := EnterCriticalSection;
213  {$ENDIF THREADSAFE}
214  Result := '';
215  if FTail = FHead then
216    Exit;
217  Result := FElements[FHead];
218  FElements[FHead] := '';
219  FHead := (FHead + 1) mod FCapacity;
220end;
221
222function TJclStrQueue.Empty: Boolean;
223begin
224  Result := FTail = FHead;
225end;
226
227procedure TJclStrQueue.Enqueue(const AString: string);
228{$IFDEF THREADSAFE}
229var
230  CS: IInterface;
231{$ENDIF THREADSAFE}
232begin
233  {$IFDEF THREADSAFE}
234  CS := EnterCriticalSection;
235  {$ENDIF THREADSAFE}
236  if AString = '' then
237    Exit;
238  FElements[FTail] := AString;
239  FTail := (FTail + 1) mod FCapacity;
240end;
241
242function TJclStrQueue.Size: Integer;
243begin
244  Result := FTail - FHead;
245end;
246
247//=== { TJclQueue } ==========================================================
248
249constructor TJclQueue.Create(Capacity: Integer = DCLDefaultCapacity);
250begin
251  inherited Create;
252  FCapacity := Capacity;
253  SetLength(FElements, FCapacity);
254end;
255
256function TJclQueue.Contains(AObject: TObject): Boolean;
257var
258  I: Integer;
259  {$IFDEF THREADSAFE}
260  CS: IInterface;
261  {$ENDIF THREADSAFE}
262begin
263  {$IFDEF THREADSAFE}
264  CS := EnterCriticalSection;
265  {$ENDIF THREADSAFE}
266  Result := False;
267  if AObject = nil then
268    Exit;
269  I := FHead;
270  while I <> FTail do
271  begin
272    if FElements[I] = AObject then
273    begin
274      Result := True;
275      Break;
276    end;
277    I := (I + 1) mod FCapacity;
278  end;
279end;
280
281function TJclQueue.Dequeue: TObject;
282{$IFDEF THREADSAFE}
283var
284  CS: IInterface;
285{$ENDIF THREADSAFE}
286begin
287  {$IFDEF THREADSAFE}
288  CS := EnterCriticalSection;
289  {$ENDIF THREADSAFE}
290  Result := nil;
291  if FTail = FHead then
292    Exit;
293  Result := FElements[FHead];
294  FElements[FHead] := nil;
295  FHead := (FHead + 1) mod FCapacity;
296end;
297
298function TJclQueue.Empty: Boolean;
299begin
300  Result := FTail = FHead;
301end;
302
303procedure TJclQueue.Enqueue(AObject: TObject);
304{$IFDEF THREADSAFE}
305var
306  CS: IInterface;
307{$ENDIF THREADSAFE}
308begin
309  {$IFDEF THREADSAFE}
310  CS := EnterCriticalSection;
311  {$ENDIF THREADSAFE}
312  if AObject = nil then
313    Exit;
314  FElements[FTail] := AObject;
315  FTail := (FTail + 1) mod FCapacity;
316end;
317
318function TJclQueue.Size: Integer;
319begin
320  Result := FTail - FHead;
321end;
322
323end.