ArenaZ

1
(*====< GLZArrayClasses.pas >===================================================@br
2
  @created(2017-04-17)
3
  @author(J.Delauney (BeanzMaster) - Peter Dyson (Dicepd) )
4
  Historique : @br
5
  @unorderedList(
6
    @item(21/01/2018 : Creation  )
7
  )
8
--------------------------------------------------------------------------------@br
9

10
  @bold(Description :)@br
11
  Generics base classes for managing array thrue pointer
12

13
  ------------------------------------------------------------------------------@br
14
  @bold(Notes) : @br
15

16
  ------------------------------------------------------------------------------@br
17
  @bold(BUGS :)@br
18
  @unorderedList(
19
     @item()
20
  )
21
  ------------------------------------------------------------------------------@br
22
  @bold(TODO :)@br
23
  @unorderedList(
24
     @item()
25
  )
26

27
  ------------------------------------------------------------------------------@br
28
  @bold(Credits :)
29
   @unorderedList(
30
     @item(FPC/Lazarus)
31
   )
32

33
  ------------------------------------------------------------------------------@br
34
  @bold(LICENCE :) MPL / GPL @br
35
  @br
36
 *==============================================================================*)
37
unit GLZArrayClasses;
38

39
{$mode objfpc}{$H+}
40

41
{$IFDEF CPU64}
42
  {$CODEALIGN LOCALMIN=16} // ??? needed here ????
43
{$ENDIF}
44

45
interface
46

47
uses
48
  Classes, SysUtils;
49
  //GLZTypes, GLZClasses, GLZPersistentClasses;
50

51
const
52
  cDefaultListGrowthDelta = 16;
53

54
Type
55

56
  { TGLZBaseArray }
57

58
  generic TGLZBaseArray<T> = class //(TGLZPersistentObject)
59
  private
60
    F: boolean;
61
    FTagString : string;
62

63
    type
64
      PT = ^ T;
65
      TArr = array of T;
66
      PArr = ^TArr;
67

68
    procedure SetCount(AValue : SizeUInt);
69

70

71
  protected
72
    var
73
      {$CODEALIGN RECORDMIN=16}
74
      FData: TArr;  // The base list pointer (untyped)
75
      {$CODEALIGN RECORDMIN=4}
76

77
      FCapacity:SizeUInt;
78
      FDataSize:SizeUInt;
79
      FItemSize:SizeUInt; // Must be defined in subclasses
80
      FGrowthDelta: Integer;
81
      FParentData: Pointer;
82
      FHandle: SizeUInt;
83
      FIsDirty: boolean;
84

85
      FRevision: LongWord;
86
      FCount: SizeUInt;
87

88
      FPosition: SizeUInt;
89
      FFirstDone: Boolean;
90

91

92
    Function GetData: Pointer; inline;
93
    function GetValue(Position: SizeUInt): T; inline;
94
   procedure SetValue(Position : SizeUInt; const AValue : T);
95

96
    function GetMutable(Position: SizeUInt): PT; inline;
97
    procedure IncreaseCapacity; inline;
98

99
    procedure SetCapacity(NewCapacity: SizeUInt); virtual;
100

101
    //  persistency support.
102
    //procedure ReadItemsData(AReader : TReader); virtual;
103
    //procedure WriteItemsData(AWriter : TWriter); virtual;
104
    //procedure DefineProperties(AFiler: TFiler); override;
105

106
  public
107
  { Public Declarations }
108
    constructor Create; //override;
109
    constructor Create(Reserved: SizeUInt); overload;
110
    constructor CreateParented(AParentData: Pointer; Reserved: SizeUInt); overload;
111
    destructor Destroy; override;
112
    //procedure Assign(Src: TPersistent); override;
113

114
    //procedure WriteToFiler(writer: TVirtualWriter); override;
115
    //procedure ReadFromFiler(reader: TVirtualReader); override;
116

117
    function DataSize: SizeUInt; // size of the list
118
    function ItemSize: Byte; // Size of 1 item
119

120
    // Management
121
    function Add(const Value: T):SizeUInt; inline;
122
    procedure Insert(Position: SizeUInt; const Value: T); inline;
123
    procedure Delete(Position : SizeUInt); inline;
124

125
    procedure Exchange(index1, index2: SizeUInt); inline;
126
    //procedure Move(curIndex, newIndex: SizeUInt); inline;
127
    procedure Reverse; inline;
128

129
    //procedure AddNulls(nbVals: Cardinal); inline;
130
    //procedure InsertNulls(Position : SizeUInt; nbVals: Cardinal); inline;
131

132
    { Empties the list without altering capacity. }
133
    procedure Flush;  inline;
134
    { Empties the list and release. }
135
    procedure Clear; inline;
136

137
    // LIFO
138
    procedure Push(const Value: T);inline;
139
    function Pop: T; inline;
140

141
    // Array Iterators
142
    function First: T; inline;
143
    function Last: T; inline;
144
    function Next: T; inline;
145
    function Prev: T; inline;
146
    function Current : T; inline;
147
    function MoveNext:Boolean; inline;
148
    function MovePrev:Boolean; inline;
149
    function MoveFirst:Boolean; inline;
150
    function MoveLast:Boolean; inline;
151
    function GetPosition : SizeUInt;
152
    function Seek(const pos : SizeUInt; const StartAt : Byte) : boolean;  inline;
153
    function MoveTo(Position:SizeUInt) : Boolean; inline;
154
    function IsEndOfArray : Boolean; inline;
155

156
    // Array Rasterizer
157
    // function Scan(CallBack):Boolean;
158
    // function ScanNext(CallBack):Boolean;
159
    // function ScanPrev(CallBack):Boolean;
160

161
    // function ScanMany(nbItem,CallBack):Boolean;
162
    // function ScanTo(Position,CallBack):Boolean;
163

164
    // function ScanAll(CallBack):Boolean;
165
    // function ScanRange(From, To, CallBack):Boolean;
166

167
    // Array Utils
168

169
    // function CompareItems(Index1, index2, comparefunc): Integer;
170
    // procedure Sort(Const Direction : byte);
171
    // procedure Merge(AnotherArray: TGLZBaseArray<T>);
172
    // function Clone : TGLZBaseArray<T>;
173
    // function Extract(From, Nb : SizeUInt): TGLZBaseArray<T>;
174

175
    // Extra funcs for management
176
    // function InsertItemsAt(Pos:SizeUInt; AnArray : TGLZBaseArray<T>):Boolean;
177
    // function InsertItemsAtEnd
178
    // function InsertItemsAtFirst
179
    // procedure DeleteItems(Index: SizeUIntr; nbVals: Cardinal); inline;
180

181
    // Properties
182
   { Nb of items in the list. When assigning a Count, added items are reset to zero. }
183
    property Count: SizeUInt read FCount write SetCount;
184
    { Current list capacity.Not persistent. }
185
    property Capacity: SizeUInt read FCapacity write SetCapacity;
186
    { List growth granularity. Not persistent. }
187
    property GrowthDelta: Integer read FGrowthDelta write FGrowthDelta;
188

189
    property TagString: string read FTagString write FTagString;
190
    { Increase by one after every content changes. }
191
    property Revision: LongWord read FRevision write FRevision;
192

193
    property ParentData : Pointer read FParentData;
194
    property Data : Pointer read GetData;
195
    property Handle : SizeUInt read FHandle;
196
    property IsDirty : boolean read FIsDirty write f;
197
    property Items[i : SizeUInt]: T read getValue write SetValue;// default;
198
    property Mutable[i : SizeUInt]: PT read getMutable;
199
  end;
200

201
  { TGLZBaseArray2D }
202

203
  generic TGLZBaseArrayMap2D<T> = class(specialize TGLZBaseArray<T>)
204
  private
205

206
    function GetValue2D(x, y : SizeUInt): T;
207
    procedure SetValue2D(x, y : SizeUInt; AValue: T);
208
  protected
209
    FRows, FCols : SizeUInt;
210

211
  public
212
    constructor Create(Rows, Cols: SizeUInt); overload;
213
    constructor CreateParented(AParentData: Pointer; Rows, Cols: SizeUInt); overload;
214

215
    function MoveTo(Row : Integer; Position : Integer) : Boolean; overload;
216

217
    property Items[x,y : SizeUInt]: T read GetValue2D write SetValue2D;
218
    property RowCount : SizeUInt read FRows;
219
    property ColCount : SizeUInt read FCols;
220

221
  end;
222

223
  //generic TGLZBaseArrayMap3D<T> = class(specialize TGLZBaseArray<T>)
224
  //private
225
  //  function GetValue3D(x, y, z : SizeUInt): T;
226
  //  procedure SetValue3D(x, y, z : SizeUInt; AValue: T);
227
  //published
228
  //public
229
  //  constructor Create(Rows, Cols, DCols : SizeUInt); overload;
230
  //  constructor CreateParented(AParentData: Pointer; Rows, Cols, DCols: SizeUInt); overload;
231
  //  property Items[x,y,z : SizeUInt]: T read GetValue3D write SetValue3D;
232
  //end;
233
  //
234
  //generic TGLZBaseArrayMap4D<T> = class(specialize TGLZBaseArray<T>)
235
  //private
236
  //  function GetValue4D(x, y, z, w : SizeUInt): T;
237
  //  procedure SetValue4D(x, y, z, w : SizeUInt; AValue: T);
238
  //published
239
  //public
240
  //  constructor Create(Rows, Cols, DCols, TCols: SizeUInt); overload;
241
  //  constructor CreateParented(AParentData: Pointer; Rows, Cols, DCols, TCols: SizeUInt); overload;
242
  //  property Items[x,y,z,w : SizeUInt]: T read GetValue4D write SetValue4D;
243
  //end;
244

245

246
implementation
247
{$ifdef DEBUGLOG}
248
uses GLZLogger;
249
{$endif}
250
{%region%=====[ TGLZBaseArray ]=================================================}
251

252
procedure TGLZBaseArray.SetCount(AValue : SizeUInt);
253
begin
254
  {$ifdef DEBUG}
255
    Assert(AValue >= 0);
256
  {$endif}
257
  if FCount = AValue then Exit;
258
  if AValue> FCapacity then SetCapacity(AValue);
259
  //if (AValue > FCount) and (bloSetCountResetsMemory in FOptions) then
260
  // FillChar(FBaseList[FItemSize * FCount], (Val - FCount) * FItemSize, 0);
261
  FCount := AValue;
262
  Inc(FRevision);
263
end;
264

265
function TGLZBaseArray.GetData : Pointer;
266
begin
267
  Result := @FData;
268
end;
269

270
function TGLZBaseArray.GetValue(Position : SizeUInt) : T;
271
begin
272
  {$ifdef DEBUG}
273
     Assert((position < size) and (position>=0), SVectorPositionOutOfRange);
274
  {$endif}
275
  Result := FData[Position];
276
end;
277

278
procedure TGLZBaseArray.SetValue(Position : SizeUInt; const AValue : T);
279
begin
280
  {$ifdef DEBUG}
281
     Assert((position < size) and (position>=0), SVectorPositionOutOfRange);
282
  {$endif}
283
  {$ifdef DEBUGLOG}
284
  GlobalLogger.LogStatus('Set value at : '+Inttostr(Position));
285
  {$endif}
286
  //if FData[Position] = AValue then exit;
287
  FData[Position] := AValue;
288
end;
289

290
function TGLZBaseArray.GetMutable(Position : SizeUInt) : PT;
291
begin
292
  {$ifdef DEBUG}
293
     Assert((position < size) and (position>=0), SVectorPositionOutOfRange);
294
  {$endif}
295
  Result := @FData[Position];
296
end;
297

298
procedure TGLZBaseArray.IncreaseCapacity;
299
begin
300
  if FCapacity=0 then SetCapacity(1)
301
  else
302
    SetCapacity(FCapacity+FGrowthDelta);
303
end;
304

305
procedure TGLZBaseArray.SetCapacity(NewCapacity : SizeUInt);
306
begin
307
  if FCapacity = newCapacity then exit;
308
  //if bloExternalMemory in FOptions then
309
  //begin
310
  //  Exclude(FOptions, bloExternalMemory);
311
  //  FBaseList := nil;
312
  //end;
313
  //ReallocMem(FBaseList, newCapacity * FItemSize);
314
  FCapacity := newCapacity;
315
  SetLength(FData, FCapacity);
316
  Inc(FRevision);
317
end;
318

319
constructor TGLZBaseArray.Create;
320
begin
321
  inherited Create;
322
  FCapacity:=0;
323
 // FItemSize:=Sizeof(T); // Must be defined in subclasses  ????
324
  FGrowthDelta:= cDefaultListGrowthDelta;
325
  FParentData:=nil;
326
  FHandle:=0;
327
  FIsDirty:=false;
328
  FRevision:=0;
329
  FCount:=0;
330
  FPosition:=0;
331
  FFirstDone:=false;
332
end;
333

334
constructor TGLZBaseArray.Create(Reserved : SizeUInt);
335
begin
336
  Create;
337
  FDataSize:=Reserved*ItemSize;
338
  SetCapacity(Reserved);
339
end;
340

341
constructor TGLZBaseArray.CreateParented(AParentData : Pointer; Reserved : SizeUInt);
342
begin
343
  Create(Reserved);
344
  FParentData := AParentData;
345
end;
346

347
destructor TGLZBaseArray.Destroy;
348
begin
349
  Clear;
350
  //SetLength(FData, 0);
351
  FData := nil;
352
  inherited Destroy;
353
end;
354

355
function TGLZBaseArray.DataSize : SizeUInt;
356
begin
357
  Result := FCount * ItemSize; //FDataSize;
358
end;
359

360
function TGLZBaseArray.ItemSize : Byte;
361
begin
362
  Result := Sizeof(T); //FItemSize;
363
end;
364

365
function TGLZBaseArray.Add(const Value : T) : SizeUInt;
366
begin
367

368
  Result := FCount;
369
  if Result >= FCapacity then IncreaseCapacity;
370
  FData[Result] := Value;
371

372
  Inc(FCount);
373
end;
374

375
procedure TGLZBaseArray.Insert(Position : SizeUInt; const Value : T);
376
begin
377
  {$ifdef DEBUG}
378
      Assert(Position < FCount);
379
  {$endif}
380
  if FCount = FCapacity then IncreaseCapacity;
381
  if Position < FCount then
382
    System.Move(FData[Position], FData[Position + 1], (FCount - Position) * FItemSize);
383
  FData[Position] := Value;
384
  Inc(FCount);
385
end;
386

387
procedure TGLZBaseArray.Delete(Position : SizeUInt);
388
begin
389
  {$ifdef DEBUG}
390
    Assert(Position < FCount-1);
391
  {$endif}
392
  Dec(FCount);
393
  System.Move(FData[(Position + 1)],  // * FItemSize],
394
      FData[Position],                // * FItemSize],
395
      (FCount - Position));           // * FItemSize);
396
  Inc(FRevision);
397
end;
398

399
procedure TGLZBaseArray.Exchange(index1, index2 : SizeUInt);
400
var
401
  temp : T;
402
begin
403
  {$ifdef DEBUG}
404
    Assert((Index1 < FCount) and (Index2 < FCount));
405
  {$endif}
406
  temp := FData[index1];
407
  FData[index1] := FData[index2];
408
  FData[index2] := temp;
409
  Inc(FRevision);
410
end;
411

412
//procedure TGLZBaseArray.Move(curIndex, newIndex : SizeUInt);
413
//begin
414
//
415
//end;
416

417
procedure TGLZBaseArray.Reverse;
418
var
419
  s, e: Integer;
420
begin
421
  s := 0;
422
  e := FCount - 1;
423
  while s < e do
424
  begin
425
    Exchange(s, e);
426
    Inc(s);
427
    Dec(e);
428
  end;
429
  Inc(FRevision);
430
end;
431

432
//procedure TGLZBaseArray.AddNulls(nbVals : Cardinal);
433
//begin
434
//
435
//end;
436
//
437
//procedure TGLZBaseArray.InsertNulls(Position : SizeUInt; nbVals : Cardinal);
438
//begin
439
//
440
//end;
441

442
procedure TGLZBaseArray.Flush;
443
begin
444
  SetCount(0);
445
end;
446

447
procedure TGLZBaseArray.Clear;
448
begin
449
  SetCount(0);
450
  SetCapacity(0);
451
end;
452

453
//procedure TGLZBaseArray.AdjustCapacityToAtLeast(const size: Integer);
454
//begin
455
//  if FCapacity < Size then SetCapacity(size);
456
//end;
457

458
procedure TGLZBaseArray.Push(const Value : T);
459
begin
460
  Add(Value);
461
end;
462

463
function TGLZBaseArray.Pop : T;
464
begin
465
 Result := FData[FCount-1];
466
end;
467

468
function TGLZBaseArray.First : T;
469
begin
470
  Result := FData[0];
471
end;
472

473
function TGLZBaseArray.Last : T;
474
begin
475
  Result := Pop;
476
end;
477

478
function TGLZBaseArray.Next : T;
479
begin
480
  Result := FData[FPosition];
481
  if (FPosition < FCount) then Inc(FPosition);
482
end;
483

484
function TGLZBaseArray.Prev : T;
485
begin
486
  Result := FData[FPosition];
487
  if (FPosition > 0) then Dec(FPosition);
488
end;
489

490
function TGLZBaseArray.Current : T;
491
begin
492
 Result := FData[FPosition];
493
end;
494

495
function TGLZBaseArray.MoveNext : Boolean;
496
begin
497
  Result := false;
498
  if (FPosition >= FCount-1) then exit;
499
  Result := True;
500
  Inc(FPosition);
501
end;
502

503
function TGLZBaseArray.MovePrev : Boolean;
504
begin
505
  Result := false;
506
  if (FPosition <= 0 ) then exit;
507
  Result := True;
508
  Dec(FPosition);
509
end;
510

511
function TGLZBaseArray.MoveFirst : Boolean;
512
begin
513
 {$ifdef DEBUG}
514
    Assert(FCount>0);
515
  {$endif}
516
  result := true;
517
  FPosition := 0;
518
end;
519

520
function TGLZBaseArray.MoveLast : Boolean;
521
begin
522
  {$ifdef DEBUG}
523
     Assert(FCount>0);
524
  {$endif}
525
  result := true;
526
  FPosition := FCount-1;
527
end;
528

529
function TGLZBaseArray.GetPosition : SizeUInt;
530
begin
531
  Result := FPosition;
532
end;
533

534
function TGLZBaseArray.Seek(const pos : SizeUInt; const StartAt : Byte) : boolean;
535
var
536
  newpos : SizeUInt;
537
begin
538
  {$ifdef DEBUG}
539
    Assert(Position < FCount);
540
  {$endif}
541
  result := true;
542
  Case StartAt of
543
    0: newpos := Pos; // From Beginning
544
    1:
545
    begin
546
      newpos := (FPosition-1) + Pos; // From Current positon
547
      if newpos >= FCount then
548
      begin
549
        //newpos := FCount-1;
550
        result := false;
551
      end;
552
    end;
553
    2:
554
    begin
555
      newpos := (FCount-1) - Pos; // From End;
556
      if newpos=0 then
557
      begin
558
        //newpos := 0;
559
        result := false;
560
      end;
561
    end;
562
    else newpos := pos;
563
  end;
564
  if result then FPosition := newpos;
565
end;
566

567
function TGLZBaseArray.MoveTo(Position:SizeUInt) : Boolean;
568
begin
569
  result:= Self.Seek(Position, 0);
570
end;
571

572
function TGLZBaseArray.IsEndOfArray : Boolean;
573
begin
574
  result := (FPosition >= FCount);
575
end;
576

577
{%endregion%}
578

579
{%region%=====[ TGLZBaseArrayMap2D ]============================================}
580

581
function TGLZBaseArrayMap2D.GetValue2D(x, y : SizeUInt) : T;
582
begin
583
  {$ifdef DEBUG}
584
    assert((x<FCols) and (y<FRows));
585
  {$endif}
586
  Result := FData[y*FCols+X];
587
end;
588

589
procedure TGLZBaseArrayMap2D.SetValue2D(x, y : SizeUInt; AValue : T);
590
var
591
  pos : SizeUint;
592
begin
593
  {$ifdef DEBUG}
594
    assert((x<FCols) and (y<FRows));
595
  {$endif}
596
  pos := (y*FCols+x);
597
  {$ifdef DEBUGLOG}
598
  GlobalLogger.LogStatus('NbRows, NbCols : '+Inttostr(FRows)+', '+Inttostr(FCols));
599
  GlobalLogger.LogStatus('Set to : '+Inttostr(x)+', '+Inttostr(y));
600
  GlobalLogger.LogStatus('Set at : '+Inttostr(pos));
601
  {$endif}
602
  if FData[pos] = AValue then exit;
603
  FData[pos] := AValue;
604
end;
605

606
constructor TGLZBaseArrayMap2D.Create(Rows, Cols : SizeUInt);
607
begin
608
  Inherited Create(Rows*Cols);
609
  FRows := Rows;
610
  FCols := Cols;
611
end;
612

613
constructor TGLZBaseArrayMap2D.CreateParented(AParentData : Pointer; Rows, Cols : SizeUInt);
614
begin
615
  Inherited CreateParented(AParentData, Rows*Cols);
616
end;
617

618
function TGLZBaseArrayMap2D.MoveTo(Row : Integer; Position : Integer) : Boolean;
619
begin
620
  result := Inherited MoveTo(Row*Position);
621
end;
622

623
{%endregion%}
624

625
end.
626

627