LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Misc. lists of vectors and entities
6

7
    History :  
8
       10/12/14 - PW - Renamed VectorList unit to GLVectorList
9
       23/02/11 - Yar - Added Revision mechanism to TAffineVectorList
10
       15/12/10 - DaStr - Added Min() and Max() for TSingleList and TDoubleList
11
       04/11/10 - DaStr - Restored Delphi5 and Delphi6 compatibility
12
       24/08/10 - Yar - Added to T4ByteList more overload of Add method
13
       11/06/10 - Yar - Bugfixed binary reading TTexPointList for FPC
14
       20/05/10 - Yar - Fixes for Linux x64
15
       27/02/10 - Yar - Added TLongWordList
16
       06/02/10 - Yar - Added methods to TSingleList
17
                           Added T4ByteList
18
       25/11/09 - DanB - Fixed FastQuickSortLists for 64bit (thanks YarUnderoaker)
19
                            ASM code protected with IFDEFs
20
       16/10/08 - UweR - Compatibility fix for Delphi 2009
21
       01/03/08 - DaStr - Added Borland-style persistency support to TBaseList
22
       29/03/07 - DaStr - Added more explicit pointer dereferencing
23
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
24
       28/03/07 - DaStr - Renamed parameters in some methods
25
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
26
       25/01/07 - DaStr - Reformated code according to VCL standard
27
                             Added explicit pointer dereferencing
28
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
29
       23/01/07 - fig - Added FindOrAdd() or IndexOf() to TTexpointList
30
       16/01/07 - DaStr - Added TDoubleList
31
       28/06/04 - LR - Removed ..\ from the GLScene.inc
32
       03/09/03 - EG - Added TBaseList.Move, faster TIntegerList.Offset
33
       22/08/03 - EG - Faster FastQuickSortLists
34
       13/08/03 - SG - Added TQuaternionList
35
       05/06/03 - EG - Added MinInteger, some TIntegerList optimizations
36
       03/06/03 - EG - Added TIntegerList.BinarySearch and AddSorted (Mattias Fagerlund)
37
       22/01/03 - EG - Added AddIntegers
38
       20/01/03 - EG - Added TIntegerList.SortAndRemoveDuplicates
39
       22/10/02 - EG - Added TransformXxxx to TAffineVectorList
40
       04/07/02 - EG - Fixed TIntegerList.Add( 2 at once )
41
       15/06/02 - EG - Added TBaseListOption stuff
42
       28/05/02 - EG - TBaseList.SetCount now properly resets new items
43
       23/02/02 - EG - Added TBaseList.UseMemory
44
       20/01/02 - EG - Now uses new funcs Add/ScaleVectorArray and VectorArrayAdd
45
       06/12/01 - EG - Added Sort & MaxInteger to TIntegerList
46
       04/12/01 - EG - Added TIntegerList.IndexOf
47
       18/08/01 - EG - Fixed TAffineVectorList.Add (list)
48
       03/08/01 - EG - Added TIntegerList.AddSerie
49
       19/07/01 - EG - Added TAffineVectorList.Add (list variant)
50
       18/03/01 - EG - Additions and enhancements
51
       16/03/01 - EG - Introduced new PersistentClasses
52
       04/03/01 - EG - Optimized TAffineVectorList.Normalize (x2 speed on K7)
53
       26/02/01 - EG - VectorArrayLerp 3DNow optimized (x2 speed on K7)
54
       08/08/00 - EG - Added TSingleList
55
     20/07/00 - EG - Creation
56
  
57
}
58
unit GLVectorLists;
59

60
interface
61

62
{$I GLScene.inc}
63

64
uses
65
  Classes, SysUtils,
66
  //GLScene
67
  GLVectorTypes, GLVectorGeometry, GLPersistentClasses, GLCrossPlatform;
68

69
type
70
  // TBaseListOption
71
  //
72
  TBaseListOption = (bloExternalMemory, bloSetCountResetsMemory);
73
  TBaseListOptions = set of TBaseListOption;
74

75
  // TBaseList
76
  //
77
  { Base class for lists, introduces common behaviours. }
78
  TBaseList = class(TPersistentObject)
79
  private
80
     
81
    FCount: Integer;
82
    FCapacity: Integer;
83
    FGrowthDelta: Integer;
84
    FBufferItem: PByteArray;
85
    FOptions: TBaseListOptions;
86
    FRevision: LongWord;
87
    FTagString: string;
88
  protected
89
     
90
    // The base list pointer (untyped)
91
    FBaseList: GLVectorGeometry.PByteArray;
92
    // Must be defined by all subclasses in their constructor(s)
93
    FItemSize: Integer;
94

95
    procedure SetCount(Val: Integer);
96
        { Only function where list may be alloc'ed & freed.
97
           Resizes the array pointed by FBaseList, adjust the subclass's
98
           typed pointer accordingly if any. }
99
    procedure SetCapacity(NewCapacity: Integer); virtual;
100
    function BufferItem: PByteArray;
101
    function GetSetCountResetsMemory: Boolean;
102
    procedure SetSetCountResetsMemory(const Val: Boolean);
103

104
    // Borland-style persistency support.
105
    procedure ReadItemsData(AReader : TReader); virtual;
106
    procedure WriteItemsData(AWriter : TWriter); virtual;
107
    procedure DefineProperties(AFiler: TFiler); override;
108
  public
109
     
110
    constructor Create; override;
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
    procedure AddNulls(nbVals: Cardinal);
118
    procedure InsertNulls(Index: Integer; nbVals: Cardinal);
119

120
    procedure AdjustCapacityToAtLeast(const size: Integer);
121
    function DataSize: Integer;
122
        { Tell the list to use the specified range instead of its own.
123
           rangeCapacity should be expressed in bytes.
124
           The allocated memory is NOT managed by the list, current content
125
           if copied to the location, if the capacity is later changed, regular
126
           memory will be allocated, and the specified range no longer used. }
127
    procedure UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
128
    { Empties the list without altering capacity. }
129
    procedure Flush;
130
    { Empties the list and release. }
131
    procedure Clear;
132

133
    procedure Delete(Index: Integer);
134
    procedure DeleteItems(Index: Integer; nbVals: Cardinal);
135
    procedure Exchange(index1, index2: Integer);
136
    procedure Move(curIndex, newIndex: Integer);
137
    procedure Reverse;
138

139
        { Nb of items in the list.
140
           When assigning a Count, added items are reset to zero. }
141
    property Count: Integer read FCount write SetCount;
142
        { Current list capacity.
143
           Not persistent. }
144
    property Capacity: Integer read FCapacity write SetCapacity;
145
        { List growth granularity.
146
                 Not persistent. }
147
    property GrowthDelta: Integer read FGrowthDelta write FGrowthDelta;
148
        { If true (default value) adjusting count will reset added values.
149
           Switching this option to true will turn off this memory reset,
150
           which can improve performance is that having empty values isn't
151
           required. }
152
    property SetCountResetsMemory: Boolean read GetSetCountResetsMemory write SetSetCountResetsMemory;
153
    property TagString: string read FTagString write FTagString;
154
    { Increase by one after every content changes. }
155
    property Revision: LongWord read FRevision write FRevision;
156
  end;
157

158
  // TBaseVectorList
159
  //
160
  { Base class for vector lists, introduces common behaviours. }
161
  TBaseVectorList = class(TBaseList)
162
  private
163
     
164
  protected
165
     
166
    function GetItemAddress(Index: Integer): PFloatArray;
167

168
  public
169
     
170
    procedure WriteToFiler(writer: TVirtualWriter); override;
171
    procedure ReadFromFiler(reader: TVirtualReader); override;
172

173
    procedure GetExtents(out min, max: TAffineVector); dynamic;
174
    function Sum: TAffineVector; dynamic;
175
    procedure Normalize; dynamic;
176
    function MaxSpacing(list2: TBaseVectorList): Single; dynamic;
177
    procedure Translate(const delta: TAffineVector); overload; dynamic;
178
    procedure Translate(const delta: TBaseVectorList); overload; dynamic;
179
    procedure TranslateInv(const delta: TBaseVectorList); overload; dynamic;
180

181
        { Replace content of the list with lerp results between the two given lists.
182
           Note: you can't Lerp with Self!!! }
183
    procedure Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single); dynamic; abstract;
184
        { Replace content of the list with angle lerp between the two given lists.
185
           Note: you can't Lerp with Self!!! }
186
    procedure AngleLerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
187
    procedure AngleCombine(const list1: TBaseVectorList; intensity: Single);
188
        { Linear combination of Self with another list.
189
           Self[i]:=Self[i]+list2[i]*factor }
190
    procedure Combine(const list2: TBaseVectorList; factor: Single); dynamic;
191

192
    property ItemAddress[Index: Integer]: PFloatArray read GetItemAddress;
193

194
  end;
195

196
  // TAffineVectorList
197
  //
198
  { A list of TAffineVector.
199
   Similar to TList, but using TAffineVector as items.
200
       The list has stack-like push/pop methods. }
201
  TAffineVectorList = class(TBaseVectorList)
202
  private
203
     
204
    FList: PAffineVectorArray;
205

206
  protected
207
     
208
    function Get(Index: Integer): TAffineVector;
209
    procedure Put(Index: Integer; const item: TAffineVector);
210
    procedure SetCapacity(NewCapacity: Integer); override;
211

212
  public
213
     
214
    constructor Create; override;
215
    procedure Assign(Src: TPersistent); override;
216

217
    function Add(const item: TAffineVector): Integer; overload;
218
    function Add(const item: TVector): Integer; overload;
219
    procedure Add(const i1, i2: TAffineVector); overload;
220
    procedure Add(const i1, i2, i3: TAffineVector); overload;
221
    function Add(const item: TVector2f): Integer; overload;
222
    function Add(const item: TTexPoint): Integer; overload;
223
    function Add(const X, Y: Single): Integer; overload;
224
    function Add(const X, Y, Z: Single): Integer; overload;
225
    function Add(const X, Y, Z: Integer): Integer; overload;
226
    function AddNC(const X, Y, Z: Integer): Integer; overload;
227
    function Add(const xy: PIntegerArray; const Z: Integer): Integer; overload;
228
    function AddNC(const xy: PIntegerArray; const Z: Integer): Integer; overload;
229
    procedure Add(const list: TAffineVectorList); overload;
230
    procedure Push(const Val: TAffineVector);
231
    function Pop: TAffineVector;
232
    procedure Insert(Index: Integer; const item: TAffineVector);
233
    function IndexOf(const item: TAffineVector): Integer;
234
    function FindOrAdd(const item: TAffineVector): Integer;
235

236
    property Items[Index: Integer]: TAffineVector read Get write Put; default;
237
    property List: PAffineVectorArray read FList;
238

239
    procedure Translate(const delta: TAffineVector); overload; override;
240
    procedure Translate(const delta: TAffineVector; base, nb: Integer); overload;
241

242
    // Translates the given item
243
    procedure TranslateItem(Index: Integer; const delta: TAffineVector);
244
    // Translates given items
245
    procedure TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
246
    // Combines the given item
247
    procedure CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
248

249
        { Transforms all items by the matrix as if they were points.
250
           ie. the translation component of the matrix is honoured. }
251
    procedure TransformAsPoints(const matrix: TMatrix);
252
        { Transforms all items by the matrix as if they were vectors.
253
           ie. the translation component of the matrix is not honoured. }
254
    procedure TransformAsVectors(const matrix: TMatrix); overload;
255
    procedure TransformAsVectors(const matrix: TAffineMatrix); overload;
256

257
    procedure Normalize; override;
258
    procedure Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single); override;
259

260
    procedure Scale(factor: Single); overload;
261
    procedure Scale(const factors: TAffineVector); overload;
262
  end;
263

264
  // TVectorList
265
  //
266
  { A list of TVector.
267
   Similar to TList, but using TVector as items.
268
       The list has stack-like push/pop methods. }
269
  TVectorList = class(TBaseVectorList)
270
  private
271
     
272
    FList: PVectorArray;
273

274
  protected
275
     
276
    function Get(Index: Integer): TVector;
277
    procedure Put(Index: Integer; const item: TVector);
278
    procedure SetCapacity(NewCapacity: Integer); override;
279

280
  public
281
     
282
    constructor Create; override;
283
    procedure Assign(Src: TPersistent); override;
284

285
    function Add(const item: TVector): Integer; overload;
286
    function Add(const item: TAffineVector; w: Single): Integer; overload;
287
    function Add(const X, Y, Z, w: Single): Integer; overload;
288
    procedure Add(const i1, i2, i3: TAffineVector; w: Single); overload;
289
    function AddVector(const item: TAffineVector): Integer; overload;
290
    function AddPoint(const item: TAffineVector): Integer; overload;
291
    function AddPoint(const X, Y: Single; const Z: Single = 0): Integer; overload;
292
    procedure Push(const Val: TVector);
293
    function Pop: TVector;
294
    function IndexOf(const item: TVector): Integer;
295
    function FindOrAdd(const item: TVector): Integer;
296
    function FindOrAddPoint(const item: TAffineVector): Integer;
297
    procedure Insert(Index: Integer; const item: TVector);
298

299
    property Items[Index: Integer]: TVector read Get write Put; default;
300
    property List: PVectorArray read FList;
301

302
    procedure Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single); override;
303
  end;
304

305
  // TTexPointList
306
  //
307
  { A list of TTexPoint.
308
   Similar to TList, but using TTexPoint as items.
309
       The list has stack-like push/pop methods. }
310
  TTexPointList = class(TBaseVectorList)
311
  private
312
     
313
    FList: PTexPointArray;
314

315
  protected
316
     
317
    function Get(Index: Integer): TTexPoint;
318
    procedure Put(Index: Integer; const item: TTexPoint);
319
    procedure SetCapacity(NewCapacity: Integer); override;
320

321
  public
322
     
323
    constructor Create; override;
324
    procedure Assign(Src: TPersistent); override;
325

326
    function IndexOf(const item: TTexpoint): Integer;
327
    function FindOrAdd(const item: TTexpoint): Integer;
328

329
    function Add(const item: TTexPoint): Integer; overload;
330
    function Add(const item: TVector2f): Integer; overload;
331
    function Add(const texS, Text: Single): Integer; overload;
332
    function Add(const texS, Text: Integer): Integer; overload;
333
    function AddNC(const texS, Text: Integer): Integer; overload;
334
    function Add(const texST: PIntegerArray): Integer; overload;
335
    function AddNC(const texST: PIntegerArray): Integer; overload;
336
    procedure Push(const Val: TTexPoint);
337
    function Pop: TTexPoint;
338
    procedure Insert(Index: Integer; const item: TTexPoint);
339

340
    property Items[Index: Integer]: TTexPoint read Get write Put; default;
341
    property List: PTexPointArray read FList;
342

343
    procedure Translate(const delta: TTexPoint);
344
    procedure ScaleAndTranslate(const scale, delta: TTexPoint); overload;
345
    procedure ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer); overload;
346

347
    procedure Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single); override;
348
  end;
349

350
  // TIntegerList
351
  //
352
  { A list of Integers.
353
   Similar to TList, but using TTexPoint as items.
354
       The list has stack-like push/pop methods. }
355
  TIntegerList = class(TBaseList)
356
  private
357
     
358
    FList: PIntegerArray;
359

360
  protected
361
     
362
    function Get(Index: Integer): Integer;
363
    procedure Put(Index: Integer; const item: Integer);
364
    procedure SetCapacity(newCapacity: Integer); override;
365

366
  public
367
     
368
    constructor Create; override;
369
    procedure Assign(src: TPersistent); override;
370

371
    function Add(const item: Integer): Integer; overload;
372
    function AddNC(const item: Integer): Integer; overload;
373
    procedure Add(const i1, i2: Integer); overload;
374
    procedure Add(const i1, i2, i3: Integer); overload;
375
    procedure Add(const AList: TIntegerList); overload;
376
    procedure Push(const Val: Integer);
377
    function Pop: Integer;
378
    procedure Insert(Index: Integer; const item: Integer);
379
    procedure Remove(const item: Integer);
380
    function IndexOf(item: Integer): Integer;
381

382
    property Items[Index: Integer]: Integer read Get write Put; default;
383
    property List: PIntegerArray read FList;
384

385
        { Adds count items in an arithmetic serie.
386
           Items are (aBase), (aBase+aDelta) ... (aBase+(aCount-1)*aDelta) }
387
    procedure AddSerie(aBase, aDelta, aCount: Integer);
388
    { Add n integers at the address starting at (and including) first. }
389
    procedure AddIntegers(const First: PInteger; n: Integer); overload;
390
    { Add all integers from aList into the list. }
391
    procedure AddIntegers(const aList: TIntegerList); overload;
392
    { Add all integers from anArray into the list. }
393
    procedure AddIntegers(const anArray: array of Integer); overload;
394

395
    { Returns the minimum integer item, zero if list is empty. }
396
    function MinInteger: Integer;
397
    { Returns the maximum integer item, zero if list is empty. }
398
    function MaxInteger: Integer;
399
    { Sort items in ascending order. }
400
    procedure Sort;
401
    { Sort items in ascending order and remove duplicated integers. }
402
    procedure SortAndRemoveDuplicates;
403

404
    { Locate a value in a sorted list. }
405
    function BinarySearch(const Value: Integer): Integer; overload;
406
        { Locate a value in a sorted list.
407
           If ReturnBestFit is set to true, the routine will return the position
408
           of the largest value that's smaller than the sought value. Found will
409
           be set to True if the exact value was found, False if a "BestFit"
410
           was found. }
411
    function BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer; overload;
412

413
        { Add integer to a sorted list.
414
           Maintains the list sorted. If you have to add "a lot" of integers
415
           at once, use the Add method then Sort the list for better performance. }
416
    function AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
417
    { Removes an integer from a sorted list. }
418
    procedure RemoveSorted(const Value: Integer);
419

420
    { Adds delta to all items in the list. }
421
    procedure Offset(delta: Integer); overload;
422
    procedure Offset(delta: Integer; const base, nb: Integer); overload;
423
  end;
424

425
  TSingleArrayList = array[0..MaxInt shr 4] of Single;
426
  PSingleArrayList = ^TSingleArrayList;
427

428
  // TSingleList
429
  //
430
  { A list of Single.
431
   Similar to TList, but using Single as items.
432
       The list has stack-like push/pop methods. }
433
  TSingleList = class(TBaseList)
434
  private
435
     
436
    FList: PSingleArrayList;
437

438
  protected
439
     
440
    function Get(Index: Integer): Single;
441
    procedure Put(Index: Integer; const item: Single);
442
    procedure SetCapacity(NewCapacity: Integer); override;
443

444
  public
445
     
446
    constructor Create; override;
447
    procedure Assign(Src: TPersistent); override;
448

449
    function Add(const item: Single): Integer; overload;
450
    procedure Add(const i1, i2: Single); overload;
451
    procedure AddSingles(const First: PSingle; n: Integer); overload;
452
    procedure AddSingles(const anArray: array of Single); overload;
453
    procedure Push(const Val: Single);
454
    function Pop: Single;
455
    procedure Insert(Index: Integer; const item: Single);
456

457
    property Items[Index: Integer]: Single read Get write Put; default;
458
    property List: PSingleArrayList read FList;
459

460
    procedure AddSerie(aBase, aDelta: Single; aCount: Integer);
461

462
    { Adds delta to all items in the list. }
463
    procedure Offset(delta: Single); overload;
464

465
    { Adds to each item the corresponding item in the delta list.
466
       Performs 'Items[i]:=Items[i]+delta[i]'. 
467
       If both lists don't have the same item count, an exception is raised. }
468
    procedure Offset(const delta: TSingleList); overload;
469

470
    { Multiplies all items by factor. }
471
    procedure Scale(factor: Single);
472

473
    { Square all items. }
474
    procedure Sqr;
475

476
    { SquareRoot all items. }
477
    procedure Sqrt;
478

479
    { Computes the sum of all elements. }
480
    function Sum: Single;
481

482
    function Min: Single;
483
    function Max: Single;
484
  end;
485

486
  TDoubleArrayList = array[0..MaxInt shr 4] of Double;
487
  PDoubleArrayList = ^TDoubleArrayList;
488

489
    { A list of Double.
490
     Similar to TList, but using Double as items.
491
         The list has stack-like push/pop methods. }
492
  TDoubleList = class(TBaseList)
493
  private
494
     
495
    FList: PDoubleArrayList;
496

497
  protected
498
     
499
    function Get(Index: Integer): Double;
500
    procedure Put(Index: Integer; const item: Double);
501
    procedure SetCapacity(NewCapacity: Integer); override;
502

503
  public
504
     
505
    constructor Create; override;
506
    procedure Assign(Src: TPersistent); override;
507

508
    function Add(const item: Double): Integer;
509
    procedure Push(const Val: Double);
510
    function Pop: Double;
511
    procedure Insert(Index: Integer; const item: Double);
512

513
    property Items[Index: Integer]: Double read Get write Put; default;
514
    property List: PDoubleArrayList read FList;
515

516
    procedure AddSerie(aBase, aDelta: Double; aCount: Integer);
517

518
    { Adds delta to all items in the list. }
519
    procedure Offset(delta: Double); overload;
520
        { Adds to each item the corresponding item in the delta list.
521
           Performs 'Items[i]:=Items[i]+delta[i]'. 
522
           If both lists don't have the same item count, an exception is raised. }
523
    procedure Offset(const delta: TDoubleList); overload;
524
    { Multiplies all items by factor. }
525
    procedure Scale(factor: Double);
526
    { Square all items. }
527
    procedure Sqr;
528
    { SquareRoot all items. }
529
    procedure Sqrt;
530

531
    { Computes the sum of all elements. }
532
    function Sum: Double;
533

534
    function Min: Single;
535
    function Max: Single;
536
  end;
537

538
  // TByteList
539
  //
540
  { A list of bytes.
541
   Similar to TList, but using Byte as items. }
542
  TByteList = class(TBaseList)
543
  private
544
     
545
    FList: PByteArray;
546

547
  protected
548
     
549
    function Get(Index: Integer): Byte;
550
    procedure Put(Index: Integer; const item: Byte);
551
    procedure SetCapacity(NewCapacity: Integer); override;
552

553
  public
554
     
555
    constructor Create; override;
556
    procedure Assign(Src: TPersistent); override;
557

558
    function Add(const item: Byte): Integer;
559
    procedure Insert(Index: Integer; const item: Byte);
560

561
    property Items[Index: Integer]: Byte read Get write Put; default;
562
    property List: PByteArray read FList;
563

564
  end;
565

566
  // TQuaternionList
567
  //
568
  { A list of TQuaternion.
569
     Similar to TList, but using TQuaternion as items.
570
        The list has stack-like push/pop methods. }
571
  TQuaternionList = class(TBaseVectorList)
572
  private
573
     
574
    FList: PQuaternionArray;
575

576
  protected
577
     
578
    function Get(Index: Integer): TQuaternion;
579
    procedure Put(Index: Integer; const item: TQuaternion);
580
    procedure SetCapacity(NewCapacity: Integer); override;
581

582
  public
583
     
584
    constructor Create; override;
585
    procedure Assign(Src: TPersistent); override;
586

587
    function Add(const item: TQuaternion): Integer; overload;
588
    function Add(const item: TAffineVector; w: Single): Integer; overload;
589
    function Add(const X, Y, Z, W: Single): Integer; overload;
590
    procedure Push(const Val: TQuaternion);
591
    function Pop: TQuaternion;
592
    function IndexOf(const item: TQuaternion): Integer;
593
    function FindOrAdd(const item: TQuaternion): Integer;
594
    procedure Insert(Index: Integer; const item: TQuaternion);
595

596
    property Items[Index: Integer]: TQuaternion read Get write Put; default;
597
    property List: PQuaternionArray read FList;
598

599
    { Lerps corresponding quaternions from both lists using QuaternionSlerp. }
600
    procedure Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single); override;
601
        { Multiplies corresponding quaternions after the second quaternion is
602
           slerped with the IdentityQuaternion using factor. This allows for weighted
603
           combining of rotation transforms using quaternions. }
604
    procedure Combine(const list2: TBaseVectorList; factor: Single); override;
605
  end;
606

607
  // 4 byte union contain access like Integer, Single and four Byte
608
	T4ByteData = packed record
609
    case Byte of
610
    0 : (Bytes : record Value : array[0..3] of Byte; end);
611
    1 : (Int   : record Value : Integer; end);
612
    2 : (UInt  : record Value : Cardinal; end);
613
    3 : (Float : record Value : Single; end);
614
    4 : (Word  : record Value : array[0..1] of Word; end);
615
  end;
616

617
  T4ByteArrayList = array[0..MaxInt shr 4] of T4ByteData;
618
  P4ByteArrayList = ^T4ByteArrayList;
619

620
  // T4ByteList
621
  //
622
  { A list of T4ByteData. }
623

624
  T4ByteList = class(TBaseList)
625
  private
626
     
627
    FList: P4ByteArrayList;
628
  protected
629
     
630
    function  Get(Index: Integer): T4ByteData;
631
    procedure Put(Index: Integer; const item: T4ByteData);
632
    procedure SetCapacity(NewCapacity: Integer); override;
633
  public
634
     
635
    constructor Create; override;
636
    procedure Assign(Src: TPersistent); override;
637

638
    function  Add(const item: T4ByteData): Integer; overload;
639
    procedure Add(const i1: Single); overload;
640
    procedure Add(const i1, i2: Single); overload;
641
    procedure Add(const i1, i2, i3: Single); overload;
642
    procedure Add(const i1, i2, i3, i4: Single); overload;
643
    procedure Add(const i1: Integer); overload;
644
    procedure Add(const i1, i2: Integer); overload;
645
    procedure Add(const i1, i2, i3: Integer); overload;
646
    procedure Add(const i1, i2, i3, i4: Integer); overload;
647
    procedure Add(const i1: Cardinal); overload;
648
    procedure Add(const i1, i2: Cardinal); overload;
649
    procedure Add(const i1, i2, i3: Cardinal); overload;
650
    procedure Add(const i1, i2, i3, i4: Cardinal); overload;
651
    procedure Add(const AList: T4ByteList); overload;
652
    procedure Push(const Val: T4ByteData);
653
    function  Pop: T4ByteData;
654
    procedure Insert(Index: Integer; const item: T4ByteData);
655

656
    property Items[Index: Integer]: T4ByteData read Get write Put; default;
657
    property List: P4ByteArrayList read FList;
658
  end;
659

660
  // TLongWordList
661
  //
662
  TLongWordList = class(TBaseList)
663
  private
664
     
665
    FList: PLongWordArray;
666

667
  protected
668
     
669
    function Get(Index: Integer): LongWord;
670
    procedure Put(Index: Integer; const item: LongWord);
671
    procedure SetCapacity(newCapacity: Integer); override;
672

673
  public
674
     
675
    constructor Create; override;
676
    procedure Assign(src: TPersistent); override;
677

678
    function Add(const item: LongWord): Integer; overload;
679
    function AddNC(const item: LongWord): Integer; overload;
680
    procedure Add(const i1, i2: LongWord); overload;
681
    procedure Add(const i1, i2, i3: LongWord); overload;
682
    procedure Add(const AList: TLongWordList); overload;
683
    procedure Push(const Val: LongWord);
684
    function Pop: LongWord;
685
    procedure Insert(Index: Integer; const item: LongWord);
686
    procedure Remove(const item: LongWord);
687
    function IndexOf(item: Integer): LongWord;
688

689
    property Items[Index: Integer]: LongWord read Get write Put; default;
690
    property List: PLongWordArray read FList;
691

692
    { Add n integers at the address starting at (and including) first. }
693
    procedure AddLongWords(const First: PLongWord; n: Integer); overload;
694
    { Add all integers from aList into the list. }
695
    procedure AddLongWords(const aList: TLongWordList); overload;
696
    { Add all integers from anArray into the list. }
697
    procedure AddLongWords(const anArray: array of LongWord); overload;
698
  end;
699

700
{ Sort the refList in ascending order, ordering objList (TList) on the way. }
701
procedure QuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TList); overload;
702

703
{ Sort the refList in ascending order, ordering objList (TBaseList) on the way. }
704
procedure QuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TBaseList); overload;
705

706
{ Sort the refList in ascending order, ordering objList on the way.
707
   Use if, and *ONLY* if refList contains only values superior or equal to 1. }
708
procedure FastQuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TPersistentObjectList);
709

710
// ------------------------------------------------------------------
711
// ------------------------------------------------------------------
712
// ------------------------------------------------------------------
713
implementation
714
// ------------------------------------------------------------------
715
// ------------------------------------------------------------------
716
// ------------------------------------------------------------------
717

718
const
719
  cDefaultListGrowthDelta = 16;
720

721
// QuickSortLists (TList)
722
//
723
procedure QuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TList);
724
var
725
  I, J: Integer;
726
  P:    Single;
727
begin
728
  if endIndex - startIndex > 1 then
729
  begin
730
    repeat
731
      I := startIndex;
732
      J := endIndex;
733
      P := refList.List^[(I + J) shr 1];
734
      repeat
735
        while Single(refList.List^[I]) < P do
736
          Inc(I);
737
        while Single(refList.List^[J]) > P do
738
          Dec(J);
739
        if I <= J then
740
        begin
741
          refList.Exchange(I, J);
742
          objList.Exchange(I, J);
743
          Inc(I);
744
          Dec(J);
745
        end;
746
      until I > J;
747
      if startIndex < J then
748
        QuickSortLists(startIndex, J, refList, objList);
749
      startIndex := I;
750
    until I >= endIndex;
751
  end
752
  else
753
  if endIndex - startIndex > 0 then
754
  begin
755
    p := refList.List^[startIndex];
756
    if refList.List^[endIndex] < p then
757
    begin
758
      refList.Exchange(startIndex, endIndex);
759
      objList.Exchange(startIndex, endIndex);
760
    end;
761
  end;
762
end;
763

764
// QuickSortLists (TBaseList)
765
//
766
procedure QuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TBaseList);
767
var
768
  I, J: Integer;
769
  P:    Single;
770
begin
771
  if endIndex - startIndex > 1 then
772
  begin
773
    repeat
774
      I := startIndex;
775
      J := endIndex;
776
      P := refList.List^[(I + J) shr 1];
777
      repeat
778
        while Single(refList.List^[I]) < P do
779
          Inc(I);
780
        while Single(refList.List^[J]) > P do
781
          Dec(J);
782
        if I <= J then
783
        begin
784
          refList.Exchange(I, J);
785
          objList.Exchange(I, J);
786
          Inc(I);
787
          Dec(J);
788
        end;
789
      until I > J;
790
      if startIndex < J then
791
        QuickSortLists(startIndex, J, refList, objList);
792
      startIndex := I;
793
    until I >= endIndex;
794
  end
795
  else
796
  if endIndex - startIndex > 0 then
797
  begin
798
    p := refList.List^[startIndex];
799
    if refList.List^[endIndex] < p then
800
    begin
801
      refList.Exchange(startIndex, endIndex);
802
      objList.Exchange(startIndex, endIndex);
803
    end;
804
  end;
805
end;
806

807
// FastQuickSortLists
808
//
809
procedure FastQuickSortLists(startIndex, endIndex: Integer; refList: TSingleList; objList: TPersistentObjectList);
810
var
811
  I, J:    Integer;
812
  p, Temp: Integer;
813
  ppl:     PIntegerArray;
814
  oTemp    : Pointer;
815
  oppl     : PPointerArray;
816
begin
817
  // All singles are >=1, so IEEE format allows comparing them as if they were integers
818
  ppl := PIntegerArray(@refList.List[0]);
819
  oppl := PPointerArray(objList.List);
820
  if endIndex > startIndex + 1 then
821
  begin
822
    repeat
823
      I := startIndex;
824
      J := endIndex;
825
      p := PInteger(@refList.List[(I + J) shr 1])^;
826
      repeat
827
        while ppl^[I] < p do
828
          Inc(I);
829
        while ppl^[J] > p do
830
          Dec(J);
831
        if I <= J then
832
        begin
833
          // swap integers
834
          Temp := ppl^[I];
835
          ppl^[I] := ppl^[J];
836
          ppl^[J] := Temp;
837
          // swap pointers
838
          oTemp := oppl^[I];
839
          oppl^[I] := oppl^[J];
840
          oppl^[J] := oTemp;
841
          Inc(I);
842
          Dec(J);
843
        end;
844
      until I > J;
845
      if startIndex < J then
846
        FastQuickSortLists(startIndex, J, refList, objList);
847
      startIndex := I;
848
    until I >= endIndex;
849
  end
850
  else
851
  if endIndex > startIndex then
852
  begin
853
    if ppl^[endIndex] < ppl^[startIndex] then
854
    begin
855
      I := endIndex;
856
      J := startIndex;
857
      // swap integers
858
      Temp := ppl^[I];
859
      ppl^[I] := ppl^[J];
860
      ppl^[J] := Temp;
861
      // swap pointers
862
      oTemp := oppl^[I];
863
      oppl^[I] := oppl^[J];
864
      oppl^[J] := oTemp;
865
    end;
866
  end;
867
end;
868

869
// ------------------
870
// ------------------ TBaseList ------------------
871
// ------------------
872

873
// Create
874
//
875
constructor TBaseList.Create;
876
begin
877
  inherited Create;
878
  FOptions := [bloSetCountResetsMemory];
879
end;
880

881
// Destroy
882
//
883
destructor TBaseList.Destroy;
884
begin
885
  Clear;
886
  if Assigned(FBufferItem) then
887
    FreeMem(FBufferItem);
888
  inherited;
889
end;
890

891
 
892
//
893
procedure TBaseList.Assign(Src: TPersistent);
894
begin
895
  if (Src is TBaseList) then
896
  begin
897
    SetCapacity(TBaseList(Src).Count);
898
    FGrowthDelta := TBaseList(Src).FGrowthDelta;
899
    FCount := FCapacity;
900
    FTagString := TBaseList(Src).FTagString;
901
    Inc(FRevision);
902
  end
903
  else
904
    inherited;
905
end;
906

907
// DefineProperties
908
procedure TBaseList.DefineProperties(AFiler: TFiler);
909
begin
910
  inherited DefineProperties(AFiler);
911
  AFiler.DefineProperty('Items', ReadItemsData, WriteItemsData, True);
912
end;
913

914
// ReadItemsData
915
procedure TBaseList.ReadItemsData(AReader: TReader);
916
var
917
  lData: AnsiString;
918
  lOutputText: string;
919
begin
920
  lOutputText := AReader.ReadString;
921
  SetLength(lData, Length(lOutputText) div 2 + 1);
922
  HexToBin(PChar(lOutputText), PAnsiChar(lData), Length(lData));
923
  LoadFromString(string(lData));
924
end;
925

926
// WriteItemsData
927
procedure TBaseList.WriteItemsData(AWriter: TWriter);
928
var
929
  lData: AnsiString;
930
  lOutputText: String;
931
begin
932
  lData := AnsiString(SaveToString);
933
  SetLength(lOutputText, Length(lData) * 2);
934
  BinToHex(PAnsiChar(lData), PChar(lOutputText), Length(lData));
935
  AWriter.WriteString(lOutputText);
936
end;
937

938
// WriteToFiler
939
//
940
procedure TBaseList.WriteToFiler(writer: TVirtualWriter);
941
begin
942
  inherited;
943
  with writer do
944
  begin
945
    WriteInteger(0); // Archive Version 0
946
    WriteInteger(Count);
947
    WriteInteger(FItemSize);
948
    if Count > 0 then
949
      write(FBaseList[0], Count * FItemSize);
950
  end;
951
end;
952

953
// ReadFromFiler
954
//
955
procedure TBaseList.ReadFromFiler(reader: TVirtualReader);
956
var
957
  archiveVersion: Integer;
958
begin
959
  inherited;
960
  archiveVersion := reader.ReadInteger;
961
  if archiveVersion = 0 then
962
    with reader do
963
    begin
964
      FCount := ReadInteger;
965
      FItemSize := ReadInteger;
966
      SetCapacity(Count);
967
      if Count > 0 then
968
        read(FBaseList[0], Count * FItemSize);
969
    end
970
  else
971
    RaiseFilerException(archiveVersion);
972
  Inc(FRevision);
973
end;
974

975
// SetCount
976
//
977
procedure TBaseList.SetCount(Val: Integer);
978
begin
979
  Assert(Val >= 0);
980
  if Val > FCapacity then
981
    SetCapacity(Val);
982
  if (Val > FCount) and (bloSetCountResetsMemory in FOptions) then
983
    FillChar(FBaseList[FItemSize * FCount], (Val - FCount) * FItemSize, 0);
984
  FCount := Val;
985
  Inc(FRevision);
986
end;
987

988
// SetCapacity
989
//
990
procedure TBaseList.SetCapacity(newCapacity: Integer);
991
begin
992
  if newCapacity <> FCapacity then
993
  begin
994
    if bloExternalMemory in FOptions then
995
    begin
996
      Exclude(FOptions, bloExternalMemory);
997
      FBaseList := nil;
998
    end;
999
    ReallocMem(FBaseList, newCapacity * FItemSize);
1000
    FCapacity := newCapacity;
1001
    Inc(FRevision);
1002
  end;
1003
end;
1004

1005
// AddNulls
1006
//
1007
procedure TBaseList.AddNulls(nbVals: Cardinal);
1008
begin
1009
  if Integer(nbVals) + Count > Capacity then
1010
    SetCapacity(Integer(nbVals) + Count);
1011
  FillChar(FBaseList[FCount * FItemSize], Integer(nbVals) * FItemSize, 0);
1012
  FCount := FCount + Integer(nbVals);
1013
  Inc(FRevision);
1014
end;
1015

1016
// InsertNulls
1017
//
1018
procedure TBaseList.InsertNulls(Index: Integer; nbVals: Cardinal);
1019
var
1020
  nc: Integer;
1021
begin
1022
{$IFOPT R+}
1023
    Assert(Cardinal(Index) < Cardinal(FCount));
1024
{$ENDIF}
1025
  if nbVals > 0 then
1026
  begin
1027
    nc := FCount + Integer(nbVals);
1028
    if nc > FCapacity then
1029
      SetCapacity(nc);
1030
    if Index < FCount then
1031
      System.Move(FBaseList[Index * FItemSize],
1032
        FBaseList[(Index + Integer(nbVals)) * FItemSize],
1033
        (FCount - Index) * FItemSize);
1034
    FillChar(FBaseList[Index * FItemSize], Integer(nbVals) * FItemSize, 0);
1035
    FCount := nc;
1036
    Inc(FRevision);
1037
  end;
1038
end;
1039

1040
// AdjustCapacityToAtLeast
1041
//
1042
procedure TBaseList.AdjustCapacityToAtLeast(const size: Integer);
1043
begin
1044
  if Capacity < size then
1045
    Capacity := size;
1046
end;
1047

1048
// DataSize
1049
//
1050

1051
function TBaseList.DataSize: Integer;
1052
begin
1053
  Result := FItemSize * FCount;
1054
end;
1055

1056
// BufferItem
1057
//
1058
function TBaseList.BufferItem: PByteArray;
1059
begin
1060
  if not Assigned(FBufferItem) then
1061
    GetMem(FBufferItem, FItemSize);
1062
  Result := FBufferItem;
1063
end;
1064

1065
// GetSetCountResetsMemory
1066
//
1067
function TBaseList.GetSetCountResetsMemory: Boolean;
1068
begin
1069
  Result := (bloSetCountResetsMemory in FOptions);
1070
end;
1071

1072
// SetSetCountResetsMemory
1073
//
1074
procedure TBaseList.SetSetCountResetsMemory(const Val: Boolean);
1075
begin
1076
  if Val then
1077
    Include(FOptions, bloSetCountResetsMemory)
1078
  else
1079
    Exclude(FOptions, bloSetCountResetsMemory);
1080
end;
1081

1082
// UseMemory
1083
//
1084
procedure TBaseList.UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
1085
begin
1086
  rangeCapacity := rangeCapacity div FItemSize;
1087
  if rangeCapacity < FCount then
1088
    Exit;
1089
  // transfer data
1090
  System.Move(FBaseList^, rangeStart^, FCount * FItemSize);
1091
  if not (bloExternalMemory in FOptions) then
1092
  begin
1093
    FreeMem(FBaseList);
1094
    Include(FOptions, bloExternalMemory);
1095
  end;
1096
  FBaseList := rangeStart;
1097
  FCapacity := rangeCapacity;
1098
  SetCapacity(FCapacity); // notify subclasses
1099
end;
1100

1101
// Flush
1102
//
1103
procedure TBaseList.Flush;
1104
begin
1105
  if Assigned(Self) then
1106
  begin
1107
    SetCount(0);
1108
  end;
1109
end;
1110

1111
// Clear
1112
//
1113
procedure TBaseList.Clear;
1114
begin
1115
  if Assigned(Self) then
1116
  begin
1117
    SetCount(0);
1118
    SetCapacity(0);
1119
  end;
1120
end;
1121

1122
// Delete
1123
//
1124
procedure TBaseList.Delete(Index: Integer);
1125
begin
1126
{$IFOPT R+}
1127
    Assert(Cardinal(index) < Cardinal(FCount));
1128
{$ENDIF}
1129
  Dec(FCount);
1130
  if Index < FCount then
1131
    System.Move(FBaseList[(Index + 1) * FItemSize],
1132
      FBaseList[Index * FItemSize],
1133
      (FCount - Index) * FItemSize);
1134
  Inc(FRevision);
1135
end;
1136

1137
// DeleteItems
1138
//
1139
procedure TBaseList.DeleteItems(Index: Integer; nbVals: Cardinal);
1140
begin
1141
{$IFOPT R+}
1142
    Assert(Cardinal(index) < Cardinal(FCount));
1143
{$ENDIF}
1144
  if nbVals > 0 then
1145
  begin
1146
    if Index + Integer(nbVals) < FCount then
1147
    begin
1148
      System.Move(FBaseList[(Index + Integer(nbVals)) * FItemSize],
1149
        FBaseList[Index * FItemSize],
1150
        (FCount - Index - Integer(nbVals)) * FItemSize);
1151
    end;
1152
    Dec(FCount, nbVals);
1153
    Inc(FRevision);
1154
  end;
1155
end;
1156

1157
// Exchange
1158
//
1159
procedure TBaseList.Exchange(index1, index2: Integer);
1160
var
1161
  buf: Integer;
1162
  p:   PIntegerArray;
1163
begin
1164
{$IFOPT R+}
1165
    Assert((Cardinal(index1) < Cardinal(FCount)) and (Cardinal(index2) < Cardinal(FCount)));
1166
{$ENDIF}
1167
  if FItemSize = 4 then
1168
  begin
1169
    p := PIntegerArray(FBaseList);
1170
    buf := p^[index1];
1171
    p^[index1] := p^[index2];
1172
    p^[index2] := buf;
1173
  end
1174
  else
1175
  begin
1176
    System.Move(FBaseList[index1 * FItemSize], BufferItem[0], FItemSize);
1177
    System.Move(FBaseList[index2 * FItemSize], FBaseList[index1 * FItemSize], FItemSize);
1178
    System.Move(BufferItem[0], FBaseList[index2 * FItemSize], FItemSize);
1179
  end;
1180
  Inc(FRevision);
1181
end;
1182

1183
// Move
1184
//
1185
procedure TBaseList.Move(curIndex, newIndex: Integer);
1186
begin
1187
  if curIndex <> newIndex then
1188
  begin
1189
{$IFOPT R+}
1190
        Assert(Cardinal(newIndex) < Cardinal(Count));
1191
        Assert(Cardinal(curIndex) < Cardinal(Count));
1192
{$ENDIF}
1193
    if FItemSize = 4 then
1194
      PInteger(BufferItem)^ := PInteger(@FBaseList[curIndex * FItemSize])^
1195
    else
1196
      System.Move(FBaseList[curIndex * FItemSize], BufferItem[0], FItemSize);
1197
    if curIndex < newIndex then
1198
    begin
1199
      // curIndex+1 necessarily exists since curIndex<newIndex and newIndex<Count
1200
      System.Move(FBaseList[(curIndex + 1) * FItemSize], FBaseList[curIndex * FItemSize],
1201
        (newIndex - curIndex - 1) * FItemSize);
1202
    end
1203
    else
1204
    begin
1205
      // newIndex+1 necessarily exists since newIndex<curIndex and curIndex<Count
1206
      System.Move(FBaseList[newIndex * FItemSize], FBaseList[(newIndex + 1) * FItemSize],
1207
        (curIndex - newIndex - 1) * FItemSize);
1208
    end;
1209
    if FItemSize = 4 then
1210
      PInteger(@FBaseList[newIndex * FItemSize])^ := PInteger(BufferItem)^
1211
    else
1212
      System.Move(BufferItem[0], FBaseList[newIndex * FItemSize], FItemSize);
1213
    Inc(FRevision);
1214
  end;
1215
end;
1216

1217
// Reverse
1218
//
1219
procedure TBaseList.Reverse;
1220
var
1221
  s, e: Integer;
1222
begin
1223
  s := 0;
1224
  e := Count - 1;
1225
  while s < e do
1226
  begin
1227
    Exchange(s, e);
1228
    Inc(s);
1229
    Dec(e);
1230
  end;
1231
  Inc(FRevision);
1232
end;
1233

1234
// ------------------
1235
// ------------------ TBaseVectorList ------------------
1236
// ------------------
1237

1238
// WriteToFiler
1239
//
1240
procedure TBaseVectorList.WriteToFiler(writer: TVirtualWriter);
1241
begin
1242
  inherited;
1243
  if Self is TTexPointList then
1244
    exit;
1245
  with writer do
1246
  begin
1247
    WriteInteger(0); // Archive Version 0
1248
    // nothing
1249
  end;
1250
end;
1251

1252
// ReadFromFiler
1253
//
1254
procedure TBaseVectorList.ReadFromFiler(reader: TVirtualReader);
1255
var
1256
  archiveVersion: Integer;
1257
begin
1258
  inherited;
1259
  if Self is TTexPointList then
1260
    exit;
1261
  archiveVersion := reader.ReadInteger;
1262
  if archiveVersion = 0 then
1263
    with reader do
1264
    begin
1265
      // nothing
1266
    end
1267
  else
1268
    RaiseFilerException(archiveVersion);
1269
end;
1270

1271
// GetExtents
1272
//
1273
procedure TBaseVectorList.GetExtents(out min, max: TAffineVector);
1274
var
1275
  I, K: Integer;
1276
  f:    Single;
1277
  ref:  PFloatArray;
1278
const
1279
  cBigValue: Single   = 1E50;
1280
  cSmallValue: Single = -1E50;
1281
begin
1282
  SetVector(min, cBigValue, cBigValue, cBigValue);
1283
  SetVector(max, cSmallValue, cSmallValue, cSmallValue);
1284
  for I := 0 to Count - 1 do
1285
  begin
1286
    ref := ItemAddress[I];
1287
    for K := 0 to 2 do
1288
    begin
1289
      f := ref^[K];
1290
      if f < min.V[K] then
1291
        min.V[K] := f;
1292
      if f > max.V[K] then
1293
        max.V[K] := f;
1294
    end;
1295
  end;
1296
end;
1297

1298
// Sum
1299
//
1300
function TBaseVectorList.Sum: TAffineVector;
1301
var
1302
  I: Integer;
1303
begin
1304
  Result := NullVector;
1305
  for I := 0 to Count - 1 do
1306
    AddVector(Result, PAffineVector(ItemAddress[I])^);
1307
end;
1308

1309
// Normalize
1310
//
1311
procedure TBaseVectorList.Normalize;
1312
var
1313
  I: Integer;
1314
begin
1315
  for I := 0 to Count - 1 do
1316
    NormalizeVector(PAffineVector(ItemAddress[I])^);
1317
  Inc(FRevision);
1318
end;
1319

1320
// MaxSpacing
1321
//
1322
function TBaseVectorList.MaxSpacing(list2: TBaseVectorList): Single;
1323
var
1324
  I: Integer;
1325
  s: Single;
1326
begin
1327
  Assert(list2.Count = Count);
1328
  Result := 0;
1329
  for I := 0 to Count - 1 do
1330
  begin
1331
    s := VectorSpacing(PAffineVector(ItemAddress[I])^,
1332
      PAffineVector(list2.ItemAddress[I])^);
1333
    if s > Result then
1334
      Result := s;
1335
  end;
1336
end;
1337

1338
// Translate (delta)
1339
//
1340
procedure TBaseVectorList.Translate(const delta: TAffineVector);
1341
var
1342
  I: Integer;
1343
begin
1344
  for I := 0 to Count - 1 do
1345
    AddVector(PAffineVector(ItemAddress[I])^, delta);
1346
  Inc(FRevision);
1347
end;
1348

1349
// Translate (TBaseVectorList)
1350
//
1351
procedure TBaseVectorList.Translate(const delta: TBaseVectorList);
1352
var
1353
  I: Integer;
1354
begin
1355
  Assert(Count <= delta.Count);
1356
  for I := 0 to Count - 1 do
1357
    AddVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
1358
  Inc(FRevision);
1359
end;
1360

1361
// TranslateInv (TBaseVectorList)
1362
//
1363
procedure TBaseVectorList.TranslateInv(const delta: TBaseVectorList);
1364
var
1365
  I: Integer;
1366
begin
1367
  Assert(Count <= delta.Count);
1368
  for I := 0 to Count - 1 do
1369
    SubtractVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
1370
  Inc(FRevision);
1371
end;
1372

1373
// AngleLerp
1374
//
1375
procedure TBaseVectorList.AngleLerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
1376
var
1377
  I: Integer;
1378
begin
1379
  Assert(list1.Count = list2.Count);
1380
  if list1 <> list2 then
1381
  begin
1382
    if lerpFactor = 0 then
1383
      Assign(list1)
1384
    else
1385
    if lerpFactor = 1 then
1386
      Assign(list2)
1387
    else
1388
    begin
1389
      Capacity := list1.Count;
1390
      FCount := list1.Count;
1391
      for I := 0 to list1.Count - 1 do
1392
        PAffineVector(ItemAddress[I])^ := VectorAngleLerp(PAffineVector(list1.ItemAddress[I])^,
1393
          PAffineVector(list2.ItemAddress[I])^,
1394
          lerpFactor);
1395
    end;
1396
  end
1397
  else
1398
    Assign(list1);
1399
  Inc(FRevision);
1400
end;
1401

1402
// AngleCombine
1403
//
1404
procedure TBaseVectorList.AngleCombine(const list1: TBaseVectorList; intensity: Single);
1405
var
1406
  I: Integer;
1407
begin
1408
  Assert(list1.Count = Count);
1409
  for I := 0 to Count - 1 do
1410
    PAffineVector(ItemAddress[I])^ := VectorAngleCombine(PAffineVector(ItemAddress[I])^,
1411
      PAffineVector(list1.ItemAddress[I])^,
1412
      intensity);
1413
  Inc(FRevision);
1414
end;
1415

1416
// Combine
1417
//
1418
procedure TBaseVectorList.Combine(const list2: TBaseVectorList; factor: Single);
1419
var
1420
  I: Integer;
1421
begin
1422
  Assert(list2.Count >= Count);
1423
  for I := 0 to Count - 1 do
1424
    CombineVector(PAffineVector(ItemAddress[I])^,
1425
      PAffineVector(list2.ItemAddress[I])^,
1426
      factor);
1427
  Inc(FRevision);
1428
end;
1429

1430
// GetItemAddress
1431
//
1432
function TBaseVectorList.GetItemAddress(Index: Integer): PFloatArray;
1433
begin
1434
{$IFOPT R+}
1435
    Assert(Cardinal(Index) < Cardinal(FCount));
1436
{$ENDIF}
1437
  Result := PFloatArray(@FBaseList[Index * FItemSize]);
1438
end;
1439

1440
// ------------------
1441
// ------------------ TAffineVectorList ------------------
1442
// ------------------
1443

1444
// Create
1445
//
1446
constructor TAffineVectorList.Create;
1447
begin
1448
  FItemSize := SizeOf(TAffineVector);
1449
  inherited Create;
1450
  FGrowthDelta := cDefaultListGrowthDelta;
1451
end;
1452

1453
 
1454
//
1455
procedure TAffineVectorList.Assign(Src: TPersistent);
1456
begin
1457
  if Assigned(Src) then
1458
  begin
1459
    inherited;
1460
    if (Src is TAffineVectorList) then
1461
      System.Move(TAffineVectorList(Src).FList^, FList^, FCount * SizeOf(TAffineVector));
1462
  end
1463
  else
1464
    Clear;
1465
end;
1466

1467
// Add (affine)
1468
//
1469
function TAffineVectorList.Add(const item: TAffineVector): Integer;
1470
begin
1471
  Result := FCount;
1472
  if Result = FCapacity then
1473
    SetCapacity(FCapacity + FGrowthDelta);
1474
  FList^[Result] := Item;
1475
  Inc(FCount);
1476
  Inc(FRevision);
1477
end;
1478

1479
// Add (hmg)
1480
//
1481
function TAffineVectorList.Add(const item: TVector): Integer;
1482
begin
1483
  Result := Add(PAffineVector(@item)^);
1484
end;
1485

1486
// Add (2 affine)
1487
//
1488
procedure TAffineVectorList.Add(const i1, i2: TAffineVector);
1489
begin
1490
  Inc(FCount, 2);
1491
  while FCount > FCapacity do
1492
    SetCapacity(FCapacity + FGrowthDelta);
1493
  FList^[FCount - 2] := i1;
1494
  FList^[FCount - 1] := i2;
1495
  Inc(FRevision);
1496
end;
1497

1498
// Add (3 affine)
1499
//
1500
procedure TAffineVectorList.Add(const i1, i2, i3: TAffineVector);
1501
begin
1502
  Inc(FCount, 3);
1503
  while FCount > FCapacity do
1504
    SetCapacity(FCapacity + FGrowthDelta);
1505
  FList^[FCount - 3] := i1;
1506
  FList^[FCount - 2] := i2;
1507
  FList^[FCount - 1] := i3;
1508
  Inc(FRevision);
1509
end;
1510

1511
// Add (vector2f)
1512
//
1513
function TAffineVectorList.Add(const item: TVector2f): Integer;
1514
begin
1515
  Result := Add(AffineVectorMake(item.V[0], item.V[1], 0));
1516
end;
1517

1518
// Add (texpoint)
1519
//
1520
function TAffineVectorList.Add(const item: TTexPoint): Integer;
1521
begin
1522
  Result := Add(AffineVectorMake(item.S, item.T, 0));
1523
end;
1524

1525
// Add
1526
//
1527
function TAffineVectorList.Add(const X, Y: Single): Integer;
1528
var
1529
  v: PAffineVector;
1530
begin
1531
  Result := FCount;
1532
  Inc(FCount);
1533
  while FCount > FCapacity do
1534
    SetCapacity(FCapacity + FGrowthDelta);
1535
  v := @List[Result];
1536
  v^.V[0] := X;
1537
  v^.V[1] := Y;
1538
  v^.V[2] := 0;
1539
  Inc(FRevision);
1540
end;
1541

1542
// Add
1543
//
1544
function TAffineVectorList.Add(const X, Y, Z: Single): Integer;
1545
var
1546
  v: PAffineVector;
1547
begin
1548
  Result := FCount;
1549
  Inc(FCount);
1550
  while FCount > FCapacity do
1551
    SetCapacity(FCapacity + FGrowthDelta);
1552
  v := @List[Result];
1553
  v^.V[0] := X;
1554
  v^.V[1] := Y;
1555
  v^.V[2] := Z;
1556
  Inc(FRevision);
1557
end;
1558

1559
// Add (3 ints)
1560
//
1561
function TAffineVectorList.Add(const X, Y, Z: Integer): Integer;
1562
var
1563
  v: PAffineVector;
1564
begin
1565
  Result := FCount;
1566
  if Result = FCapacity then
1567
    SetCapacity(FCapacity + FGrowthDelta);
1568
  v := @List[Result];
1569
  v^.V[0] := X;
1570
  v^.V[1] := Y;
1571
  v^.V[2] := Z;
1572
  Inc(FCount);
1573
  Inc(FRevision);
1574
end;
1575

1576
// Add (3 ints, no capacity check)
1577
//
1578
function TAffineVectorList.AddNC(const X, Y, Z: Integer): Integer;
1579
var
1580
  v: PAffineVector;
1581
begin
1582
  Result := FCount;
1583
  v := @List[Result];
1584
  v^.V[0] := X;
1585
  v^.V[1] := Y;
1586
  v^.V[2] := Z;
1587
  Inc(FCount);
1588
  Inc(FRevision);
1589
end;
1590

1591
// Add (2 ints in array + 1)
1592
//
1593
function TAffineVectorList.Add(const xy: PIntegerArray; const Z: Integer): Integer;
1594
var
1595
  v: PAffineVector;
1596
begin
1597
  Result := FCount;
1598
  if Result = FCapacity then
1599
    SetCapacity(FCapacity + FGrowthDelta);
1600
  v := @List[Result];
1601
  v^.V[0] := xy^[0];
1602
  v^.V[1] := xy^[1];
1603
  v^.V[2] := Z;
1604
  Inc(FCount);
1605
  Inc(FRevision);
1606
end;
1607

1608
// AddNC (2 ints in array + 1, no capacity check)
1609
//
1610
function TAffineVectorList.AddNC(const xy: PIntegerArray; const Z: Integer): Integer;
1611
var
1612
  v: PAffineVector;
1613
begin
1614
  Result := FCount;
1615
  v := @List[Result];
1616
  v^.V[0] := xy^[0];
1617
  v^.V[1] := xy^[1];
1618
  v^.V[2] := Z;
1619
  Inc(FCount);
1620
  Inc(FRevision);
1621
end;
1622

1623
// Add
1624
//
1625
procedure TAffineVectorList.Add(const list: TAffineVectorList);
1626
begin
1627
  if Assigned(list) and (list.Count > 0) then
1628
  begin
1629
    if Count + list.Count > Capacity then
1630
      Capacity := Count + list.Count;
1631
    System.Move(list.FList[0], FList[Count], list.Count * SizeOf(TAffineVector));
1632
    Inc(FCount, list.Count);
1633
  end;
1634
  Inc(FRevision);
1635
end;
1636

1637
// Get
1638
//
1639
function TAffineVectorList.Get(Index: Integer): TAffineVector;
1640
begin
1641
{$IFOPT R+}
1642
    Assert(Cardinal(Index) < Cardinal(FCount));
1643
{$ENDIF}
1644
  Result := FList^[Index];
1645
end;
1646

1647
// Insert
1648
//
1649
procedure TAffineVectorList.Insert(Index: Integer; const Item: TAffineVector);
1650
begin
1651
{$IFOPT R+}
1652
    Assert(Cardinal(Index) < Cardinal(FCount));
1653
{$ENDIF}
1654
  if FCount = FCapacity then
1655
    SetCapacity(FCapacity + FGrowthDelta);
1656
  if Index < FCount then
1657
    System.Move(FList[Index], FList[Index + 1],
1658
      (FCount - Index) * SizeOf(TAffineVector));
1659
  FList^[Index] := Item;
1660
  Inc(FCount);
1661
  Inc(FRevision);
1662
end;
1663

1664
// IndexOf
1665
//
1666
function TAffineVectorList.IndexOf(const item: TAffineVector): Integer;
1667
var
1668
  I: Integer;
1669
begin
1670
  Result := -1;
1671
  for I := 0 to Count - 1 do
1672
    if VectorEquals(item, FList^[I]) then
1673
    begin
1674
      Result := I;
1675
      Break;
1676
    end;
1677
end;
1678

1679
// FindOrAdd
1680
//
1681
function TAffineVectorList.FindOrAdd(const item: TAffineVector): Integer;
1682
begin
1683
  Result := IndexOf(item);
1684
  if Result < 0 then
1685
  begin
1686
    Result := Add(item);
1687
    Inc(FRevision);
1688
  end;
1689
end;
1690

1691
// Put
1692
//
1693
procedure TAffineVectorList.Put(Index: Integer; const Item: TAffineVector);
1694
begin
1695
{$IFOPT R+}
1696
    Assert(Cardinal(Index) < Cardinal(FCount));
1697
{$ENDIF}
1698
  FList^[Index] := Item;
1699
  Inc(FRevision);
1700
end;
1701

1702
// SetCapacity
1703
//
1704
procedure TAffineVectorList.SetCapacity(NewCapacity: Integer);
1705
begin
1706
  inherited;
1707
  FList := PAffineVectorArray(FBaseList);
1708
end;
1709

1710
// Push
1711
//
1712
procedure TAffineVectorList.Push(const Val: TAffineVector);
1713
begin
1714
  Add(Val);
1715
end;
1716

1717
// Pop
1718
//
1719
function TAffineVectorList.Pop: TAffineVector;
1720
begin
1721
  if FCount > 0 then
1722
  begin
1723
    Result := Get(FCount - 1);
1724
    Delete(FCount - 1);
1725
    Inc(FRevision);
1726
  end
1727
  else
1728
    Result := NullVector;
1729
end;
1730

1731
// Translate (delta)
1732
//
1733
procedure TAffineVectorList.Translate(const delta: TAffineVector);
1734
begin
1735
  VectorArrayAdd(FList, delta, Count, FList);
1736
  Inc(FRevision);
1737
end;
1738

1739
// Translate (delta, range)
1740
//
1741
procedure TAffineVectorList.Translate(const delta: TAffineVector; base, nb: Integer);
1742
begin
1743
  VectorArrayAdd(@FList[base], delta, nb, @FList[base]);
1744
  Inc(FRevision);
1745
end;
1746

1747
// TranslateItem
1748
//
1749

1750
procedure TAffineVectorList.TranslateItem(Index: Integer; const delta: TAffineVector);
1751
begin
1752
{$IFOPT R+}
1753
    Assert(Cardinal(Index) < Cardinal(FCount));
1754
{$ENDIF}
1755
  AddVector(FList^[Index], delta);
1756
  Inc(FRevision);
1757
end;
1758

1759
// TranslateItems
1760
//
1761
procedure TAffineVectorList.TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
1762
begin
1763
  nb := Index + nb;
1764
{$IFOPT R+}
1765
    Assert(Cardinal(index) < Cardinal(FCount));
1766
    if nb > FCount then
1767
        nb := FCount;
1768
{$ENDIF}
1769
  VectorArrayAdd(@FList[Index], delta, nb - Index, @FList[Index]);
1770
  Inc(FRevision);
1771
end;
1772

1773
// CombineItem
1774
//
1775
procedure TAffineVectorList.CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
1776
begin
1777
{$IFOPT R+}
1778
    Assert(Cardinal(Index) < Cardinal(FCount));
1779
{$ENDIF}
1780
  CombineVector(FList^[Index], vector, @f);
1781
  Inc(FRevision);
1782
end;
1783

1784
// TransformAsPoints
1785
//
1786
procedure TAffineVectorList.TransformAsPoints(const matrix: TMatrix);
1787
var
1788
  I: Integer;
1789
begin
1790
  for I := 0 to FCount - 1 do
1791
    FList^[I] := VectorTransform(FList^[I], matrix);
1792
  Inc(FRevision);
1793
end;
1794

1795
// TransformAsVectors (hmg)
1796
//
1797
procedure TAffineVectorList.TransformAsVectors(const matrix: TMatrix);
1798
var
1799
  m: TAffineMatrix;
1800
begin
1801
  if FCount > 0 then
1802
  begin
1803
    SetMatrix(m, matrix);
1804
    TransformAsVectors(m);
1805
  end;
1806
end;
1807

1808
// TransformAsVectors (affine)
1809
//
1810

1811
procedure TAffineVectorList.TransformAsVectors(const matrix: TAffineMatrix);
1812
var
1813
  I: Integer;
1814
begin
1815
  for I := 0 to FCount - 1 do
1816
    FList^[I] := VectorTransform(FList^[I], matrix);
1817
  Inc(FRevision);
1818
end;
1819

1820
// Normalize
1821
//
1822
procedure TAffineVectorList.Normalize;
1823
begin
1824
  NormalizeVectorArray(List, Count);
1825
  Inc(FRevision);
1826
end;
1827

1828
// Lerp
1829
//
1830
procedure TAffineVectorList.Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
1831
begin
1832
  if (list1 is TAffineVectorList) and (list2 is TAffineVectorList) then
1833
  begin
1834
    Assert(list1.Count = list2.Count);
1835
    Capacity := list1.Count;
1836
    FCount := list1.Count;
1837
    VectorArrayLerp(TAffineVectorList(list1).List, TAffineVectorList(list2).List,
1838
      lerpFactor, FCount, List);
1839
    Inc(FRevision);
1840
  end;
1841
end;
1842

1843
// Scale (scalar)
1844
//
1845
procedure TAffineVectorList.Scale(factor: Single);
1846
begin
1847
  if (Count > 0) and (factor <> 1) then
1848
  begin
1849
    ScaleFloatArray(@FList[0].V[0], Count * 3, factor);
1850
    Inc(FRevision);
1851
  end;
1852
end;
1853

1854
// Scale (affine)
1855
//
1856
procedure TAffineVectorList.Scale(const factors: TAffineVector);
1857
var
1858
  I: Integer;
1859
begin
1860
  for I := 0 to Count - 1 do
1861
    ScaleVector(FList^[I], factors);
1862
  Inc(FRevision);
1863
end;
1864

1865
// ------------------
1866
// ------------------ TVectorList ------------------
1867
// ------------------
1868

1869
// Create
1870
//
1871

1872
constructor TVectorList.Create;
1873
begin
1874
  FItemSize := SizeOf(TVector);
1875
  inherited Create;
1876
  FGrowthDelta := cDefaultListGrowthDelta;
1877
end;
1878

1879
 
1880
//
1881

1882
procedure TVectorList.Assign(Src: TPersistent);
1883
begin
1884
  if Assigned(Src) then
1885
  begin
1886
    inherited;
1887
    if (Src is TVectorList) then
1888
      System.Move(TVectorList(Src).FList^, FList^, FCount * SizeOf(TVector));
1889
  end
1890
  else
1891
    Clear;
1892
end;
1893

1894
// Add
1895
//
1896

1897
function TVectorList.Add(const item: TVector): Integer;
1898
begin
1899
  Result := FCount;
1900
  if Result = FCapacity then
1901
    SetCapacity(FCapacity + FGrowthDelta);
1902
  FList^[Result] := Item;
1903
  Inc(FCount);
1904
end;
1905

1906
// Add
1907
//
1908

1909
function TVectorList.Add(const item: TAffineVector; w: Single): Integer;
1910
begin
1911
  Result := Add(VectorMake(item, w));
1912
end;
1913

1914
// Add
1915
//
1916

1917
function TVectorList.Add(const X, Y, Z, w: Single): Integer;
1918
begin
1919
  Result := Add(VectorMake(X, Y, Z, w));
1920
end;
1921

1922
// Add (3 affine)
1923
//
1924

1925
procedure TVectorList.Add(const i1, i2, i3: TAffineVector; w: Single);
1926
begin
1927
  Inc(FCount, 3);
1928
  while FCount > FCapacity do
1929
    SetCapacity(FCapacity + FGrowthDelta);
1930
  PAffineVector(@FList[FCount - 3])^ := i1;
1931
  FList^[FCount - 3].V[3] := w;
1932
  PAffineVector(@FList[FCount - 2])^ := i2;
1933
  FList^[FCount - 2].V[3] := w;
1934
  PAffineVector(@FList[FCount - 1])^ := i3;
1935
  FList^[FCount - 1].V[3] := w;
1936
end;
1937

1938
// AddVector
1939
//
1940

1941
function TVectorList.AddVector(const item: TAffineVector): Integer;
1942
begin
1943
  Result := Add(VectorMake(item));
1944
end;
1945

1946
// AddPoint
1947
//
1948

1949
function TVectorList.AddPoint(const item: TAffineVector): Integer;
1950
begin
1951
  Result := Add(PointMake(item));
1952
end;
1953

1954
// AddPoint
1955
//
1956

1957
function TVectorList.AddPoint(const X, Y: Single; const Z: Single = 0): Integer;
1958
begin
1959
  Result := Add(PointMake(X, Y, Z));
1960
end;
1961

1962
// Get
1963
//
1964

1965
function TVectorList.Get(Index: Integer): TVector;
1966
begin
1967
{$IFOPT R+}
1968
    Assert(Cardinal(Index) < Cardinal(FCount));
1969
{$ENDIF}
1970
  Result := FList^[Index];
1971
end;
1972

1973
// Insert
1974
//
1975

1976
procedure TVectorList.Insert(Index: Integer; const Item: TVector);
1977
begin
1978
{$IFOPT R+}
1979
    Assert(Cardinal(Index) < Cardinal(FCount));
1980
{$ENDIF}
1981
  if FCount = FCapacity then
1982
    SetCapacity(FCapacity + FGrowthDelta);
1983
  if Index < FCount then
1984
    System.Move(FList[Index], FList[Index + 1],
1985
      (FCount - Index) * SizeOf(TVector));
1986
  FList^[Index] := Item;
1987
  Inc(FCount);
1988
end;
1989

1990
// Put
1991
//
1992

1993
procedure TVectorList.Put(Index: Integer; const Item: TVector);
1994
begin
1995
{$IFOPT R+}
1996
    Assert(Cardinal(Index) < Cardinal(FCount));
1997
{$ENDIF}
1998
  FList^[Index] := Item;
1999
end;
2000

2001
// SetCapacity
2002
//
2003

2004
procedure TVectorList.SetCapacity(NewCapacity: Integer);
2005
begin
2006
  inherited;
2007
  FList := PVectorArray(FBaseList);
2008
end;
2009

2010
// Push
2011
//
2012

2013
procedure TVectorList.Push(const Val: TVector);
2014
begin
2015
  Add(Val);
2016
end;
2017

2018
// Pop
2019
//
2020

2021
function TVectorList.Pop: TVector;
2022
begin
2023
  if FCount > 0 then
2024
  begin
2025
    Result := Get(FCount - 1);
2026
    Delete(FCount - 1);
2027
  end
2028
  else
2029
    Result := NullHmgVector;
2030
end;
2031

2032
// IndexOf
2033
//
2034

2035
function TVectorList.IndexOf(const item: TVector): Integer;
2036
var
2037
  I: Integer;
2038
begin
2039
  Result := -1;
2040
  for I := 0 to Count - 1 do
2041
    if VectorEquals(item, FList^[I]) then
2042
    begin
2043
      Result := I;
2044
      Break;
2045
    end;
2046
end;
2047

2048
// FindOrAdd
2049
//
2050

2051
function TVectorList.FindOrAdd(const item: TVector): Integer;
2052
begin
2053
  Result := IndexOf(item);
2054
  if Result < 0 then
2055
    Result := Add(item);
2056
end;
2057

2058
// FindOrAddPoint
2059
//
2060

2061
function TVectorList.FindOrAddPoint(const item: TAffineVector): Integer;
2062
var
2063
  ptItem: TVector;
2064
begin
2065
  MakePoint(ptItem, item);
2066
  Result := IndexOf(ptItem);
2067
  if Result < 0 then
2068
    Result := Add(ptItem);
2069
end;
2070

2071
// Lerp
2072
//
2073

2074
procedure TVectorList.Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
2075
begin
2076
  if (list1 is TVectorList) and (list2 is TVectorList) then
2077
  begin
2078
    Assert(list1.Count = list2.Count);
2079
    Capacity := list1.Count;
2080
    FCount := list1.Count;
2081
    VectorArrayLerp(TVectorList(list1).List, TVectorList(list2).List,
2082
      lerpFactor, FCount, List);
2083
  end;
2084
end;
2085

2086
// ------------------
2087
// ------------------ TTexPointList ------------------
2088
// ------------------
2089

2090
// Create
2091
//
2092

2093
constructor TTexPointList.Create;
2094
begin
2095
  FItemSize := SizeOf(TTexPoint);
2096
  inherited Create;
2097
  FGrowthDelta := cDefaultListGrowthDelta;
2098
end;
2099

2100
 
2101
//
2102

2103
procedure TTexPointList.Assign(Src: TPersistent);
2104
begin
2105
  if Assigned(Src) then
2106
  begin
2107
    inherited;
2108
    if (Src is TTexPointList) then
2109
      System.Move(TTexPointList(Src).FList^, FList^, FCount * SizeOf(TTexPoint));
2110
  end
2111
  else
2112
    Clear;
2113
end;
2114

2115
// IndexOf
2116
//
2117

2118
function TTexPointList.IndexOf(const item: TTexpoint): Integer;
2119
var
2120
  I: Integer;
2121
begin
2122
  Result := -1;
2123
  for I := 0 to Count - 1 do
2124
    if TexpointEquals(FList^[I], item) then
2125
    begin
2126
      Result := I;
2127
      Break;
2128
    end;
2129
end;
2130

2131
// FindOrAdd
2132
//
2133

2134
function TTexPointList.FindOrAdd(const item: TTexPoint): Integer;
2135
begin
2136
  Result := IndexOf(item);
2137
  if Result < 0 then
2138
    Result := Add(item);
2139
end;
2140

2141
// Add
2142
//
2143

2144
function TTexPointList.Add(const item: TTexPoint): Integer;
2145
begin
2146
  Result := FCount;
2147
  if Result = FCapacity then
2148
    SetCapacity(FCapacity + FGrowthDelta);
2149
  FList^[Result] := Item;
2150
  Inc(FCount);
2151
end;
2152

2153
// Add
2154
//
2155

2156
function TTexPointList.Add(const item: TVector2f): Integer;
2157
begin
2158
  Result := FCount;
2159
  if Result = FCapacity then
2160
    SetCapacity(FCapacity + FGrowthDelta);
2161
  FList^[Result] := PTexPoint(@Item)^;
2162
  Inc(FCount);
2163
end;
2164

2165
// Add
2166
//
2167

2168
function TTexPointList.Add(const texS, Text: Single): Integer;
2169
begin
2170
  Result := FCount;
2171
  if Result = FCapacity then
2172
    SetCapacity(FCapacity + FGrowthDelta);
2173
  with FList^[Result] do
2174
  begin
2175
    s := texS;
2176
    t := Text;
2177
  end;
2178
  Inc(FCount);
2179
end;
2180

2181
// Add
2182
//
2183

2184
function TTexPointList.Add(const texS, Text: Integer): Integer;
2185
begin
2186
  Result := FCount;
2187
  if Result = FCapacity then
2188
    SetCapacity(FCapacity + FGrowthDelta);
2189
  with FList^[Result] do
2190
  begin
2191
    s := texS;
2192
    t := Text;
2193
  end;
2194
  Inc(FCount);
2195
end;
2196

2197
// AddNC
2198
//
2199

2200
function TTexPointList.AddNC(const texS, Text: Integer): Integer;
2201
begin
2202
  Result := FCount;
2203
  with FList^[Result] do
2204
  begin
2205
    s := texS;
2206
    t := Text;
2207
  end;
2208
  Inc(FCount);
2209
end;
2210

2211
// Add
2212
//
2213

2214
function TTexPointList.Add(const texST: PIntegerArray): Integer;
2215
begin
2216
  Result := FCount;
2217
  if Result = FCapacity then
2218
    SetCapacity(FCapacity + FGrowthDelta);
2219
  with FList^[Result] do
2220
  begin
2221
    s := texST^[0];
2222
    t := texST^[1];
2223
  end;
2224
  Inc(FCount);
2225
end;
2226

2227
// AddNC
2228
//
2229

2230
function TTexPointList.AddNC(const texST: PIntegerArray): Integer;
2231
begin
2232
  Result := FCount;
2233
  with FList^[Result] do
2234
  begin
2235
    s := texST^[0];
2236
    t := texST^[1];
2237
  end;
2238
  Inc(FCount);
2239
end;
2240

2241
// Get
2242
//
2243

2244
function TTexPointList.Get(Index: Integer): TTexPoint;
2245
begin
2246
{$IFOPT R+}
2247
    Assert(Cardinal(Index) < Cardinal(FCount));
2248
{$ENDIF}
2249
  Result := FList^[Index];
2250
end;
2251

2252
// Insert
2253
//
2254

2255
procedure TTexPointList.Insert(Index: Integer; const Item: TTexPoint);
2256
begin
2257
{$IFOPT R+}
2258
    Assert(Cardinal(Index) < Cardinal(FCount));
2259
{$ENDIF}
2260
  if FCount = FCapacity then
2261
    SetCapacity(FCapacity + FGrowthDelta);
2262
  if Index < FCount then
2263
    System.Move(FList[Index], FList[Index + 1],
2264
      (FCount - Index) * SizeOf(TTexPoint));
2265
  FList^[Index] := Item;
2266
  Inc(FCount);
2267
end;
2268

2269
// Put
2270
//
2271

2272
procedure TTexPointList.Put(Index: Integer; const Item: TTexPoint);
2273
begin
2274
{$IFOPT R+}
2275
    Assert(Cardinal(Index) < Cardinal(FCount));
2276
{$ENDIF}
2277
  FList^[Index] := Item;
2278
end;
2279

2280
// SetCapacity
2281
//
2282

2283
procedure TTexPointList.SetCapacity(NewCapacity: Integer);
2284
begin
2285
  inherited;
2286
  FList := PTexPointArray(FBaseList);
2287
end;
2288

2289
// Push
2290
//
2291

2292
procedure TTexPointList.Push(const Val: TTexPoint);
2293
begin
2294
  Add(Val);
2295
end;
2296

2297
// Pop
2298
//
2299

2300
function TTexPointList.Pop: TTexPoint;
2301
begin
2302
  if FCount > 0 then
2303
  begin
2304
    Result := Get(FCount - 1);
2305
    Delete(FCount - 1);
2306
  end
2307
  else
2308
    Result := NullTexPoint;
2309
end;
2310

2311
// Translate
2312
//
2313

2314
procedure TTexPointList.Translate(const delta: TTexPoint);
2315
begin
2316
  TexPointArrayAdd(List, delta, FCount, FList);
2317
end;
2318

2319
// ScaleAndTranslate
2320
//
2321

2322
procedure TTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint);
2323
begin
2324
  TexPointArrayScaleAndAdd(FList, delta, FCount, scale, FList);
2325
end;
2326

2327
// ScaleAndTranslate
2328
//
2329

2330
procedure TTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer);
2331
var
2332
  p: PTexPointArray;
2333
begin
2334
  p := @FList[base];
2335
  TexPointArrayScaleAndAdd(p, delta, nb, scale, p);
2336
end;
2337

2338
// Lerp
2339
//
2340

2341
procedure TTexPointList.Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
2342
begin
2343
  if (list1 is TTexPointList) and (list2 is TTexPointList) then
2344
  begin
2345
    Assert(list1.Count = list2.Count);
2346
    Capacity := list1.Count;
2347
    FCount := list1.Count;
2348
    VectorArrayLerp(TTexPointList(list1).List, TTexPointList(list2).List,
2349
      lerpFactor, FCount, List);
2350
  end;
2351
end;
2352

2353
// ------------------
2354
// ------------------ TIntegerList ------------------
2355
// ------------------
2356

2357
// Create
2358
//
2359

2360
constructor TIntegerList.Create;
2361
begin
2362
  FItemSize := SizeOf(Integer);
2363
  inherited Create;
2364
  FGrowthDelta := cDefaultListGrowthDelta;
2365
end;
2366

2367
 
2368
//
2369

2370
procedure TIntegerList.Assign(Src: TPersistent);
2371
begin
2372
  if Assigned(Src) then
2373
  begin
2374
    inherited;
2375
    if (Src is TIntegerList) then
2376
      System.Move(TIntegerList(Src).FList^, FList^, FCount * SizeOf(Integer));
2377
  end
2378
  else
2379
    Clear;
2380
end;
2381

2382
// Add (simple)
2383
//
2384

2385
function TIntegerList.Add(const item: Integer): Integer;
2386
begin
2387
  Result := FCount;
2388
  if Result = FCapacity then
2389
    SetCapacity(FCapacity + FGrowthDelta);
2390
  FList^[Result] := Item;
2391
  Inc(FCount);
2392
end;
2393

2394
// AddNC (simple, no capacity check)
2395
//
2396

2397
function TIntegerList.AddNC(const item: Integer): Integer;
2398
begin
2399
  Result := FCount;
2400
  FList^[Result] := Item;
2401
  Inc(FCount);
2402
end;
2403

2404
// Add (two at once)
2405
//
2406

2407
procedure TIntegerList.Add(const i1, i2: Integer);
2408
var
2409
  tmpList : PIntegerArray;
2410
begin
2411
  Inc(FCount, 2);
2412
  while FCount > FCapacity do
2413
    SetCapacity(FCapacity + FGrowthDelta);
2414
  tmpList := @FList[FCount - 2];
2415
  tmpList^[0] := i1;
2416
  tmpList^[1] := i2;
2417
end;
2418

2419
// Add (three at once)
2420
//
2421

2422
procedure TIntegerList.Add(const i1, i2, i3: Integer);
2423
var
2424
  tmpList : PIntegerArray;
2425
begin
2426
  Inc(FCount, 3);
2427
  while FCount > FCapacity do
2428
    SetCapacity(FCapacity + FGrowthDelta);
2429
  tmpList := @FList[FCount - 3];
2430
  tmpList^[0] := i1;
2431
  tmpList^[1] := i2;
2432
  tmpList^[2] := i3;
2433
end;
2434

2435
// Add (list)
2436
//
2437

2438
procedure TIntegerList.Add(const AList: TIntegerList);
2439
begin
2440
  if Assigned(AList) and (AList.Count > 0) then
2441
  begin
2442
    if Count + AList.Count > Capacity then
2443
      Capacity := Count + AList.Count;
2444
    System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(Integer));
2445
    Inc(FCount, AList.Count);
2446
  end;
2447
end;
2448

2449
// Get
2450
//
2451

2452
function TIntegerList.Get(Index: Integer): Integer;
2453
begin
2454
{$IFOPT R+}
2455
    Assert(Cardinal(Index) < Cardinal(FCount));
2456
{$ENDIF}
2457
  Result := FList^[Index];
2458
end;
2459

2460
// Insert
2461
//
2462

2463
procedure TIntegerList.Insert(Index: Integer; const Item: Integer);
2464
begin
2465
{$IFOPT R+}
2466
    Assert(Cardinal(Index) < Cardinal(FCount));
2467
{$ENDIF}
2468
  if FCount = FCapacity then
2469
    SetCapacity(FCapacity + FGrowthDelta);
2470
  if Index < FCount then
2471
    System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(Integer));
2472
  FList^[Index] := Item;
2473
  Inc(FCount);
2474
end;
2475

2476
// Remove
2477
//
2478

2479
procedure TIntegerList.Remove(const item: Integer);
2480
var
2481
  I: Integer;
2482
begin
2483
  for I := 0 to Count - 1 do
2484
  begin
2485
    if FList^[I] = item then
2486
    begin
2487
      System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(Integer));
2488
      Dec(FCount);
2489
      Break;
2490
    end;
2491
  end;
2492
end;
2493

2494
// Put
2495
//
2496

2497
procedure TIntegerList.Put(Index: Integer; const Item: Integer);
2498
begin
2499
{$IFOPT R+}
2500
    Assert(Cardinal(Index) < Cardinal(FCount));
2501
{$ENDIF}
2502
  FList^[Index] := Item;
2503
end;
2504

2505
// SetCapacity
2506
//
2507

2508
procedure TIntegerList.SetCapacity(NewCapacity: Integer);
2509
begin
2510
  inherited;
2511
  FList := PIntegerArray(FBaseList);
2512
end;
2513

2514
// Push
2515
//
2516

2517
procedure TIntegerList.Push(const Val: Integer);
2518
begin
2519
  Add(Val);
2520
end;
2521

2522
// Pop
2523
//
2524

2525
function TIntegerList.Pop: Integer;
2526
begin
2527
  if FCount > 0 then
2528
  begin
2529
    Result := FList^[FCount - 1];
2530
    Delete(FCount - 1);
2531
  end
2532
  else
2533
    Result := 0;
2534
end;
2535

2536
// AddSerie
2537
//
2538

2539
procedure TIntegerList.AddSerie(aBase, aDelta, aCount: Integer);
2540
var
2541
  tmpList : PInteger;
2542
  I:    Integer;
2543
begin
2544
  if aCount <= 0 then
2545
    Exit;
2546
  AdjustCapacityToAtLeast(Count + aCount);
2547
  tmpList := @FList[Count];
2548
  for I := Count to Count + aCount - 1 do
2549
  begin
2550
    tmpList^ := aBase;
2551
    Inc(tmpList);
2552
    aBase := aBase + aDelta;
2553
  end;
2554
  FCount := Count + aCount;
2555
end;
2556

2557
// AddIntegers (pointer & n)
2558
//
2559

2560
procedure TIntegerList.AddIntegers(const First: PInteger; n: Integer);
2561
begin
2562
  if n < 1 then
2563
    Exit;
2564
  AdjustCapacityToAtLeast(Count + n);
2565
  System.Move(First^, FList[FCount], n * SizeOf(Integer));
2566
  FCount := FCount + n;
2567
end;
2568

2569
// AddIntegers (TIntegerList)
2570
//
2571

2572
procedure TIntegerList.AddIntegers(const aList: TIntegerList);
2573
begin
2574
  if not Assigned(aList) then
2575
    Exit;
2576
  AddIntegers(@aList.List[0], aList.Count);
2577
end;
2578

2579
// AddIntegers (array)
2580
//
2581

2582
procedure TIntegerList.AddIntegers(const anArray: array of Integer);
2583
var
2584
  n: Integer;
2585
begin
2586
  n := Length(anArray);
2587
  if n > 0 then
2588
    AddIntegers(@anArray[0], n);
2589
end;
2590

2591
// IntegerSearch
2592
//
2593

2594
function IntegerSearch(item: Integer; list: PIntegerVector; Count: Integer): Integer; register;
2595
{$IFDEF GLS_NO_ASM}
2596
var i : integer;
2597
begin
2598
  result:=-1;
2599
  for i := 0 to Count-1 do begin
2600
    if list^[i]=item then begin
2601
      result:=i;
2602
      break;
2603
    end;
2604
  end;
2605
end;
2606
{$ELSE}
2607
asm
2608
  push edi;
2609

2610
  test ecx, ecx
2611
  jz @@NotFound
2612

2613
  mov edi, edx;
2614
  mov edx, ecx;
2615
  repne scasd;
2616
  je @@FoundIt
2617

2618
  @@NotFound:
2619
  xor eax, eax
2620
  dec eax
2621
  jmp @@end;
2622

2623
  @@FoundIt:
2624
  sub edx, ecx;
2625
  dec edx;
2626
  mov eax, edx;
2627

2628
  @@end:
2629
  pop edi;
2630
end;
2631
{$ENDIF}
2632

2633
// IndexOf
2634
//
2635

2636
function TIntegerList.IndexOf(item: Integer): Integer; register;
2637
begin
2638
  Result := IntegerSearch(item, FList, FCount);
2639
end;
2640

2641
// MinInteger
2642
//
2643

2644
function TIntegerList.MinInteger: Integer;
2645
var
2646
  I: Integer;
2647
  locList: PIntegerVector;
2648
begin
2649
  if FCount > 0 then
2650
  begin
2651
    locList := FList;
2652
    Result := locList^[0];
2653
    for I := 1 to FCount - 1 do
2654
      if locList^[I] < Result then
2655
        Result := locList^[I];
2656
  end
2657
  else
2658
    Result := 0;
2659
end;
2660

2661
// MaxInteger
2662
//
2663

2664
function TIntegerList.MaxInteger: Integer;
2665
var
2666
  I: Integer;
2667
  locList: PIntegerVector;
2668
begin
2669
  if FCount > 0 then
2670
  begin
2671
    locList := FList;
2672
    Result := locList^[0];
2673
    for I := 1 to FCount - 1 do
2674
      if locList^[I] > Result then
2675
        Result := locList^[I];
2676
  end
2677
  else
2678
    Result := 0;
2679
end;
2680

2681
// IntegerQuickSort
2682
//
2683

2684
procedure IntegerQuickSort(sortList: PIntegerArray; left, right: Integer);
2685
var
2686
  I, J: Integer;
2687
  p, t: Integer;
2688
begin
2689
  repeat
2690
    I := left;
2691
    J := right;
2692
    p := sortList^[(left + right) shr 1];
2693
    repeat
2694
      while sortList^[I] < p do
2695
        Inc(I);
2696
      while sortList^[J] > p do
2697
        Dec(J);
2698
      if I <= J then
2699
      begin
2700
        t := sortList^[I];
2701
        sortList^[I] := sortList^[J];
2702
        sortList^[J] := t;
2703
        Inc(I);
2704
        Dec(J);
2705
      end;
2706
    until I > J;
2707
    if left < J then
2708
      IntegerQuickSort(sortList, left, J);
2709
    left := I;
2710
  until I >= right;
2711
end;
2712

2713
// Sort
2714
//
2715

2716
procedure TIntegerList.Sort;
2717
begin
2718
  if (FList <> nil) and (Count > 1) then
2719
    IntegerQuickSort(FList, 0, Count - 1);
2720
end;
2721

2722
// SortAndRemoveDuplicates
2723
//
2724

2725
procedure TIntegerList.SortAndRemoveDuplicates;
2726
var
2727
  I, J, lastVal: Integer;
2728
  localList:     PIntegerArray;
2729
begin
2730
  if (FList <> nil) and (Count > 1) then
2731
  begin
2732
    IntegerQuickSort(FList, 0, Count - 1);
2733
    J := 0;
2734
    localList := FList;
2735
    lastVal := localList^[J];
2736
    for I := 1 to Count - 1 do
2737
    begin
2738
      if localList^[I] <> lastVal then
2739
      begin
2740
        lastVal := localList^[I];
2741
        Inc(J);
2742
        localList^[J] := lastVal;
2743
      end;
2744
    end;
2745
    FCount := J + 1;
2746
  end;
2747
end;
2748

2749
// BinarySearch
2750
//
2751

2752
function TIntegerList.BinarySearch(const Value: Integer): Integer;
2753
var
2754
  found: Boolean;
2755
begin
2756
  Result := BinarySearch(Value, False, found);
2757
end;
2758

2759
// BinarySearch
2760
//
2761

2762
function TIntegerList.BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer;
2763
var
2764
  Index:   Integer;
2765
  min, max, mid: Integer;
2766
  intList: PIntegerArray;
2767
begin
2768
  // Assume we won't find it
2769
  found := False;
2770
  // If the list is empty, we won't find the sought value!
2771
  if Count = 0 then
2772
  begin
2773
    Result := -1;
2774
    Exit;
2775
  end;
2776

2777
  min := -1; // ONE OFF!
2778
  max := Count; // ONE OFF!
2779

2780
  // We now know that Min and Max AREN'T the values!
2781
  Index := -1;
2782
  intList := List;
2783
  repeat
2784
    // Find the middle of the current scope
2785
    mid := (min + max) shr 1;
2786
    // Reduce the search scope by half
2787
    if intList^[mid] <= Value then
2788
    begin
2789
      // Is this the one?
2790
      if intList^[mid] = Value then
2791
      begin
2792
        Index := mid;
2793
        found := True;
2794
        Break;
2795
      end
2796
      else
2797
        min := mid;
2798
    end
2799
    else
2800
      max := mid;
2801
  until min + 1 = max;
2802

2803
  if returnBestFit then
2804
  begin
2805
    if Index >= 0 then
2806
      Result := Index
2807
    else
2808
      Result := min;
2809
  end
2810
  else
2811
    Result := Index;
2812
end;
2813

2814
// AddSorted
2815
//
2816

2817
function TIntegerList.AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
2818
var
2819
  Index: Integer;
2820
  found: Boolean;
2821
begin
2822
  Index := BinarySearch(Value, True, found);
2823
  if ignoreDuplicates and Found then
2824
    Result := -1
2825
  else
2826
  begin
2827
    Insert(Index + 1, Value);
2828
    Result := Index + 1;
2829
  end;
2830
end;
2831

2832
// RemoveSorted
2833
//
2834

2835
procedure TIntegerList.RemoveSorted(const Value: Integer);
2836
var
2837
  Index: Integer;
2838
begin
2839
  Index := BinarySearch(Value);
2840
  if Index >= 0 then
2841
    Delete(Index);
2842
end;
2843

2844
// Offset (all)
2845
//
2846

2847
procedure TIntegerList.Offset(delta: Integer);
2848
var
2849
  I: Integer;
2850
  locList: PIntegerArray;
2851
begin
2852
  locList := FList;
2853
  for I := 0 to FCount - 1 do
2854
    locList^[I] := locList^[I] + delta;
2855
end;
2856

2857
// Offset (range)
2858
//
2859

2860
procedure TIntegerList.Offset(delta: Integer; const base, nb: Integer);
2861
var
2862
  I: Integer;
2863
  locList: PIntegerArray;
2864
begin
2865
  locList := FList;
2866
  for I := base to base + nb - 1 do
2867
    locList^[I] := locList^[I] + delta;
2868
end;
2869

2870
// ------------------
2871
// ------------------ TSingleList ------------------
2872
// ------------------
2873

2874
// Create
2875
//
2876

2877
constructor TSingleList.Create;
2878
begin
2879
  FItemSize := SizeOf(Single);
2880
  inherited Create;
2881
  FGrowthDelta := cDefaultListGrowthDelta;
2882
end;
2883

2884
 
2885
//
2886

2887
procedure TSingleList.Assign(Src: TPersistent);
2888
begin
2889
  if Assigned(Src) then
2890
  begin
2891
    inherited;
2892
    if (Src is TSingleList) then
2893
      System.Move(TSingleList(Src).FList^, FList^, FCount * SizeOf(Single));
2894
  end
2895
  else
2896
    Clear;
2897
end;
2898

2899
// Add
2900
//
2901

2902
function TSingleList.Add(const item: Single): Integer;
2903
begin
2904
  Result := FCount;
2905
  if Result = FCapacity then
2906
    SetCapacity(FCapacity + FGrowthDelta);
2907
  FList^[Result] := Item;
2908
  Inc(FCount);
2909
end;
2910

2911
procedure TSingleList.Add(const i1, i2: Single);
2912
var
2913
  tmpList : PSingleArray;
2914
begin
2915
  Inc(FCount, 2);
2916
  while FCount > FCapacity do
2917
    SetCapacity(FCapacity + FGrowthDelta);
2918
  tmpList := @FList[FCount - 2];
2919
  tmpList^[0] := i1;
2920
  tmpList^[1] := i2;
2921
end;
2922

2923
procedure TSingleList.AddSingles(const First: PSingle; n: Integer);
2924
begin
2925
  if n < 1 then
2926
    Exit;
2927
  AdjustCapacityToAtLeast(Count + n);
2928
  System.Move(First^, FList[FCount], n * SizeOf(Single));
2929
  FCount := FCount + n;
2930
end;
2931

2932
procedure TSingleList.AddSingles(const anArray: array of Single);
2933
var
2934
  n: Integer;
2935
begin
2936
  n := Length(anArray);
2937
  if n > 0 then
2938
    AddSingles(@anArray[0], n);
2939
end;
2940

2941
// Get
2942
//
2943

2944
function TSingleList.Get(Index: Integer): Single;
2945
begin
2946
{$IFOPT R+}
2947
    Assert(Cardinal(Index) < Cardinal(FCount));
2948
{$ENDIF}
2949
  Result := FList^[Index];
2950
end;
2951

2952
// Insert
2953
//
2954

2955
procedure TSingleList.Insert(Index: Integer; const Item: Single);
2956
begin
2957
{$IFOPT R+}
2958
    Assert(Cardinal(Index) < Cardinal(FCount));
2959
{$ENDIF}
2960
  if FCount = FCapacity then
2961
    SetCapacity(FCapacity + FGrowthDelta);
2962
  if Index < FCount then
2963
    System.Move(FList[Index], FList[Index + 1],
2964
      (FCount - Index) * SizeOf(Single));
2965
  FList^[Index] := Item;
2966
  Inc(FCount);
2967
end;
2968

2969
// Put
2970
//
2971

2972
procedure TSingleList.Put(Index: Integer; const Item: Single);
2973
begin
2974
{$IFOPT R+}
2975
    Assert(Cardinal(Index) < Cardinal(FCount));
2976
{$ENDIF}
2977
  FList^[Index] := Item;
2978
end;
2979

2980
// SetCapacity
2981
//
2982

2983
procedure TSingleList.SetCapacity(NewCapacity: Integer);
2984
begin
2985
  inherited;
2986
  FList := PSingleArrayList(FBaseList);
2987
end;
2988

2989
// Push
2990
//
2991

2992
procedure TSingleList.Push(const Val: Single);
2993
begin
2994
  Add(Val);
2995
end;
2996

2997
// Pop
2998
//
2999

3000
function TSingleList.Pop: Single;
3001
begin
3002
  if FCount > 0 then
3003
  begin
3004
    Result := Get(FCount - 1);
3005
    Delete(FCount - 1);
3006
  end
3007
  else
3008
    Result := 0;
3009
end;
3010

3011
// AddSerie
3012
//
3013

3014
procedure TSingleList.AddSerie(aBase, aDelta: Single; aCount: Integer);
3015
var
3016
  tmpList : PSingle;
3017
  I:    Integer;
3018
begin
3019
  if aCount <= 0 then
3020
    Exit;
3021
  AdjustCapacityToAtLeast(Count + aCount);
3022
  tmpList := @FList[Count];
3023
  for I := Count to Count + aCount - 1 do
3024
  begin
3025
    tmpList^ := aBase;
3026
    Inc(tmpList);
3027
    aBase := aBase + aDelta;
3028
  end;
3029
  FCount := Count + aCount;
3030
end;
3031

3032
// Offset (single)
3033
//
3034

3035
procedure TSingleList.Offset(delta: Single);
3036
begin
3037
  OffsetFloatArray(PFloatVector(FList), FCount, delta);
3038
end;
3039

3040
// Offset (list)
3041
//
3042

3043
procedure TSingleList.Offset(const delta: TSingleList);
3044
begin
3045
  if FCount = delta.FCount then
3046
    OffsetFloatArray(PFloatVector(FList), PFloatVector(delta.FList), FCount)
3047
  else
3048
    raise Exception.Create('SingleList count do not match');
3049
end;
3050

3051
// Scale
3052
//
3053

3054
procedure TSingleList.Scale(factor: Single);
3055
begin
3056
  ScaleFloatArray(PFloatVector(FList), FCount, factor);
3057
end;
3058

3059
// Sqr
3060
//
3061

3062
procedure TSingleList.Sqr;
3063
var
3064
  I: Integer;
3065
  locList: PSingleArrayList;
3066
begin
3067
  locList := FList;
3068
  for I := 0 to Count - 1 do
3069
    locList^[I] := locList^[I] * locList^[I];
3070
end;
3071

3072
// Sqrt
3073
//
3074

3075
procedure TSingleList.Sqrt;
3076
var
3077
  I: Integer;
3078
  locList: PSingleArrayList;
3079
begin
3080
  locList := FList;
3081
  for I := 0 to Count - 1 do
3082
    locList^[I] := System.Sqrt(locList^[I]);
3083
end;
3084

3085
// Sum
3086
//
3087

3088
function TSingleList.Sum: Single;
3089
{$IFNDEF GLS_NO_ASM}
3090
  function ComputeSum(list: PSingleArrayList; nb: Integer): Single; register;
3091
  asm
3092
    fld   dword ptr [eax]
3093
    @@Loop:
3094
    dec   edx
3095
    fadd  dword ptr [eax+edx*4]
3096
    jnz   @@Loop
3097
  end;
3098

3099
begin
3100
  if FCount > 0 then
3101
    Result := ComputeSum(FList, FCount)
3102
  else
3103
    Result := 0;
3104
{$ELSE}
3105
var
3106
  i: Integer;
3107
begin
3108
  Result := 0;
3109
  for i := 0 to FCount-1 do
3110
    Result := Result + FList^[i];
3111
{$ENDIF}
3112
end;
3113

3114
// Min
3115
//
3116
function TSingleList.Min: Single;
3117
var
3118
  I: Integer;
3119
  locList: PSingleArrayList;
3120
begin
3121
  if FCount > 0 then
3122
  begin
3123
    locList := FList;
3124
    Result := locList^[0];
3125
    for I := 1 to FCount - 1 do
3126
      if locList^[I] < Result then
3127
        Result := locList^[I];
3128
  end
3129
  else
3130
    Result := 0;
3131
end;
3132

3133
// Max
3134
//
3135
function TSingleList.Max: Single;
3136
var
3137
  I: Integer;
3138
  locList: PSingleArrayList;
3139
begin
3140
  if FCount > 0 then
3141
  begin
3142
    locList := FList;
3143
    Result := locList^[0];
3144
    for I := 1 to FCount - 1 do
3145
      if locList^[I] > Result then
3146
        Result := locList^[I];
3147
  end
3148
  else
3149
    Result := 0;
3150
end;
3151

3152
// ------------------
3153
// ------------------ TByteList ------------------
3154
// ------------------
3155

3156
// Create
3157
//
3158

3159
constructor TByteList.Create;
3160
begin
3161
  FItemSize := SizeOf(Byte);
3162
  inherited Create;
3163
  FGrowthDelta := cDefaultListGrowthDelta;
3164
end;
3165

3166
 
3167
//
3168

3169
procedure TByteList.Assign(Src: TPersistent);
3170
begin
3171
  if Assigned(Src) then
3172
  begin
3173
    inherited;
3174
    if (Src is TByteList) then
3175
      System.Move(TByteList(Src).FList^, FList^, FCount * SizeOf(Byte));
3176
  end
3177
  else
3178
    Clear;
3179
end;
3180

3181
// Add
3182
//
3183

3184
function TByteList.Add(const item: Byte): Integer;
3185
begin
3186
  Result := FCount;
3187
  if Result = FCapacity then
3188
    SetCapacity(FCapacity + FGrowthDelta);
3189
  FList^[Result] := Item;
3190
  Inc(FCount);
3191
end;
3192

3193
// Get
3194
//
3195

3196
function TByteList.Get(Index: Integer): Byte;
3197
begin
3198
{$IFOPT R+}
3199
    Assert(Cardinal(Index) < Cardinal(FCount));
3200
{$ENDIF}
3201
  Result := FList^[Index];
3202
end;
3203

3204
// Insert
3205
//
3206

3207
procedure TByteList.Insert(Index: Integer; const Item: Byte);
3208
begin
3209
{$IFOPT R+}
3210
    Assert(Cardinal(Index) < Cardinal(FCount));
3211
{$ENDIF}
3212
  if FCount = FCapacity then
3213
    SetCapacity(FCapacity + FGrowthDelta);
3214
  if Index < FCount then
3215
    System.Move(FList[Index], FList[Index + 1],
3216
      (FCount - Index) * SizeOf(Byte));
3217
  FList^[Index] := Item;
3218
  Inc(FCount);
3219
end;
3220

3221
// Put
3222
//
3223

3224
procedure TByteList.Put(Index: Integer; const Item: Byte);
3225
begin
3226
{$IFOPT R+}
3227
    Assert(Cardinal(Index) < Cardinal(FCount));
3228
{$ENDIF}
3229
  FList^[Index] := Item;
3230
end;
3231

3232
// SetCapacity
3233
//
3234

3235
procedure TByteList.SetCapacity(NewCapacity: Integer);
3236
begin
3237
  inherited;
3238
  FList := PByteArray(FBaseList);
3239
end;
3240

3241
// ------------------
3242
// ------------------ TDoubleList ------------------
3243
// ------------------
3244

3245
// Create
3246
//
3247

3248
constructor TDoubleList.Create;
3249
begin
3250
  FItemSize := SizeOf(Double);
3251
  inherited Create;
3252
  FGrowthDelta := cDefaultListGrowthDelta;
3253
end;
3254

3255
 
3256
//
3257

3258
procedure TDoubleList.Assign(Src: TPersistent);
3259
begin
3260
  if Assigned(Src) then
3261
  begin
3262
    inherited;
3263
    if (Src is TDoubleList) then
3264
      System.Move(TDoubleList(Src).FList^, FList^, FCount * SizeOf(Double));
3265
  end
3266
  else
3267
    Clear;
3268
end;
3269

3270
// Add
3271
//
3272

3273
function TDoubleList.Add(const item: Double): Integer;
3274
begin
3275
  Result := FCount;
3276
  if Result = FCapacity then
3277
    SetCapacity(FCapacity + FGrowthDelta);
3278
  FList^[Result] := Item;
3279
  Inc(FCount);
3280
end;
3281

3282
// Get
3283
//
3284

3285
function TDoubleList.Get(Index: Integer): Double;
3286
begin
3287
{$IFOPT R+}
3288
    Assert(Cardinal(Index) < Cardinal(FCount));
3289
{$ENDIF}
3290
  Result := FList^[Index];
3291
end;
3292

3293
// Insert
3294
//
3295

3296
procedure TDoubleList.Insert(Index: Integer; const Item: Double);
3297
begin
3298
{$IFOPT R+}
3299
    Assert(Cardinal(Index) < Cardinal(FCount));
3300
{$ENDIF}
3301
  if FCount = FCapacity then
3302
    SetCapacity(FCapacity + FGrowthDelta);
3303
  if Index < FCount then
3304
    System.Move(FList[Index], FList[Index + 1],
3305
      (FCount - Index) * SizeOf(Double));
3306
  FList^[Index] := Item;
3307
  Inc(FCount);
3308
end;
3309

3310
// Put
3311
//
3312

3313
procedure TDoubleList.Put(Index: Integer; const Item: Double);
3314
begin
3315
{$IFOPT R+}
3316
    Assert(Cardinal(Index) < Cardinal(FCount));
3317
{$ENDIF}
3318
  FList^[Index] := Item;
3319
end;
3320

3321
// SetCapacity
3322
//
3323

3324
procedure TDoubleList.SetCapacity(NewCapacity: Integer);
3325
begin
3326
  inherited;
3327
  FList := PDoubleArrayList(FBaseList);
3328
end;
3329

3330
// Push
3331
//
3332

3333
procedure TDoubleList.Push(const Val: Double);
3334
begin
3335
  Add(Val);
3336
end;
3337

3338
// Pop
3339
//
3340

3341
function TDoubleList.Pop: Double;
3342
begin
3343
  if FCount > 0 then
3344
  begin
3345
    Result := Get(FCount - 1);
3346
    Delete(FCount - 1);
3347
  end
3348
  else
3349
    Result := 0;
3350
end;
3351

3352
// AddSerie
3353
//
3354

3355
procedure TDoubleList.AddSerie(aBase, aDelta: Double; aCount: Integer);
3356
var
3357
  tmpList: PDouble;
3358
  I:    Integer;
3359
begin
3360
  if aCount <= 0 then
3361
    Exit;
3362
  AdjustCapacityToAtLeast(Count + aCount);
3363
  tmpList := @FList[Count];
3364
  for I := Count to Count + aCount - 1 do
3365
  begin
3366
    tmpList^ := aBase;
3367
    Inc(tmpList);
3368
    aBase := aBase + aDelta;
3369
  end;
3370
  FCount := Count + aCount;
3371
end;
3372

3373
// Offset (Double)
3374
//
3375

3376
procedure TDoubleList.Offset(delta: Double);
3377
var
3378
  I: Integer;
3379
begin
3380
  for I := 0 to Count - 1 do
3381
    FList^[I] := FList^[I] + delta;
3382
end;
3383

3384
// Offset (list)
3385
//
3386

3387
procedure TDoubleList.Offset(const delta: TDoubleList);
3388
var
3389
  I: Integer;
3390
begin
3391
  if FCount = delta.FCount then
3392
    for I := 0 to Count - 1 do
3393
      FList^[I] := FList^[I] + delta[I]
3394
  else
3395
    raise Exception.Create('DoubleList count do not match');
3396
end;
3397

3398
// Scale
3399
//
3400

3401
procedure TDoubleList.Scale(factor: Double);
3402
var
3403
  I: Integer;
3404
begin
3405
  for I := 0 to Count - 1 do
3406
    FList^[I] := FList^[I] * factor;
3407
end;
3408

3409
// Sqr
3410
//
3411

3412
procedure TDoubleList.Sqr;
3413
var
3414
  I: Integer;
3415
  locList: PDoubleArrayList;
3416
begin
3417
  locList := FList;
3418
  for I := 0 to Count - 1 do
3419
    locList^[I] := locList^[I] * locList^[I];
3420
end;
3421

3422
// Sqrt
3423
//
3424

3425
procedure TDoubleList.Sqrt;
3426
var
3427
  I: Integer;
3428
  locList: PDoubleArrayList;
3429
begin
3430
  locList := FList;
3431
  for I := 0 to Count - 1 do
3432
    locList^[I] := System.Sqrt(locList^[I]);
3433
end;
3434

3435
// Sum
3436
//
3437

3438
function TDoubleList.Sum: Double;
3439
{$IFNDEF GLS_NO_ASM}
3440
  function ComputeSum(list: PDoubleArrayList; nb: Integer): Double; register;
3441
  asm
3442
    fld   dword ptr [eax]
3443
    @@Loop:
3444
    dec   edx
3445
    fadd  dword ptr [eax+edx*4]
3446
    jnz   @@Loop
3447
  end;
3448

3449
begin
3450
  if FCount > 0 then
3451
    Result := ComputeSum(FList, FCount)
3452
  else
3453
    Result := 0;
3454
{$ELSE}
3455
var
3456
  i: Integer;
3457
begin
3458
    Result := 0;
3459
    for i := 0 to FCount-1 do
3460
    Result := Result + FList^[i];
3461
{$ENDIF}
3462
end;
3463

3464
// Min
3465
//
3466
function TDoubleList.Min: Single;
3467
var
3468
  I: Integer;
3469
  locList: PDoubleArrayList;
3470
begin
3471
  if FCount > 0 then
3472
  begin
3473
    locList := FList;
3474
    Result := locList^[0];
3475
    for I := 1 to FCount - 1 do
3476
      if locList^[I] < Result then
3477
        Result := locList^[I];
3478
  end
3479
  else
3480
    Result := 0;
3481
end;
3482

3483
// Max
3484
//
3485
function TDoubleList.Max: Single;
3486
var
3487
  I: Integer;
3488
  locList: PDoubleArrayList;
3489
begin
3490
  if FCount > 0 then
3491
  begin
3492
    locList := FList;
3493
    Result := locList^[0];
3494
    for I := 1 to FCount - 1 do
3495
      if locList^[I] > Result then
3496
        Result := locList^[I];
3497
  end
3498
  else
3499
    Result := 0;
3500
end;
3501

3502
// ------------------
3503
// ------------------ TQuaternionList ------------------
3504
// ------------------
3505

3506
// Create
3507
//
3508

3509
constructor TQuaternionList.Create;
3510
begin
3511
  FItemSize := SizeOf(TQuaternion);
3512
  inherited Create;
3513
  FGrowthDelta := cDefaultListGrowthDelta;
3514
end;
3515

3516
 
3517
//
3518

3519
procedure TQuaternionList.Assign(Src: TPersistent);
3520
begin
3521
  if Assigned(Src) then
3522
  begin
3523
    inherited;
3524
    if (Src is TQuaternionList) then
3525
      System.Move(TQuaternionList(Src).FList^, FList^, FCount * SizeOf(TQuaternion));
3526
  end
3527
  else
3528
    Clear;
3529
end;
3530

3531
// Add
3532
//
3533

3534
function TQuaternionList.Add(const item: TQuaternion): Integer;
3535
begin
3536
  Result := FCount;
3537
  if Result = FCapacity then
3538
    SetCapacity(FCapacity + FGrowthDelta);
3539
  FList^[Result] := Item;
3540
  Inc(FCount);
3541
end;
3542

3543
// Add
3544
//
3545

3546
function TQuaternionList.Add(const item: TAffineVector; w: Single): Integer;
3547
begin
3548
  Result := Add(QuaternionMake(item.V, w));
3549
end;
3550

3551
// Add
3552
//
3553

3554
function TQuaternionList.Add(const X, Y, Z, w: Single): Integer;
3555
begin
3556
  Result := Add(QuaternionMake([X, Y, Z], w));
3557
end;
3558

3559
// Get
3560
//
3561

3562
function TQuaternionList.Get(Index: Integer): TQuaternion;
3563
begin
3564
{$IFOPT R+}
3565
    Assert(Cardinal(Index) < Cardinal(FCount));
3566
{$ENDIF}
3567
  Result := FList^[Index];
3568
end;
3569

3570
// Insert
3571
//
3572

3573
procedure TQuaternionList.Insert(Index: Integer; const Item: TQuaternion);
3574
begin
3575
{$IFOPT R+}
3576
    Assert(Cardinal(Index) < Cardinal(FCount));
3577
{$ENDIF}
3578
  if FCount = FCapacity then
3579
    SetCapacity(FCapacity + FGrowthDelta);
3580
  if Index < FCount then
3581
    System.Move(FList[Index], FList[Index + 1],
3582
      (FCount - Index) * SizeOf(TQuaternion));
3583
  FList^[Index] := Item;
3584
  Inc(FCount);
3585
end;
3586

3587
// Put
3588
//
3589

3590
procedure TQuaternionList.Put(Index: Integer; const Item: TQuaternion);
3591
begin
3592
{$IFOPT R+}
3593
    Assert(Cardinal(Index) < Cardinal(FCount));
3594
{$ENDIF}
3595
  FList^[Index] := Item;
3596
end;
3597

3598
// SetCapacity
3599
//
3600

3601
procedure TQuaternionList.SetCapacity(NewCapacity: Integer);
3602
begin
3603
  inherited;
3604
  FList := PQuaternionArray(FBaseList);
3605
end;
3606

3607
// Push
3608
//
3609

3610
procedure TQuaternionList.Push(const Val: TQuaternion);
3611
begin
3612
  Add(Val);
3613
end;
3614

3615
// Pop
3616
//
3617

3618
function TQuaternionList.Pop: TQuaternion;
3619
begin
3620
  if FCount > 0 then
3621
  begin
3622
    Result := Get(FCount - 1);
3623
    Delete(FCount - 1);
3624
  end
3625
  else
3626
    Result := IdentityQuaternion;
3627
end;
3628

3629
// IndexOf
3630
//
3631

3632
function TQuaternionList.IndexOf(const item: TQuaternion): Integer;
3633
var
3634
  I: Integer;
3635
  curItem: PQuaternion;
3636
begin
3637
  for I := 0 to Count - 1 do
3638
  begin
3639
    curItem := @FList[I];
3640
    if (item.RealPart = curItem^.RealPart) and VectorEquals(item.ImagPart, curItem^.ImagPart) then
3641
    begin
3642
      Result := I;
3643
      Exit;
3644
    end;
3645
  end;
3646
  Result := -1;
3647
end;
3648

3649
// FindOrAdd
3650
//
3651

3652
function TQuaternionList.FindOrAdd(const item: TQuaternion): Integer;
3653
begin
3654
  Result := IndexOf(item);
3655
  if Result < 0 then
3656
    Result := Add(item);
3657
end;
3658

3659
// Lerp
3660
//
3661

3662
procedure TQuaternionList.Lerp(const list1, list2: TBaseVectorList; lerpFactor: Single);
3663
var
3664
  I: Integer;
3665
begin
3666
  if (list1 is TQuaternionList) and (list2 is TQuaternionList) then
3667
  begin
3668
    Assert(list1.Count = list2.Count);
3669
    Capacity := list1.Count;
3670
    FCount := list1.Count;
3671
    for I := 0 to FCount - 1 do
3672
      Put(I, QuaternionSlerp(TQuaternionList(list1)[I], TQuaternionList(list2)[I], lerpFactor));
3673
  end;
3674
end;
3675

3676
// Combine
3677
//
3678

3679
procedure TQuaternionList.Combine(const list2: TBaseVectorList; factor: Single);
3680

3681
  procedure CombineQuaternion(var q1: TQuaternion; const q2: TQuaternion; factor: Single);
3682
  begin
3683
    q1 := QuaternionMultiply(q1, QuaternionSlerp(IdentityQuaternion, q2, factor));
3684
  end;
3685

3686
var
3687
  I: Integer;
3688
begin
3689
  Assert(list2.Count >= Count);
3690
  if list2 is TQuaternionList then
3691
  begin
3692
    for I := 0 to Count - 1 do
3693
    begin
3694
      CombineQuaternion(PQuaternion(ItemAddress[I])^,
3695
        PQuaternion(list2.ItemAddress[I])^,
3696
        factor);
3697
    end;
3698
  end
3699
  else
3700
    inherited;
3701
end;
3702

3703
// ------------------
3704
// ------------------ T4ByteList ------------------
3705
// ------------------
3706

3707
// Create
3708
//
3709

3710
constructor T4ByteList.Create;
3711
begin
3712
  FItemSize := SizeOf(T4ByteList);
3713
  inherited Create;
3714
  FGrowthDelta := cDefaultListGrowthDelta;
3715
end;
3716

3717
 
3718
//
3719

3720
procedure T4ByteList.Assign(Src: TPersistent);
3721
begin
3722
  if Assigned(Src) then
3723
  begin
3724
    inherited;
3725
    if (Src is T4ByteList) then
3726
      System.Move(T4ByteList(Src).FList^, FList^, FCount * SizeOf(T4ByteData));
3727
  end
3728
  else
3729
    Clear;
3730
end;
3731

3732
// Add
3733
//
3734

3735
function T4ByteList.Add(const item: T4ByteData): Integer;
3736
begin
3737
  Result := FCount;
3738
  if Result = FCapacity then
3739
    SetCapacity(FCapacity + FGrowthDelta);
3740
  FList^[Result] := Item;
3741
  Inc(FCount);
3742
  Inc(FRevision);
3743
end;
3744

3745
procedure T4ByteList.Add(const i1: Single);
3746
var
3747
  tmpList: PSingle;
3748
begin
3749
  Inc(FCount);
3750
  if FCount >= FCapacity then
3751
    SetCapacity(FCapacity + FGrowthDelta);
3752
  tmpList := @FList[FCount - 1];
3753
  tmpList^ := i1;
3754
  Inc(FRevision);
3755
end;
3756

3757
procedure T4ByteList.Add(const i1, i2: Single);
3758
var
3759
  tmpList: PSingleArray;
3760
begin
3761
  Inc(FCount, 2);
3762
  while FCount > FCapacity do
3763
    SetCapacity(FCapacity + FGrowthDelta);
3764
  tmpList := @FList[FCount - 2];
3765
  tmpList^[0] := i1;
3766
  tmpList^[1] := i2;
3767
  Inc(FRevision);
3768
end;
3769

3770

3771
procedure T4ByteList.Add(const i1, i2, i3: Single);
3772
var
3773
  tmpList: PSingleArray;
3774
begin
3775
  Inc(FCount, 3);
3776
  while FCount > FCapacity do
3777
    SetCapacity(FCapacity + FGrowthDelta);
3778
  tmpList := @FList[FCount - 3];
3779
  tmpList^[0] := i1;
3780
  tmpList^[1] := i2;
3781
  tmpList^[2] := i3;
3782
  Inc(FRevision);
3783
end;
3784

3785

3786
procedure T4ByteList.Add(const i1, i2, i3, i4: Single);
3787
var
3788
  tmpList: PSingleArray;
3789
begin
3790
  Inc(FCount, 4);
3791
  while FCount > FCapacity do
3792
    SetCapacity(FCapacity + FGrowthDelta);
3793
  tmpList := @FList[FCount - 4];
3794
  tmpList^[0] := i1;
3795
  tmpList^[1] := i2;
3796
  tmpList^[2] := i3;
3797
  tmpList^[3] := i4;
3798
  Inc(FRevision);
3799
end;
3800

3801
procedure T4ByteList.Add(const i1: Integer);
3802
var
3803
  tmpList: PInteger;
3804
begin
3805
  Inc(FCount);
3806
  while FCount > FCapacity do
3807
    SetCapacity(FCapacity + FGrowthDelta);
3808
  tmpList := @FList[FCount - 1];
3809
  tmpList^ := i1;
3810
  Inc(FRevision);
3811
end;
3812

3813
procedure T4ByteList.Add(const i1, i2: Integer);
3814
var
3815
  tmpList: PIntegerArray;
3816
begin
3817
  Inc(FCount, 2);
3818
  while FCount > FCapacity do
3819
    SetCapacity(FCapacity + FGrowthDelta);
3820
  tmpList := @FList[FCount - 2];
3821
  tmpList^[0] := i1;
3822
  tmpList^[1] := i2;
3823
  Inc(FRevision);
3824
end;
3825

3826

3827
procedure T4ByteList.Add(const i1, i2, i3: Integer);
3828
var
3829
  tmpList: PIntegerArray;
3830
begin
3831
  Inc(FCount, 3);
3832
  while FCount > FCapacity do
3833
    SetCapacity(FCapacity + FGrowthDelta);
3834
  tmpList := @FList[FCount - 3];
3835
  tmpList^[0] := i1;
3836
  tmpList^[1] := i2;
3837
  tmpList^[2] := i3;
3838
  Inc(FRevision);
3839
end;
3840

3841

3842
procedure T4ByteList.Add(const i1, i2, i3, i4: Integer);
3843
var
3844
  tmpList: PIntegerArray;
3845
begin
3846
  Inc(FCount, 4);
3847
  while FCount > FCapacity do
3848
    SetCapacity(FCapacity + FGrowthDelta);
3849
  tmpList := @FList[FCount - 4];
3850
  tmpList^[0] := i1;
3851
  tmpList^[1] := i2;
3852
  tmpList^[2] := i3;
3853
  tmpList^[3] := i4;
3854
  Inc(FRevision);
3855
end;
3856

3857
procedure T4ByteList.Add(const i1: Cardinal);
3858
var
3859
  tmpList: PLongWord;
3860
begin
3861
  Inc(FCount);
3862
  while FCount > FCapacity do
3863
    SetCapacity(FCapacity + FGrowthDelta);
3864
  tmpList := @FList[FCount - 1];
3865
  tmpList^ := i1;
3866
  Inc(FRevision);
3867
end;
3868

3869
procedure T4ByteList.Add(const i1, i2: Cardinal);
3870
var
3871
  tmpList: PLongWordArray;
3872
begin
3873
  Inc(FCount, 2);
3874
  while FCount > FCapacity do
3875
    SetCapacity(FCapacity + FGrowthDelta);
3876
  tmpList := @FList[FCount - 2];
3877
  tmpList^[0] := i1;
3878
  tmpList^[1] := i2;
3879
  Inc(FRevision);
3880
end;
3881

3882

3883
procedure T4ByteList.Add(const i1, i2, i3: Cardinal);
3884
var
3885
  tmpList: PLongWordArray;
3886
begin
3887
  Inc(FCount, 3);
3888
  while FCount > FCapacity do
3889
    SetCapacity(FCapacity + FGrowthDelta);
3890
  tmpList := @FList[FCount - 3];
3891
  tmpList^[0] := i1;
3892
  tmpList^[1] := i2;
3893
  tmpList^[2] := i3;
3894
  Inc(FRevision);
3895
end;
3896

3897

3898
procedure T4ByteList.Add(const i1, i2, i3, i4: Cardinal);
3899
var
3900
  tmpList: PLongWordArray;
3901
begin
3902
  Inc(FCount, 4);
3903
  while FCount > FCapacity do
3904
    SetCapacity(FCapacity + FGrowthDelta);
3905
  tmpList := @FList[FCount - 4];
3906
  tmpList^[0] := i1;
3907
  tmpList^[1] := i2;
3908
  tmpList^[2] := i3;
3909
  tmpList^[3] := i4;
3910
  Inc(FRevision);
3911
end;
3912

3913
procedure T4ByteList.Add(const AList: T4ByteList);
3914
begin
3915
  if Assigned(AList) and (AList.Count > 0) then
3916
  begin
3917
    if Count + AList.Count > Capacity then
3918
      Capacity := Count + AList.Count;
3919
    System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(T4ByteData));
3920
    Inc(FCount, AList.Count);
3921
    Inc(FRevision);
3922
  end;
3923
end;
3924

3925
// Get
3926
//
3927

3928
function T4ByteList.Get(Index: Integer): T4ByteData;
3929
begin
3930
{$IFOPT R+}
3931
    Assert(Cardinal(Index) < Cardinal(FCount));
3932
{$ENDIF}
3933
  Result := FList^[Index];
3934
end;
3935

3936
// Insert
3937
//
3938

3939
procedure T4ByteList.Insert(Index: Integer; const Item: T4ByteData);
3940
begin
3941
{$IFOPT R+}
3942
    Assert(Cardinal(Index) < Cardinal(FCount));
3943
{$ENDIF}
3944
  if FCount = FCapacity then
3945
    SetCapacity(FCapacity + FGrowthDelta);
3946
  if Index < FCount then
3947
    System.Move(FList[Index], FList[Index + 1],
3948
      (FCount - Index) * SizeOf(T4ByteData));
3949
  FList^[Index] := Item;
3950
  Inc(FCount);
3951
  Inc(FRevision);
3952
end;
3953

3954
// Put
3955
//
3956

3957
procedure T4ByteList.Put(Index: Integer; const Item: T4ByteData);
3958
begin
3959
{$IFOPT R+}
3960
    Assert(Cardinal(Index) < Cardinal(FCount));
3961
{$ENDIF}
3962
  FList^[Index] := Item;
3963
  INc(FRevision);
3964
end;
3965

3966
// SetCapacity
3967
//
3968

3969
procedure T4ByteList.SetCapacity(NewCapacity: Integer);
3970
begin
3971
  inherited;
3972
  FList := P4ByteArrayList(FBaseList);
3973
end;
3974

3975
// Push
3976
//
3977

3978
procedure T4ByteList.Push(const Val: T4ByteData);
3979
begin
3980
  Add(Val);
3981
end;
3982

3983
// Pop
3984
//
3985

3986
function T4ByteList.Pop: T4ByteData;
3987
const
3988
  Zero : T4ByteData = ( Int: (Value:0) );
3989
begin
3990
  if FCount > 0 then
3991
  begin
3992
    Result := Get(FCount - 1);
3993
    Delete(FCount - 1);
3994
  end
3995
  else
3996
    Result := Zero;
3997
end;
3998

3999
// ------------------
4000
// ------------------ TLongWordList ------------------
4001
// ------------------
4002

4003
// Create
4004
//
4005

4006
constructor TLongWordList.Create;
4007
begin
4008
  FItemSize := SizeOf(LongWord);
4009
  inherited Create;
4010
  FGrowthDelta := cDefaultListGrowthDelta;
4011
end;
4012

4013
 
4014
//
4015

4016
procedure TLongWordList.Assign(Src: TPersistent);
4017
begin
4018
  if Assigned(Src) then
4019
  begin
4020
    inherited;
4021
    if (Src is TLongWordList) then
4022
      System.Move(TLongWordList(Src).FList^, FList^, FCount * SizeOf(LongWord));
4023
  end
4024
  else
4025
    Clear;
4026
end;
4027

4028
// Add (simple)
4029
//
4030

4031
function TLongWordList.Add(const item: LongWord): Integer;
4032
begin
4033
  Result := FCount;
4034
  if Result = FCapacity then
4035
    SetCapacity(FCapacity + FGrowthDelta);
4036
  FList^[Result] := Item;
4037
  Inc(FCount);
4038
end;
4039

4040
// AddNC (simple, no capacity check)
4041
//
4042

4043
function TLongWordList.AddNC(const item: LongWord): Integer;
4044
begin
4045
  Result := FCount;
4046
  FList^[Result] := Item;
4047
  Inc(FCount);
4048
end;
4049

4050
// Add (two at once)
4051
//
4052

4053
procedure TLongWordList.Add(const i1, i2: LongWord);
4054
var
4055
  tmpList : PLongWordArray;
4056
begin
4057
  Inc(FCount, 2);
4058
  while FCount > FCapacity do
4059
    SetCapacity(FCapacity + FGrowthDelta);
4060
  tmpList := @FList[FCount - 2];
4061
  tmpList^[0] := i1;
4062
  tmpList^[1] := i2;
4063
end;
4064

4065
// Add (three at once)
4066
//
4067

4068
procedure TLongWordList.Add(const i1, i2, i3: LongWord);
4069
var
4070
  tmpList : PLongWordArray;
4071
begin
4072
  Inc(FCount, 3);
4073
  while FCount > FCapacity do
4074
    SetCapacity(FCapacity + FGrowthDelta);
4075
  tmpList := @FList[FCount - 3];
4076
  tmpList^[0] := i1;
4077
  tmpList^[1] := i2;
4078
  tmpList^[2] := i3;
4079
end;
4080

4081
// Add (list)
4082
//
4083

4084
procedure TLongWordList.Add(const AList: TLongWordList);
4085
begin
4086
  if Assigned(AList) and (AList.Count > 0) then
4087
  begin
4088
    if Count + AList.Count > Capacity then
4089
      Capacity := Count + AList.Count;
4090
    System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(LongWord));
4091
    Inc(FCount, AList.Count);
4092
  end;
4093
end;
4094

4095
// Get
4096
//
4097

4098
function TLongWordList.Get(Index: Integer): LongWord;
4099
begin
4100
{$IFOPT R+}
4101
    Assert(Cardinal(Index) < Cardinal(FCount));
4102
{$ENDIF}
4103
  Result := FList^[Index];
4104
end;
4105

4106
// Insert
4107
//
4108

4109
procedure TLongWordList.Insert(Index: Integer; const Item: LongWord);
4110
begin
4111
{$IFOPT R+}
4112
    Assert(Cardinal(Index) < Cardinal(FCount));
4113
{$ENDIF}
4114
  if FCount = FCapacity then
4115
    SetCapacity(FCapacity + FGrowthDelta);
4116
  if Index < FCount then
4117
    System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(LongWord));
4118
  FList^[Index] := Item;
4119
  Inc(FCount);
4120
end;
4121

4122
// Remove
4123
//
4124

4125
procedure TLongWordList.Remove(const item: LongWord);
4126
var
4127
  I: Integer;
4128
begin
4129
  for I := 0 to Count - 1 do
4130
  begin
4131
    if FList^[I] = item then
4132
    begin
4133
      System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(LongWord));
4134
      Dec(FCount);
4135
      Break;
4136
    end;
4137
  end;
4138
end;
4139

4140
// Put
4141
//
4142

4143
procedure TLongWordList.Put(Index: Integer; const Item: LongWord);
4144
begin
4145
{$IFOPT R+}
4146
    Assert(Cardinal(Index) < Cardinal(FCount));
4147
{$ENDIF}
4148
  FList^[Index] := Item;
4149
end;
4150

4151
// SetCapacity
4152
//
4153

4154
procedure TLongWordList.SetCapacity(NewCapacity: Integer);
4155
begin
4156
  inherited;
4157
  FList := PLongWordArray(FBaseList);
4158
end;
4159

4160
// Push
4161
//
4162

4163
procedure TLongWordList.Push(const Val: LongWord);
4164
begin
4165
  Add(Val);
4166
end;
4167

4168
// Pop
4169
//
4170

4171
function TLongWordList.Pop: LongWord;
4172
begin
4173
  if FCount > 0 then
4174
  begin
4175
    Result := FList^[FCount - 1];
4176
    Delete(FCount - 1);
4177
  end
4178
  else
4179
    Result := 0;
4180
end;
4181

4182
// AddLongWords (pointer & n)
4183
//
4184

4185
procedure TLongWordList.AddLongWords(const First: PLongWord; n: Integer);
4186
begin
4187
  if n < 1 then
4188
    Exit;
4189
  AdjustCapacityToAtLeast(Count + n);
4190
  System.Move(First^, FList[FCount], n * SizeOf(LongWord));
4191
  FCount := FCount + n;
4192
end;
4193

4194
// AddLongWords (TLongWordList)
4195
//
4196

4197
procedure TLongWordList.AddLongWords(const aList: TLongWordList);
4198
begin
4199
  if not Assigned(aList) then
4200
    Exit;
4201
  AddLongWords(@aList.List[0], aList.Count);
4202
end;
4203

4204
// AddLongWords (array)
4205
//
4206

4207
procedure TLongWordList.AddLongWords(const anArray: array of LongWord);
4208
var
4209
  n: Integer;
4210
begin
4211
  n := Length(anArray);
4212
  if n > 0 then
4213
    AddLongWords(@anArray[0], n);
4214
end;
4215

4216
// LongWordSearch
4217
//
4218

4219
function LongWordSearch(item: LongWord; list: PLongWordVector; Count: Integer): Integer; register;
4220
{$IFDEF GLS_NO_ASM}
4221
var i : integer;
4222
begin
4223
  result:=-1;
4224
  for i := 0 to Count-1 do begin
4225
    if list^[i]=item then begin
4226
      result:=i;
4227
      break;
4228
    end;
4229
  end;
4230
end;
4231
{$ELSE}
4232
asm
4233
  push edi;
4234

4235
  test ecx, ecx
4236
  jz @@NotFound
4237

4238
  mov edi, edx;
4239
  mov edx, ecx;
4240
  repne scasd;
4241
  je @@FoundIt
4242

4243
  @@NotFound:
4244
  xor eax, eax
4245
  dec eax
4246
  jmp @@end;
4247

4248
  @@FoundIt:
4249
  sub edx, ecx;
4250
  dec edx;
4251
  mov eax, edx;
4252

4253
  @@end:
4254
  pop edi;
4255
end;
4256
{$ENDIF}
4257

4258
function TLongWordList.IndexOf(item: Integer): LongWord; register;
4259
begin
4260
  Result := LongWordSearch(item, FList, FCount);
4261
end;
4262

4263
// ------------------------------------------------------------------
4264
// ------------------------------------------------------------------
4265
// ------------------------------------------------------------------
4266
initialization
4267
  // ------------------------------------------------------------------
4268
  // ------------------------------------------------------------------
4269
  // ------------------------------------------------------------------
4270

4271
  RegisterClasses([TAffineVectorList, TVectorList, TTexPointList, TSingleList,
4272
                   TDoubleList, T4ByteList, TLongWordList]);
4273

4274
end.
4275