1 {
2 *****************************************************************************
3 * *
4 * This file is part of the ZCAD *
5 * *
6 * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
7 * for details about the copyright. *
8 * *
9 * This program is distributed in the hope that it will be useful, *
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
12 * *
13 *****************************************************************************
14 }
15 {**
16 @author(Andrey Zubarev <zamtmn@yandex.ru>)
17 }
18 {**Модуль описания базового генерика обьекта-массива}
19 unit gzctnrvector;
20 {$INCLUDE def.inc}
21 interface
22 uses uzbtypes,gzctnrvectortypes,uzbmemman,sysutils,typinfo;
23 const
24 {**типы нуждающиеся в инициализации}
25 TypesNeedToFinalize=[tkUnknown{$IFNDEF DELPHI},tkSString{$ENDIF},tkLString{$IFNDEF DELPHI},tkAString{$ENDIF},
26 tkWString,tkVariant,tkRecord,tkInterface,
27 tkClass{$IFNDEF DELPHI},tkObject{$ENDIF},tkDynArray{$IFNDEF DELPHI},tkInterfaceRaw{$ENDIF},
28 tkUString{$IFNDEF DELPHI},tkUChar{$ENDIF}{$IFNDEF DELPHI},tkHelper{$ENDIF}{$IFNDEF DELPHI},tkFile{$ENDIF},tkClassRef];
29 {**типы нуждающиеся в финализации}
30 TypesNeedToInicialize=[tkUnknown{$IFNDEF DELPHI},tkSString{$ENDIF},tkLString{$IFNDEF DELPHI},tkAString{$ENDIF},
31 tkWString,tkVariant,tkRecord,tkInterface,
32 tkClass{$IFNDEF DELPHI},tkObject{$ENDIF},tkDynArray{$IFNDEF DELPHI},tkInterfaceRaw{$ENDIF},
33 tkUString{$IFNDEF DELPHI},tkUChar{$ENDIF}{$IFNDEF DELPHI},tkHelper{$ENDIF}{$IFNDEF DELPHI},tkFile{$ENDIF},tkClassRef];
34 type
35 {Export+}
36 {**Генерик объекта-массива}
37 GZVector{-}<T>{//}={$IFNDEF DELPHI}packed{$ENDIF}
38 object(GDBaseObject)
39 {-}type{//}
40 {-}PT=^T;{//} //**< Тип указатель на тип данных T
41 {-}TArr=array[0..0] of T;{//} //**< Тип массив данных T
42 {-}PTArr=^TArr;{//} //**< Тип указатель на массив данных T
onstnull43 {-}TEqualFunc=function(const a, b: T):Boolean;{//}//**< Тип функция идентичности T
44 {-}TProcessProc=procedure(const p: PT);{//} //**< Тип процедура принимающая указатель на T
45 {-}var{//}
46 PArray:{-}PTArr{/GDBPointer/};(*hidden_in_objinsp*) //**< Указатель на массив данных
47 GUID:String;(*hidden_in_objinsp*) //**< Шняга для подсчета куда уходит память. используется только с DEBUGBUILD. Надо чтото ч ней делать
48 Count:TArrayIndex;(*hidden_in_objinsp*) //**< Количество занятых элементов массива
49 Max:TArrayIndex;(*hidden_in_objinsp*) //**< Размер массива (под сколько элементов выделено памяти)
50
51 {**~Деструктор}
52 destructor done;virtual;
53 {**Деструктор}
54 procedure destroy;virtual;
55 {**Конструктор}
56 constructor init({$IFDEF DEBUGBUILD}ErrGuid:pansichar;{$ENDIF}m:TArrayIndex);
57 {**Конструктор}
58 constructor initnul;
59
60 {**Удаление всех элементов массива}
61 procedure free;virtual;
62
63 {**Начало "перебора" элементов массива
64 @param(ir переменная "итератор")
65 @return(указатель на первый элемент массива)}
beginiteratenull66 function beginiterate(out ir:itrec):Pointer;virtual;
67 {**"Перебор" элементов массива
68 @param(ir переменная "итератор")
69 @return(указатель на следующий элемент массива, nil если это конец)}
iteratenull70 function iterate(var ir:itrec):Pointer;virtual;
71
SetCountnull72 function SetCount(index:Integer):Pointer;virtual;
73 {**Инвертировать массив}
74 procedure Invert;
75 {**Копировать в массив}
copytonull76 function copyto(var source:GZVector<T>):Integer;virtual;
77 {**Выделяет место и копирует в массив SData элементов из PData. Надо compilermagic! соответствие с AllocData
78 @PData(указатель на копируемые элементы)
79 @SData(кол-во копируемых элементов)
80 @return(индекс первого скопированного элемента в массиве)}
AddDatanull81 function AddData(PData:Pointer;SData:Word):Integer;virtual;
82 {**Выделяет место в массиве под SData элементов. Надо compilermagic! соответствие с AddData
83 @SData(кол-во копируемых элементов)
84 @return(индекс первого выделенного элемента в массиве)}
AllocDatanull85 function AllocData(SData:Word):Integer;virtual;
86
87
88 {old}
89 {**Удалить элемент по индексу, без уменьшениием размера массива, элемент затирается значением default(T)}
DeleteElementnull90 function DeleteElement(index:Integer):Pointer;
91 //TODO:исправить пиздеж
92 {**Пиздеж!!! уменьшается!!! Удалить элемент по индексу, с уменьшениием размера массива}
EraseElementnull93 function EraseElement(index:Integer):Pointer;
94 {**Перевод указателя в индекс}
P2Inull95 function P2I(pel:Pointer):Integer;
96 {**Удалить элемент по указателю}
DeleteElementByPnull97 function DeleteElementByP(pel:Pointer):Pointer;
98 {**вставить элемент}
InsertElementnull99 function InsertElement(index:Integer;const data:T):Pointer;
100
101 {need compilermagic}
102 procedure Grow(newmax:Integer=0);virtual;
103 {**Выделяет память под массив}
CreateArraynull104 function CreateArray:Pointer;virtual;
105
106 {reworked}
107 {**Устанавливает длину массива}
108 procedure SetSize(nsize:TArrayIndex);
109 {**Возвращает указатель на значение по индексу}
getDataMutablenull110 function getDataMutable(index:TArrayIndex):PT;
111 {**Возвращает значение по индексу}
getDatanull112 function getData(index:TArrayIndex):T;
113 {**Добавить в конец массива значение, возвращает индекс добавленного значения}
PushBackDatanull114 function PushBackData(const data:T):TArrayIndex;
115 {**Добавить в конец массива значение если его еще нет в массиве, возвращает индекс найденного или добавленного значения}
PushBackIfNotPresentWithCompareProcnull116 function PushBackIfNotPresentWithCompareProc(data:T;EqualFunc:TEqualFunc):Integer;
117 {**Добавить в конец массива значение если оно еще не в конце массива, возвращает индекс найденного или добавленного значения}
PushBackIfNotLastWithCompareProcnull118 function PushBackIfNotLastWithCompareProc(data:T;EqualFunc:TEqualFunc):Integer;
119 {**Добавить в конец массива значение если оно еще не в конце массива или не в начале масива, возвращает индекс найденного или добавленного значения}
PushBackIfNotLastOrFirstWithCompareProcnull120 function PushBackIfNotLastOrFirstWithCompareProc(data:T;EqualFunc:TEqualFunc):Integer;
121 {**Проверка нахождения в массиве значения с функцией сравнения}
IsDataExistWithCompareProcnull122 function IsDataExistWithCompareProc(pobj:T;EqualFunc:TEqualFunc):Integer;
123 {**Возвращает тип элемента массива}
GetSpecializedTypeInfonull124 function GetSpecializedTypeInfo:PTypeInfo;inline;
125
126 {**Возвращает размер элемента массива}
SizeOfDatanull127 function SizeOfData:TArrayIndex;
128 {**Возвращает указатель на массив}
GetParrayAsPointernull129 function GetParrayAsPointer:pointer;
130 {**Очищает массив не убивая элементы, просто count:=0}
131 procedure Clear;virtual;
132 {**Возвращает реальное колво элементов, в данном случае=count}
GetRealCountnull133 function GetRealCount:Integer;
134 {**Возвращает колво элементов}
GetCountnull135 function GetCount:Integer;
136 {**Подрезать выделенную память по count}
137 procedure Shrink;virtual;
138 end;
139 {Export-}
140 implementation
GZVectornull141 function GZVector<T>.GetSpecializedTypeInfo:PTypeInfo;
142 begin
143 result:=TypeInfo(T);
144 end;
145
GZVectornull146 function GZVector<T>.getDataMutable;
147 begin
148 if (index>=max)
149 or(index<0)then
150 result:=nil
151 else if PArray=nil then
152 result:=nil
153 else
154 result:=@parray[index];
155 end;
GZVectornull156 function GZVector<T>.getData;
157 begin
158 if (index>=max)
159 or(index<0)then
160 result:=default(T)
161 else if PArray=nil then
162 result:=default(T)
163 else
164 result:=parray[index];
165 end;
GZVectornull166 function GZVector<T>.PushBackData(const data:T):TArrayIndex;
167 begin
168 if parray=nil then
169 CreateArray;
170 if count = max then
171 grow;
172 begin
173 if PTypeInfo(TypeInfo(T))^.kind in TypesNeedToInicialize
174 then fillchar(parray[count],sizeof(T),0);
175 parray[count]:=data;
176 result:=count;
177 inc(count);
178 end;
179 end;
GZVectornull180 function GZVector<T>.GetParrayAsPointer;
181 begin
182 result:=pointer(parray);
183 end;
184
GZVectornull185 function GZVector<T>.IsDataExistWithCompareProc;
186 var i:integer;
187 begin
188 for i:=0 to count-1 do
189 if EqualFunc(parray[i],pobj) then
190 begin
191 result:=i;
192 exit;
193 end;
194 result:=-1;
195 end;
GZVectornull196 function GZVector<T>.PushBackIfNotLastWithCompareProc(data:T;EqualFunc:TEqualFunc):Integer;
197 begin
198 if count>0 then
199 begin
200 if not EqualFunc(parray[count-1],data) then
201 result:=PushBackData(data)
202 else
203 result:=count-1;
204 end
205 else
206 result:=PushBackData(data);
207 end;
GZVectornull208 function GZVector<T>.PushBackIfNotLastOrFirstWithCompareProc(data:T;EqualFunc:TEqualFunc):Integer;
209 begin
210 if count>0 then
211 begin
212 if not EqualFunc(parray[count-1],data) then
213 begin
214 if not EqualFunc(parray[0],data) then
215 result:=PushBackData(data)
216 else
217 result:=0;
218 end
219 else
220 result:=count-1;
221 end
222 else
223 result:=PushBackData(data);
224 end;
GZVectornull225 function GZVector<T>.PushBackIfNotPresentWithCompareProc;
226 begin
227 result:=IsDataExistWithCompareProc(data,EqualFunc);
228 if result=-1 then
229 result:=PushBackData(data);
230 {if IsDataExistWithCompareProc(data,EqualFunc)>=0 then
231 begin
232 result := -1;
233 exit;
234 end;
235 result:=PushBackData(data);}
236 end;
GZVectornull237 function GZVector<T>.AllocData(SData:Word):Integer;
238 begin
239 if parray=nil then
240 createarray;
241 if count+sdata>max then
242 Grow((count+sdata)*2);
243 result:={@parray^[}count{]};
244 //result:=pointer(GDBPlatformUInt(parray)+count*SizeOfData);
245 {$IFDEF FILL0ALLOCATEDMEMORY}
246 fillchar(result^,sdata,0);
247 {$ENDIF}
248 inc(count,SData);
249 end;
GZVectornull250 function GZVector<T>.AddData(PData:Pointer;SData:Word):Integer;
251 var addr:pointer;
252 begin
253 if parray=nil then
254 createarray;
255 if count+sdata>max then
256 begin
257 if count+sdata>2*max then
258 {Grow}SetSize(count+sdata)
259 else
260 Grow;
261 end;
262 {if count = max then
263 begin
264 parray := enlargememblock(parray, size * max, 2*size * max);
265 max:=2*max;
266 end;}
267 begin
268 //GDBPointer(addr) := parray;
269 //addr := addr + count;
270 { TODO : Надо копировать с учетом compiler magic а не тупо мовить }
271 addr:=@parray^[count];
272 Move(PData^, addr^,SData*SizeOfData);
273 result:=count;
274 inc(count,SData);
275 end;
276 end;
GZVectornull277 function GZVector<T>.GetRealCount:Integer;
278 {var p:GDBPointer;
279 ir:itrec;}
280 begin
281 result:=GetCount;
282 {p:=beginiterate(ir);
283 if p<>nil then
284 repeat
285 inc(result);
286 p:=iterate(ir);
287 until p=nil;}
288 end;
GZVectornull289 function GZVector<T>.copyto(var source:GZVector<T>):Integer;
290 var i:integer;
291 begin
292 result:=count;
293 for i:=0 to count-1 do
294 source.PushBackData(parray[i]);
295 end;
296
297 {var p:pt;
298 ir:itrec;
299 begin
300 p:=beginiterate(ir);
301 if p<>nil then
302 repeat
303 source.PushBackData(p^); //-----------------//-----------
304 p:=iterate(ir);
305 until p=nil;
306 result:=count;
307 end;}
308 procedure GZVector<T>.Invert;
309 (*var p,pl,tp:GDBPointer;
310 ir:itrec;
311 begin
312 p:=beginiterate(ir);
313 p:=getDataMutable(0);
314 pl:=getDataMutable(count-1);
315 GDBGetMem({$IFDEF DEBUGBUILD}'{D9D91D43-BD6A-450A-B07E-E964425E7C99}',{$ENDIF}tp,SizeOfData);
316 if p<>nil then
317 repeat
318 if GDBPlatformUInt(pl)<=GDBPlatformUInt(p) then
319 break;
320 Move(p^,tp^,SizeOfData);
321 Move(pl^,p^,SizeOfData);
322 Move(tp^,pl^,SizeOfData);
323 dec(GDBPlatformUInt(pl),SizeOfData);
324 inc(GDBPlatformUInt(p),SizeOfData);
325 until false;
326 GDBFreeMem(tp);
327 end;*)
328 var i,j:integer;
329 tdata:t;
330 begin
331 j:=count-1;
332 for i:=0 to (count-1)div 2 do
333 begin
334 tdata:=parray^[i];
335 parray^[i]:=parray^[j];
336 parray^[j]:=tdata;
337 dec(j);
338 end;
339 end;
340
GZVectornull341 function GZVector<T>.SetCount;
342 begin
343 count:=index;
344 if parray=nil then
345 createarray;
346 if count>=max then
347 begin
348 if count>2*max then
349 SetSize(2*count)
350 else
351 SetSize(2*max);
352 end;
353 result:=parray;
354 end;
355 procedure GZVector<T>.SetSize;
356 begin
357 if nsize>max then
358 begin
359 parray := enlargememblock({$IFDEF DEBUGBUILD}@Guid[1],{$ENDIF}parray, SizeOfData*max, SizeOfData*nsize);
360 end
361 else if nsize<max then
362 begin
363 parray := enlargememblock({$IFDEF DEBUGBUILD}@Guid[1],{$ENDIF}parray, SizeOfData*max, SizeOfData*nsize);
364 if count>nsize then count:=nsize;
365 end;
366 max:=nsize;
367 end;
GZVectornull368 function GZVector<T>.beginiterate;
369 begin
370 if parray=nil then
371 result:=nil
372 else
373 begin
374 {ir.itp:=pointer(GDBPlatformUInt(parray)-SizeOfData);}
375 ir.itp:=pointer(parray);
376 dec(pt(ir.itp));
377 ir.itc:=-1;
378 result:=iterate(ir);
379 end;
380 end;
GZVectornull381 function GZVector<T>.iterate;
382 begin
383 if count=0 then result:=nil
384 else if ir.itc<(count-1) then
385 begin
386 inc(pByte(ir.itp),SizeOfData);
387 inc(ir.itc);
388
389 result:=ir.itp;
390 end
391 else result:=nil;
392 end;
393 constructor GZVector<T>.initnul;
394 begin
395 PArray:=nil;
396 pointer(GUID):=nil;
397 Count:=0;
398 Max:=0;
399 end;
400 constructor GZVector<T>.init;
401 begin
402 PArray:=nil;
403 pointer(GUID):=nil;
404 Count:=0;
405 Max:=m;
406 {$IFDEF DEBUGBUILD}Guid:=ErrGuid;{$ENDIF}
407 end;
408 destructor GZVector<T>.done;
409 begin
410 free;
411 destroy;
412 end;
413 procedure GZVector<T>.destroy;
414 begin
415 if PArray<>nil then
416 GDBFreeMem(PArray);
417 PArray:=nil;
418 {$IFDEF DEBUGBUILD}Guid:='';{$ENDIF}
419 end;
420 procedure GZVector<T>.free;
421 var i:integer;
422 _pt:PTypeInfo;
423 begin
424 _pt:=TypeInfo(T);
425 if _pt^.Kind in TypesNeedToFinalize then
426 for i:=0 to count-1 do
427 PArray^[i]:=default(t);
428 count:=0;
429 end;
GZVectornull430 function GZVector<T>.SizeOfData:TArrayIndex;
431 begin
432 result:=sizeof(T);
433 end;
434 procedure GZVector<T>.clear;
435 begin
436 count:=0;
437 end;
GZVectornull438 function GZVector<T>.CreateArray;
439 begin
440 GDBGetMem({$IFDEF DEBUGBUILD}@Guid[1],{$ENDIF}PArray,SizeOfData*max);
441 result:=parray;
442 end;
443 procedure GZVector<T>.Grow;
444 begin
445 if newmax<=0 then
446 newmax:=2*max;
447 parray := enlargememblock({$IFDEF DEBUGBUILD}@Guid[1],{$ENDIF}parray, SizeOfData * max, SizeOfData * newmax);
448 max:=newmax;
449 end;
450 procedure GZVector<T>.Shrink;
451 begin
452 if (count<>0)and(count<max) then
453 begin
454 parray := remapmememblock({$IFDEF DEBUGBUILD}@Guid[1],{$ENDIF}parray, SizeOfData * count);
455 max := count;
456 end;
457 end;
GZVectornull458 function GZVector<T>.GetCount:Integer;
459 begin
460 result:=count;
461 end;
GZVectornull462 function GZVector<T>.InsertElement;
463 {var
464 s:integer;}
465 begin
466 if index=count then
467 PushBackData(data)
468 else
469 begin
470 if parray=nil then
471 CreateArray;
472 if count = max then
473 grow;
474 Move(parray[index],parray[index+1],(count-index)*sizeof(t));
475 if PTypeInfo(TypeInfo(T))^.kind in TypesNeedToInicialize
476 then fillchar(parray[index],sizeof(T),0);
477 parray[index]:=data;
478 inc(count);
479 end;
480 result:=parray;
481 end;
GZVectornull482 function GZVector<T>.DeleteElement;
483 begin
484 if (index>=0)and(index<count)then
485 begin
486 dec(count);
487 if PTypeInfo(TypeInfo(T))^.kind in TypesNeedToInicialize
488 then parray^[index]:=default(t);
489 if index<>count then
490 Move(parray^[index+1],parray^[index],(count-index)*SizeOfData);
491 end;
492 result:=parray;
493 end;
GZVectornull494 function GZVector<T>.EraseElement;
495 begin
496 if (index>=0)and(index<count)then
497 begin
498 dec(count);
499 if PTypeInfo(TypeInfo(T))^.kind in TypesNeedToInicialize
500 then parray^[index]:=default(t);
501 if index<>count then
502 Move(parray^[index+1],parray^[index],(count-index)*SizeOfData);
503 end;
504 result:=parray;
505 end;
GZVectornull506 function GZVector<T>.P2I(pel:Pointer):Integer;
507 begin
508 result:=PT(pel)-PT(parray);
509 end;
GZVectornull510 function GZVector<T>.DeleteElementByP;
511 {var
512 s:integer;}
513 begin
514 result:=deleteelement(p2i(pel));
515 {s:=PT(pel)-PT(parray);
516 if s>=0 then
517 begin
518 deleteelement(s);
519 end;
520 result:=parray;}
521 end;
522 begin
523 end.
524