/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

  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. // Last modified: $Date$
  25. // For history see end of file
  26. unit JclQueue;
  27. {$I jcl.inc}
  28. interface
  29. uses
  30. JclBase, JclAbstractContainer, JclDCL_intf, JclDCLUtil;
  31. type
  32. TJclIntfQueue = class(TJclAbstractContainer, IIntfQueue)
  33. private
  34. FCapacity: Integer;
  35. FElements: TDynIInterfaceArray;
  36. FHead: Integer;
  37. FTail: Integer;
  38. protected
  39. { IIntfQueue }
  40. function Contains(AInterface: IInterface): Boolean;
  41. function Dequeue: IInterface;
  42. function Empty: Boolean;
  43. procedure Enqueue(AInterface: IInterface);
  44. function Size: Integer;
  45. public
  46. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  47. end;
  48. TJclStrQueue = class(TJclAbstractContainer, IStrQueue)
  49. private
  50. FCapacity: Integer;
  51. FElements: TDynStringArray;
  52. FHead: Integer;
  53. FTail: Integer;
  54. protected
  55. { IStrQueue }
  56. function Contains(const AString: string): Boolean;
  57. function Dequeue: string;
  58. function Empty: Boolean;
  59. procedure Enqueue(const AString: string);
  60. function Size: Integer;
  61. public
  62. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  63. end;
  64. TJclQueue = class(TJclAbstractContainer, IQueue)
  65. private
  66. FCapacity: Integer;
  67. FElements: TDynObjectArray;
  68. FHead: Integer;
  69. FTail: Integer;
  70. protected
  71. { IQueue }
  72. function Contains(AObject: TObject): Boolean;
  73. function Dequeue: TObject;
  74. function Empty: Boolean;
  75. procedure Enqueue(AObject: TObject);
  76. function Size: Integer;
  77. public
  78. constructor Create(Capacity: Integer = DCLDefaultCapacity);
  79. end;
  80. implementation
  81. //=== { TJclIntfQueue } ======================================================
  82. constructor TJclIntfQueue.Create(Capacity: Integer = DCLDefaultCapacity);
  83. begin
  84. inherited Create;
  85. FHead := 0;
  86. FTail := 0;
  87. FCapacity := Capacity;
  88. SetLength(FElements, FCapacity);
  89. end;
  90. function TJclIntfQueue.Contains(AInterface: IInterface): Boolean;
  91. var
  92. I: Integer;
  93. {$IFDEF THREADSAFE}
  94. CS: IInterface;
  95. {$ENDIF THREADSAFE}
  96. begin
  97. {$IFDEF THREADSAFE}
  98. CS := EnterCriticalSection;
  99. {$ENDIF THREADSAFE}
  100. Result := False;
  101. if AInterface = nil then
  102. Exit;
  103. I := FHead;
  104. while I <> FTail do
  105. begin
  106. if FElements[I] = AInterface then
  107. begin
  108. Result := True;
  109. Break;
  110. end;
  111. I := (I + 1) mod FCapacity;
  112. end;
  113. end;
  114. function TJclIntfQueue.Dequeue: IInterface;
  115. {$IFDEF THREADSAFE}
  116. var
  117. CS: IInterface;
  118. {$ENDIF THREADSAFE}
  119. begin
  120. {$IFDEF THREADSAFE}
  121. CS := EnterCriticalSection;
  122. {$ENDIF THREADSAFE}
  123. Result := nil;
  124. if FTail = FHead then
  125. Exit;
  126. Result := FElements[FHead];
  127. FElements[FHead] := nil;
  128. FHead := (FHead + 1) mod FCapacity;
  129. end;
  130. function TJclIntfQueue.Empty: Boolean;
  131. begin
  132. Result := FTail = FHead;
  133. end;
  134. procedure TJclIntfQueue.Enqueue(AInterface: IInterface);
  135. {$IFDEF THREADSAFE}
  136. var
  137. CS: IInterface;
  138. {$ENDIF THREADSAFE}
  139. begin
  140. {$IFDEF THREADSAFE}
  141. CS := EnterCriticalSection;
  142. {$ENDIF THREADSAFE}
  143. if AInterface = nil then
  144. Exit;
  145. FElements[FTail] := AInterface;
  146. FTail := (FTail + 1) mod FCapacity;
  147. end;
  148. function TJclIntfQueue.Size: Integer;
  149. begin
  150. Result := FTail - FHead;
  151. end;
  152. //=== { TJclStrQueue } =======================================================
  153. constructor TJclStrQueue.Create(Capacity: Integer = DCLDefaultCapacity);
  154. begin
  155. inherited Create;
  156. FHead := 0;
  157. FTail := 0;
  158. FCapacity := Capacity;
  159. SetLength(FElements, FCapacity);
  160. end;
  161. function TJclStrQueue.Contains(const AString: string): Boolean;
  162. var
  163. I: Integer;
  164. {$IFDEF THREADSAFE}
  165. CS: IInterface;
  166. {$ENDIF THREADSAFE}
  167. begin
  168. {$IFDEF THREADSAFE}
  169. CS := EnterCriticalSection;
  170. {$ENDIF THREADSAFE}
  171. Result := False;
  172. if AString = '' then
  173. Exit;
  174. I := FHead;
  175. while I <> FTail do
  176. begin
  177. if FElements[I] = AString then
  178. begin
  179. Result := True;
  180. Break;
  181. end;
  182. I := (I + 1) mod FCapacity;
  183. end;
  184. end;
  185. function TJclStrQueue.Dequeue: string;
  186. {$IFDEF THREADSAFE}
  187. var
  188. CS: IInterface;
  189. {$ENDIF THREADSAFE}
  190. begin
  191. {$IFDEF THREADSAFE}
  192. CS := EnterCriticalSection;
  193. {$ENDIF THREADSAFE}
  194. Result := '';
  195. if FTail = FHead then
  196. Exit;
  197. Result := FElements[FHead];
  198. FElements[FHead] := '';
  199. FHead := (FHead + 1) mod FCapacity;
  200. end;
  201. function TJclStrQueue.Empty: Boolean;
  202. begin
  203. Result := FTail = FHead;
  204. end;
  205. procedure TJclStrQueue.Enqueue(const AString: string);
  206. {$IFDEF THREADSAFE}
  207. var
  208. CS: IInterface;
  209. {$ENDIF THREADSAFE}
  210. begin
  211. {$IFDEF THREADSAFE}
  212. CS := EnterCriticalSection;
  213. {$ENDIF THREADSAFE}
  214. if AString = '' then
  215. Exit;
  216. FElements[FTail] := AString;
  217. FTail := (FTail + 1) mod FCapacity;
  218. end;
  219. function TJclStrQueue.Size: Integer;
  220. begin
  221. Result := FTail - FHead;
  222. end;
  223. //=== { TJclQueue } ==========================================================
  224. constructor TJclQueue.Create(Capacity: Integer = DCLDefaultCapacity);
  225. begin
  226. inherited Create;
  227. FCapacity := Capacity;
  228. SetLength(FElements, FCapacity);
  229. end;
  230. function TJclQueue.Contains(AObject: TObject): Boolean;
  231. var
  232. I: Integer;
  233. {$IFDEF THREADSAFE}
  234. CS: IInterface;
  235. {$ENDIF THREADSAFE}
  236. begin
  237. {$IFDEF THREADSAFE}
  238. CS := EnterCriticalSection;
  239. {$ENDIF THREADSAFE}
  240. Result := False;
  241. if AObject = nil then
  242. Exit;
  243. I := FHead;
  244. while I <> FTail do
  245. begin
  246. if FElements[I] = AObject then
  247. begin
  248. Result := True;
  249. Break;
  250. end;
  251. I := (I + 1) mod FCapacity;
  252. end;
  253. end;
  254. function TJclQueue.Dequeue: TObject;
  255. {$IFDEF THREADSAFE}
  256. var
  257. CS: IInterface;
  258. {$ENDIF THREADSAFE}
  259. begin
  260. {$IFDEF THREADSAFE}
  261. CS := EnterCriticalSection;
  262. {$ENDIF THREADSAFE}
  263. Result := nil;
  264. if FTail = FHead then
  265. Exit;
  266. Result := FElements[FHead];
  267. FElements[FHead] := nil;
  268. FHead := (FHead + 1) mod FCapacity;
  269. end;
  270. function TJclQueue.Empty: Boolean;
  271. begin
  272. Result := FTail = FHead;
  273. end;
  274. procedure TJclQueue.Enqueue(AObject: TObject);
  275. {$IFDEF THREADSAFE}
  276. var
  277. CS: IInterface;
  278. {$ENDIF THREADSAFE}
  279. begin
  280. {$IFDEF THREADSAFE}
  281. CS := EnterCriticalSection;
  282. {$ENDIF THREADSAFE}
  283. if AObject = nil then
  284. Exit;
  285. FElements[FTail] := AObject;
  286. FTail := (FTail + 1) mod FCapacity;
  287. end;
  288. function TJclQueue.Size: Integer;
  289. begin
  290. Result := FTail - FHead;
  291. end;
  292. end.