2
// This unit is part of the GLScene Engine https://github.com/glscene
5
Base classes for scene-wide blended particles FX.
7
These provide a mechanism to render heterogenous particles systems with per
8
particle depth-sorting (allowing correct rendering of interwoven separate
9
fire and smoke particle systems for instance).
12
21/01/01 - DanB - Added "inherited" call to TGLParticleFXEffect.WriteToFiler
13
23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
14
22/04/10 - Yar - Fixes after GLState revision
15
05/03/10 - DanB - More state added to TGLStateCache
16
22/01/10 - Yar - Added bmp32.Blank:=false for memory allocation
17
and fix RegisterAsOpenGLTexture
18
12/10/08 - DanB - fix to TGLLifeColoredPFXManager.ComputeRotateAngle (it used lck.FDoScale
19
instead of lck.FDoRotate), made more use of RCI instead of accessing via global variables.
20
Changed order of transformations when rendering particles, now does rotation+scaling before translation.
21
Disabled FRotationCenter,
22
15/02/08 - Mrqzzz - Fixed SizeScale in Lifetimes of TGLBaseSpritePFXManager (was ignored)
23
06/06/07 - DaStr - Added GLColor to uses (BugtrackerID = 1732211)
24
02/04/07 - DaStr - TPFXLifeColors now inherits from TOwnedCollection
25
(thanks Burkhard Carstens)
26
30/03/07 - DaStr - Added $I GLScene.inc
27
14/03/07 - DaStr - Added explicit pointer dereferencing
28
(thanks Burkhard Carstens) (Bugtracker ID = 1678644)
29
24/01/07 - DaStr - TGLSourcePFXEffect.Burst and TGLBaseSpritePFXManager.RenderParticle bugfixed
30
TGLLifeColoredPFXManager.RotateVertexBuf bugfixed (all based on old code)
31
28/10/06 - LC - Fixed access violation in TGLParticleFXRenderer. Bugtracker ID=1585907 (thanks Da Stranger)
32
19/10/06 - LC - Fixed memory leak in TGLParticleFXManager. Bugtracker ID=1551866 (thanks Dave Gravel)
33
08/10/05 - Mathx - Fixed access violation when a PFXManager was removed from
34
form but a particleFX still had a reference to it (added
35
the FUsers property). Butracker ID=783625.
36
17/02/05 - EG - Restored correct PFXSource.Burst relative/absolute behaviour,
37
EffectsScale support not added back (no clue what it does... Mrqz?)
38
23/11/04 - SG - Fixed memory leak in TGLLifeColoredPFXManager (kenguru)
39
03/10/04 - Mrqzzz - added property TGLParticleFXEffect.DisabledIfOwnerInvisible. Fixed PositionDispersionRange to honour VelocityMode=svmRelative
40
25/09/04 - Graham Kennedy - Fixed restore of currentTexturingMode
41
09/09/04 - Mrqzzz - added property TGLParticleFXEffect.EffectScale allowing different scaling of effect with same manager. TGLParticleFXEffect.ArchiveVersion updated to 4
42
02/08/04 - LR, YHC - BCB corrections: use record instead array
43
Replace direct access of some properties by
44
a getter and a setter.
45
fixed undefined TPFXRegion error in BCB
46
29/08/04 - Mrqzzz - fixed particles initial position when VelocityMode=svmRelative
47
28/08/04 - Mrqzzz - fixed particles direction when VelocityMode=svmRelative
48
09/07/04 - Mrqzzz - small fixup (TGLSourcePFXEffect.WriteToFiler Archive V.4)
49
08/07/04 - Eugene Kryukov - Added rotation for particles, RotateAngle in
50
LifeColor. And added AbsoluteRotation for TGLDynamicPFXManager
51
25/04/04 - EG - Added friction, Life sizes, multiple sprites per texture
53
24/04/04 - Mrqzzz - Added property "enabled" to TGLSourcePFXEffect
54
15/04/04 - EG - AspectRatio and Rotation added to sprite PFX,
55
improved texturing mode switches
56
26/05/03 - EG - Improved TGLParticleFXRenderer.BuildList
57
05/11/02 - EG - Enable per-manager blending mode control
58
27/01/02 - EG - Added TGLLifeColoredPFXManager, TGLBaseSpritePFXManager
59
and TGLPointLightPFXManager.
60
23/01/02 - EG - Added ZWrite and BlendingMode to the PFX renderer,
61
minor sort and render optims
62
22/01/02 - EG - Another RenderParticle color lerp fix (GliGli)
63
20/01/02 - EG - Several optimization (35% faster on Volcano bench)
64
18/01/02 - EG - RenderParticle color lerp fix (GliGli)
65
08/09/01 - EG - Creation (GLParticleFX.omm)
76
GLScene, OpenGLTokens, GLCrossPlatform, GLState, GLVectorTypes,
77
GLPersistentClasses, GLVectorGeometry, GLXCollection, GLMaterial,
78
GLCadencer, GLVectorLists, GLGraphics, GLContext, GLColor, GLBaseClasses,
79
GLCoordinates, GLRenderContextInfo, GLManager, GLTextureFormat, GLRandomGenerator;
82
cPFXNbRegions = 128; // number of distance regions
83
cPFXGranularity = 128; // granularity of particles per region
87
TGLParticleList = class;
88
TGLParticleFXManager = class;
89
TGLParticleFXEffect = class;
93
{ Base class for particles.94
The class implements properties for position, velocity and time, whatever
95
you need in excess of that will have to be placed in subclasses (this
96
class should remain as compact as possible). }
97
TGLParticle = class(TPersistentObject)
101
FManager: TGLParticleFXManager; // NOT persistent
102
FPosition: TAffineVector;
103
FVelocity: TAffineVector;
105
FCreationTime: Double;
106
FEffectScale: Single;
107
function GetPosition(const Index: Integer): Single;
108
procedure WritePosition(const Index: Integer; const aValue: Single);
109
function GetVelocity(const Index: Integer): Single;
110
procedure WriteVelocity(const Index: Integer; const aValue: Single);
117
constructor Create; override;
118
destructor Destroy; override;
119
procedure WriteToFiler(writer: TVirtualWriter); override;
120
procedure ReadFromFiler(reader: TVirtualReader); override;
122
property Manager: TGLParticleFXManager read FManager write FManager;
124
{ Particle's ID, given at birth.125
ID is a value unique per manager. }
126
property ID: Integer read FID;
127
{ Particle's absolute position.128
Note that this property is read-accessed directly at rendering time
129
in the innards of the depth-sorting code. }
130
property Position: TAffineVector read FPosition write FPosition;
131
{ Particle's velocity.132
This velocity is indicative and is NOT automatically applied
133
to the position during progression events by this class (subclasses
134
may implement that). }
135
property Velocity: TAffineVector read FVelocity write FVelocity;
136
{ Time at which particle was created }137
property CreationTime: Double read FCreationTime write FCreationTime;
139
property PosX : Single index 0 read GetPosition write WritePosition;
140
property PosY : Single index 1 read GetPosition write WritePosition;
141
property PosZ : Single index 2 read GetPosition write WritePosition;
142
property VelX : Single index 0 read GetVelocity write WriteVelocity;
143
property VelY : Single index 1 read GetVelocity write WriteVelocity;
144
property VelZ : Single index 2 read GetVelocity write WriteVelocity;
146
property Tag: Integer read FTag write FTag;
149
TGLParticleClass = class of TGLParticle;
150
TGLParticleArray = array[0..MaxInt shr 4] of TGLParticle;
151
PGLParticleArray = ^TGLParticleArray;
156
This list is managed with particles and performance in mind, make sure to
158
TGLParticleList = class(TPersistentObject)
161
FOwner: TGLParticleFXManager; // NOT persistent
162
FItemList: TPersistentObjectList;
163
FDirectList: PGLParticleArray; // NOT persistent
167
function GetItems(index: Integer): TGLParticle;
168
procedure SetItems(index: Integer; val: TGLParticle);
169
procedure AfterItemCreated(Sender: TObject);
173
constructor Create; override;
174
destructor Destroy; override;
175
procedure WriteToFiler(writer: TVirtualWriter); override;
176
procedure ReadFromFiler(reader: TVirtualReader); override;
178
{ Refers owner manager }179
property Owner: TGLParticleFXManager read FOwner write FOwner;
180
property Items[index: Integer]: TGLParticle read GetItems write SetItems; default;
182
function ItemCount: Integer;
183
{ Adds a particle to the list.184
Particle owneship is defined blindly, if the particle was previously
185
in another list, it won't be automatically removed from that list. }
186
function AddItem(aItem: TGLParticle): Integer;
187
{ Removes and frees a particular item for the list.188
If the item is not part of the list, nothing is done.
189
If found in the list, the item's "slot" is set to nil and item is
190
freed (after setting its ownership to nil). The nils can be removed
191
with a call to Pack. }
192
procedure RemoveAndFreeItem(aItem: TGLParticle);
193
function IndexOfItem(aItem: TGLParticle): Integer;
194
{ Packs the list by removing all "nil" items.195
Note: this functions is orders of magnitude faster than the TList
199
property List: PGLParticleArray read FDirectList;
202
TGLParticleFXRenderer = class;
203
TPFXCreateParticleEvent = procedure(Sender: TObject; aParticle: TGLParticle) of object;
205
// TGLParticleFXManager
207
{ Base class for particle FX managers.208
Managers take care of life and death of particles for a particular
209
particles FX system. You can have multiple scene-wide particle
210
FX managers in a scene, handled by the same ParticleFxRenderer.
211
Before subclassing, make sure you understood how the Initialize/Finalize
212
Rendering, Begin/End Particles and RenderParticles methods (and also
213
understood that rendering of manager's particles may be interwoven). }
214
TGLParticleFXManager = class(TGLCadencedComponent)
217
FBlendingMode: TBlendingMode;
218
FRenderer: TGLParticleFXRenderer;
219
FParticles: TGLParticleList;
221
FOnCreateParticle: TPFXCreateParticleEvent;
222
FAutoFreeWhenEmpty: Boolean;
224
FUsers: TList; //list of objects that use this manager
228
procedure SetRenderer(const val: TGLParticleFXRenderer);
229
procedure SetParticles(const aParticles: TGLParticleList);
231
{ Texturing mode for the particles.232
Subclasses should return GL_TEXTURE_1D, 2D or 3D depending on their
233
needs, and zero if they don't use texturing. This method is used
234
to reduce the number of texturing activations/deactivations. }
235
function TexturingMode: Cardinal; virtual; abstract;
237
{ Invoked when the particles of the manager will be rendered.238
This method is fired with the "base" OpenGL states and matrices
239
that will be used throughout the whole rendering, per-frame
240
initialization should take place here.
241
OpenGL states/matrices should not be altered in any way here. }
242
procedure InitializeRendering(var rci: TGLRenderContextInfo); dynamic; abstract;
243
{ Triggered just before rendering a set of particles.244
The current OpenGL state should be assumed to be the "base" one as
245
was found during InitializeRendering. Manager-specific states should
247
Multiple BeginParticles can occur during a render (but all will be
248
between InitializeRendering and Finalizerendering, and at least one
249
particle will be rendered before EndParticles is invoked). }
250
procedure BeginParticles(var rci: TGLRenderContextInfo); virtual; abstract;
251
{ Request to render a particular particle.252
Due to the nature of the rendering, no particular order should be
253
assumed. If possible, no OpenGL state changes should be made in this
254
method, but should be placed in Begin/EndParticles. }
255
procedure RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle); virtual; abstract;
256
{ Triggered after a set of particles as been rendered.257
If OpenGL state were altered directly (ie. not through the states
258
caches of GLMisc), it should be restored back to the "base" state. }
259
procedure EndParticles(var rci: TGLRenderContextInfo); virtual; abstract;
260
{ Invoked when rendering of particles for this manager is done. }261
procedure FinalizeRendering(var rci: TGLRenderContextInfo); dynamic; abstract;
263
{ ID for the next created particle. }264
property NextID: Integer read FNextID write FNextID;
266
{ Blending mode for the particles.267
Protected and unused in the base class. }
268
property BlendingMode: TBlendingMode read FBlendingMode write FBlendingMode;
269
{ Apply BlendingMode relatively to the renderer's blending mode. }270
procedure ApplyBlendingMode(var rci: TGLRenderContextInfo);
271
{ Unapply BlendingMode relatively by restoring the renderer's blending mode. }272
procedure UnapplyBlendingMode(var rci: TGLRenderContextInfo);
274
procedure registerUser(obj: TGLParticleFXEffect);
275
procedure unregisterUser(obj: TGLParticleFXEffect);
279
constructor Create(aOwner: TComponent); override;
280
destructor Destroy; override;
282
procedure NotifyChange(Sender: TObject); override;
283
procedure DoProgress(const progressTime: TProgressTimes); override;
285
// Class of particles created by this manager. }
286
class function ParticlesClass: TGLParticleClass; virtual;
287
{ Creates a new particle controled by the manager. }288
function CreateParticle: TGLParticle; virtual;
289
{ Create several particles at once. }290
procedure CreateParticles(nbParticles: Integer);
292
{ A TGLParticleList property. }293
property Particles: TGLParticleList read FParticles write SetParticles;
294
{ Return the number of particles.295
Note that subclasses may decide to return a particle count inferior
296
to Particles.ItemCount, and the value returned by this method will
297
be the one honoured at render time. }
298
function ParticleCount: Integer; virtual;
300
{ If True the manager will free itself when its particle count reaches zero.301
Check happens in the progression event, use with caution and only
302
if you know what you're doing! }
303
property AutoFreeWhenEmpty: Boolean read FAutoFreeWhenEmpty write FAutoFreeWhenEmpty;
307
{ References the renderer.308
The renderer takes care of ordering the particles of the manager
309
(and other managers linked to it) and rendering them all depth-sorted. }
310
property Renderer: TGLParticleFXRenderer read FRenderer write SetRenderer;
311
{ Event triggered after standard particle creation and initialization. }312
property OnCreateParticle: TPFXCreateParticleEvent read FOnCreateParticle write FOnCreateParticle;
317
// TGLParticleFXEffect
319
{ Base class for linking scene objects to a particle FX manager. }320
TGLParticleFXEffect = class(TGLObjectPostEffect)
323
FManager: TGLParticleFXManager;
324
FManagerName: string;
325
FEffectScale: single;
326
procedure SetEffectScale(const Value: single); // NOT persistent, temporarily used for persistence
330
procedure SetManager(val: TGLParticleFXManager);
332
procedure WriteToFiler(writer: TWriter); override;
333
procedure ReadFromFiler(reader: TReader); override;
335
procedure Loaded; override;
337
procedure managerNotification(aManager: TGLParticleFXManager; Operation: TOperation);
341
constructor Create(aOwner: TGLXCollection); override;
342
destructor Destroy; override;
346
{ Reference to the Particle FX manager }347
property Manager: TGLParticleFXManager read FManager write SetManager;
348
property EffectScale: single read FEffectScale write SetEffectScale;
352
// PFX region rendering structures
354
TParticleReference = packed record
355
particle: TGLParticle;
356
distance: Integer; // stores an IEEE single!
358
PParticleReference = ^TParticleReference;
359
TParticleReferenceArray = packed array[0..MaxInt shr 8-1] of TParticleReference;
360
PParticleReferenceArray = ^TParticleReferenceArray;
361
PFXPointerList = ^TFXPointerList;
362
TFXPointerList = array[0..MaxInt shr 8-1] of Pointer;
364
count, capacity: Integer;
365
particleRef: PParticleReferenceArray;
366
particleOrder: PFXPointerList;
368
PPFXRegion = ^TPFXRegion;
372
TPFXSortAccuracy = (saLow, saOneTenth, saOneThird, saOneHalf, saHigh);
374
// TGLParticleFXRenderer
376
{ Rendering interface for scene-wide particle FX.377
A renderer can take care of rendering any number of particle systems,
378
its main task being to depth-sort the particles so that they are blended
380
This object will usually be placed at the end of the scene hierarchy,
381
just before the HUD overlays, its position, rotation etc. is of no
382
importance and has no effect on the rendering of the particles. }
383
TGLParticleFXRenderer = class(TGLBaseSceneObject)
387
FLastSortTime: Double;
388
FLastParticleCount: Integer;
389
FZWrite, FZTest, FZCull: Boolean;
390
FZSortAccuracy: TPFXSortAccuracy;
391
FZMaxDistance: Single;
392
FBlendingMode: TBlendingMode;
393
FRegions: array[0..cPFXNbRegions - 1] of TPFXRegion;
398
function StoreZMaxDistance: Boolean;
400
{ Register a manager }401
procedure RegisterManager(aManager: TGLParticleFXManager);
402
{ UnRegister a manager }403
procedure UnRegisterManager(aManager: TGLParticleFXManager);
405
procedure UnRegisterAll;
409
constructor Create(aOwner: TComponent); override;
410
destructor Destroy; override;
412
procedure BuildList(var rci: TGLRenderContextInfo); override;
414
{ Time (in msec) spent sorting the particles for last render. }415
property LastSortTime: Double read FLastSortTime;
416
{ Amount of particles during the last render. }417
property LastParticleCount: Integer read FLastParticleCount;
421
{ Specifies if particles should write to ZBuffer.422
If the PFXRenderer is the last object to be rendered in the scene,
423
it is not necessary to write to the ZBuffer since the particles
424
are depth-sorted. Writing to the ZBuffer has a performance penalty. }
425
property ZWrite: Boolean read FZWrite write FZWrite default False;
426
{ Specifies if particles should write to test ZBuffer. }427
property ZTest: Boolean read FZTest write FZTest default True;
428
{ If true the renderer will cull particles that are behind the camera. }429
property ZCull: Boolean read FZCull write FZCull default True;
430
{ If true particles will be accurately sorted back to front.431
When false, only a rough ordering is used, which can result in
432
visual glitches but may be faster. }
433
property ZSortAccuracy: TPFXSortAccuracy read FZSortAccuracy write FZSortAccuracy default saHigh;
434
{ Maximum distance for rendering PFX particles.435
If zero, camera's DepthOfView is used. }
436
property ZMaxDistance: Single read FZMaxDistance write FZMaxDistance stored StoreZMaxDistance;
437
{ Default blending mode for particles.438
"Additive" blending is the usual mode (increases brightness and
439
saturates), "transparency" may be used for smoke or systems that
440
opacify view, "opaque" is more rarely used.
441
Note: specific PFX managers may override/ignore this setting. }
442
property BlendingMode: TBlendingMode read FBlendingMode write FBlendingMode default bmAdditive;
447
// TGLSourcePFXVelocityMode
449
TGLSourcePFXVelocityMode = (svmAbsolute, svmRelative);
451
// TGLSourcePFXPositionMode
453
TGLSourcePFXPositionMode = (spmAbsoluteOffset, spmRelative);
455
// TGLSourcePFXDispersionMode
457
TGLSourcePFXDispersionMode = (sdmFast, sdmIsotropic);
459
// TGLSourcePFXEffect
461
{ Simple Particles Source. }462
TGLSourcePFXEffect = class(TGLParticleFXEffect)
465
FInitialVelocity: TGLCoordinates;
466
FInitialPosition: TGLCoordinates;
467
FPositionDispersionRange: TGLCoordinates;
468
FVelocityDispersion: Single;
469
FPositionDispersion: Single;
470
FParticleInterval: Single;
471
FVelocityMode: TGLSourcePFXVelocityMode;
472
FPositionMode: TGLSourcePFXPositionMode;
473
FDispersionMode: TGLSourcePFXDispersionMode;
475
FDisabledIfOwnerInvisible: Boolean;
476
FTimeRemainder: Double;
477
FRotationDispersion: Single;
480
Procedure SetSeed(aValue: Integer);
484
procedure SetInitialVelocity(const val: TGLCoordinates);
485
procedure SetInitialPosition(const val: TGLCoordinates);
486
procedure SetPositionDispersionRange(const val: TGLCoordinates);
487
procedure SetParticleInterval(const val: Single);
488
procedure WriteToFiler(writer: TWriter); override;
489
procedure ReadFromFiler(reader: TReader); override;
491
function ParticleAbsoluteInitialPos: TAffineVector;
492
procedure RndVector(const dispersion: TGLSourcePFXDispersionMode; var v: TAffineVector; var f: Single;dispersionRange: TGLCoordinates);
495
constructor Create(aOwner: TGLXCollection); override;
496
destructor Destroy; override;
498
class function FriendlyName: string; override;
499
class function FriendlyDescription: string; override;
501
procedure DoProgress(const progressTime: TProgressTimes); override;
503
// Instantaneously creates nb particles
504
procedure Burst(time: Double; nb: Integer);
505
procedure RingExplosion(time: Double; minInitialSpeed, maxInitialSpeed: Single; nbParticles: Integer);
508
property Seed : Integer read FSeed write SetSeed;
509
property InitialVelocity: TGLCoordinates read FInitialVelocity write SetInitialVelocity;
510
property VelocityDispersion: Single read FVelocityDispersion write FVelocityDispersion;
511
property InitialPosition: TGLCoordinates read FInitialPosition write SetInitialPosition;
512
property PositionDispersion: Single read FPositionDispersion write FPositionDispersion;
513
property PositionDispersionRange: TGLCoordinates read FPositionDispersionRange write SetPositionDispersionRange;
514
property ParticleInterval: Single read FParticleInterval write SetParticleInterval;
515
property VelocityMode: TGLSourcePFXVelocityMode read FVelocityMode write FVelocityMode default svmAbsolute;
516
property PositionMode: TGLSourcePFXPositionMode read FPositionMode write FPositionMode default spmAbsoluteOffset;
517
property DispersionMode: TGLSourcePFXDispersionMode read FDispersionMode write FDispersionMode default sdmFast;
518
property RotationDispersion: Single read FRotationDispersion write FRotationDispersion;
519
property Enabled: boolean read FEnabled write FEnabled;
520
property DisabledIfOwnerInvisible: boolean read FDisabledIfOwnerInvisible write FDisabledIfOwnerInvisible;
523
// TGLDynamicPFXManager
525
{ An abstract PFX manager for simple dynamic particles.526
Adds properties and progress implementation for handling moving particles
527
(simple velocity and const acceleration integration). }
528
TGLDynamicPFXManager = class(TGLParticleFXManager)
531
FAcceleration: TGLCoordinates;
533
FCurrentTime: Double;
535
//FRotationCenter: TAffineVector;
539
procedure SetAcceleration(const val: TGLCoordinates);
541
{ Returns the maximum age for a particle.542
Particles older than that will be killed by DoProgress. }
543
function MaxParticleAge: Single; dynamic; abstract;
545
property CurrentTime: Double read FCurrentTime;
549
constructor Create(aOwner: TComponent); override;
550
destructor Destroy; override;
552
procedure DoProgress(const progressTime: TProgressTimes); override;
556
{ Oriented acceleration applied to the particles. }557
property Acceleration: TGLCoordinates read FAcceleration write SetAcceleration;
558
{ Friction applied to the particles.559
Friction is applied as a speed scaling factor over 1 second, ie.
560
a friction of 0.5 will half speed over 1 second, a friction of 3
561
will triple speed over 1 second, and a friction of 1 (default
562
value) will have no effect. }
563
property Friction: Single read FFriction write FFriction;
568
TPFXLifeColor = class(TCollectionItem)
571
FColorInner: TGLColor;
572
FColorOuter: TGLColor;
573
FLifeTime, FInvLifeTime: Single;
574
FIntervalRatio: Single;
579
FRotateAngle: Single;
583
function GetDisplayName: string; override;
584
procedure SetColorInner(const val: TGLColor);
585
procedure SetColorOuter(const val: TGLColor);
586
procedure SetLifeTime(const val: Single);
587
procedure SetSizeScale(const val: Single);
588
procedure SetRotateAngle(const Value: Single); // indirectly persistent
592
constructor Create(Collection: TCollection); override;
593
destructor Destroy; override;
595
procedure Assign(Source: TPersistent); override;
597
{ Stores 1/LifeTime }598
property InvLifeTime: Single read FInvLifeTime;
599
{ Stores 1/(LifeTime[Next]-LifeTime[Self]) }600
property InvIntervalRatio: Single read FIntervalRatio;
604
property ColorInner: TGLColor read FColorInner write SetColorInner;
605
property ColorOuter: TGLColor read FColorOuter write SetColorOuter;
606
property LifeTime: Single read FLifeTime write SetLifeTime;
607
property SizeScale: Single read FSizeScale write SetSizeScale;
609
property RotateAngle: Single read FRotateAngle write SetRotateAngle;
615
TPFXLifeColors = class(TOwnedCollection)
618
procedure SetItems(index: Integer; const val: TPFXLifeColor);
619
function GetItems(index: Integer): TPFXLifeColor;
623
constructor Create(AOwner: TPersistent);
625
function Add: TPFXLifeColor;
626
function FindItemID(ID: Integer): TPFXLifeColor;
627
property Items[index: Integer]: TPFXLifeColor read GetItems write SetItems; default;
629
function MaxLifeTime: Double;
630
function RotationsDefined: Boolean;
631
function ScalingDefined: Boolean;
632
procedure PrepareIntervalRatios;
635
// TGLLifeColoredPFXManager
637
{ Base PFX manager for particles with life colors.638
Particles have a core and edge color, for subclassing. }
639
TGLLifeColoredPFXManager = class(TGLDynamicPFXManager)
642
FLifeColors: TPFXLifeColors;
643
FLifeColorsLookup: TList;
644
FLifeRotations: Boolean;
645
FLifeScaling: Boolean;
646
FColorInner: TGLColor;
647
FColorOuter: TGLColor;
648
FParticleSize: Single;
652
procedure SetLifeColors(const val: TPFXLifeColors);
653
procedure SetColorInner(const val: TGLColor);
654
procedure SetColorOuter(const val: TGLColor);
656
procedure InitializeRendering(var rci: TGLRenderContextInfo); override;
657
procedure FinalizeRendering(var rci: TGLRenderContextInfo); override;
659
function MaxParticleAge: Single; override;
661
procedure ComputeColors(var lifeTime: Single; var inner, outer: TColorVector);
662
procedure ComputeInnerColor(var lifeTime: Single; var inner: TColorVector);
663
procedure ComputeOuterColor(var lifeTime: Single; var outer: TColorVector);
664
function ComputeSizeScale(var lifeTime: Single; var sizeScale: Single): Boolean;
665
function ComputeRotateAngle(var lifeTime, rotateAngle: Single): Boolean;
667
procedure RotateVertexBuf(buf: TAffineVectorList; lifeTime: Single;
668
const axis: TAffineVector; offsetAngle: Single);
672
constructor Create(aOwner: TComponent); override;
673
destructor Destroy; override;
675
property ParticleSize: Single read FParticleSize write FParticleSize;
676
property ColorInner: TGLColor read FColorInner write SetColorInner;
677
property ColorOuter: TGLColor read FColorOuter write SetColorOuter;
678
property LifeColors: TPFXLifeColors read FLifeColors write SetLifeColors;
682
property BlendingMode default bmAdditive;
685
TPFXDirectRenderEvent = procedure(Sender: TObject; aParticle: TGLParticle;
686
var rci: TGLRenderContextInfo) of object;
687
TPFXProgressEvent = procedure(Sender: TObject; const progressTime: TProgressTimes;
688
var defaultProgress: Boolean) of object;
689
TPFXParticleProgress = procedure(Sender: TObject; const progressTime: TProgressTimes;
690
aParticle: TGLParticle; var killParticle: Boolean) of object;
691
TPFXGetParticleCountEvent = function(Sender: TObject): Integer of object;
693
// TGLCustomPFXManager
695
{ A particles FX manager offering events for customization/experimentation.696
This manager essentially surfaces the PFX methods as events, and is best
697
suited when you have specific particles that don't fall into any existing
698
category, or when you want to experiment with particles and later plan to
699
wrap things up in a full-blown manager.
700
If the events aren't handled, nothing will be rendered. }
701
TGLCustomPFXManager = class(TGLLifeColoredPFXManager)
704
FOnInitializeRendering: TDirectRenderEvent;
705
FOnBeginParticles: TDirectRenderEvent;
706
FOnRenderParticle: TPFXDirectRenderEvent;
707
FOnEndParticles: TDirectRenderEvent;
708
FOnFinalizeRendering: TDirectRenderEvent;
709
FOnProgress: TPFXProgressEvent;
710
FOnParticleProgress: TPFXParticleProgress;
711
FOnGetParticleCountEvent: TPFXGetParticleCountEvent;
715
function TexturingMode: Cardinal; override;
716
procedure InitializeRendering(var rci: TGLRenderContextInfo); override;
717
procedure BeginParticles(var rci: TGLRenderContextInfo); override;
718
procedure RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle); override;
719
procedure EndParticles(var rci: TGLRenderContextInfo); override;
720
procedure FinalizeRendering(var rci: TGLRenderContextInfo); override;
724
procedure DoProgress(const progressTime: TProgressTimes); override;
725
function ParticleCount: Integer; override;
729
property OnInitializeRendering: TDirectRenderEvent read FOnInitializeRendering write FOnInitializeRendering;
730
property OnBeginParticles: TDirectRenderEvent read FOnBeginParticles write FOnBeginParticles;
731
property OnRenderParticle: TPFXDirectRenderEvent read FOnRenderParticle write FOnRenderParticle;
732
property OnEndParticles: TDirectRenderEvent read FOnEndParticles write FOnEndParticles;
733
property OnFinalizeRendering: TDirectRenderEvent read FOnFinalizeRendering write FOnFinalizeRendering;
734
property OnProgress: TPFXProgressEvent read FOnProgress write FOnProgress;
735
property OnParticleProgress: TPFXParticleProgress read FOnParticleProgress write FOnParticleProgress;
736
property OnGetParticleCountEvent: TPFXGetParticleCountEvent read FOnGetParticleCountEvent write FOnGetParticleCountEvent;
738
property ParticleSize;
744
// TGLPolygonPFXManager
746
{ Polygonal particles FX manager.747
The particles of this manager are made of N-face regular polygon with
748
a core and edge color. No texturing is available.
749
If you render large particles and don't have T&L acceleration, consider
750
using TGLPointLightPFXManager. }
751
TGLPolygonPFXManager = class(TGLLifeColoredPFXManager)
755
Fvx, Fvy: TAffineVector; // NOT persistent
756
FVertices: TAffineVectorList; // NOT persistent
757
FVertBuf: TAffineVectorList; // NOT persistent
761
procedure SetNbSides(const val: Integer);
763
function TexturingMode: Cardinal; override;
764
procedure InitializeRendering(var rci: TGLRenderContextInfo); override;
765
procedure BeginParticles(var rci: TGLRenderContextInfo); override;
766
procedure RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle); override;
767
procedure EndParticles(var rci: TGLRenderContextInfo); override;
768
procedure FinalizeRendering(var rci: TGLRenderContextInfo); override;
772
constructor Create(aOwner: TComponent); override;
773
destructor Destroy; override;
777
property NbSides: Integer read FNbSides write SetNbSides default 6;
779
property ParticleSize;
787
{ Sprite color modes.789
scmFade: vertex coloring is used to fade inner-outer
790
scmInner: vertex coloring uses inner color only
791
scmOuter: vertex coloring uses outer color only
792
scmNone: vertex coloring is NOT used (colors are ignored).
794
TSpriteColorMode = (scmFade, scmInner, scmOuter, scmNone);
796
// TSpritesPerTexture
798
{ Sprites per sprite texture for the SpritePFX. }799
TSpritesPerTexture = (sptOne, sptFour);
801
// TGLBaseSpritePFXManager
803
{ Base class for sprite-based particles FX managers.804
The particles are made of optionally centered single-textured quads. }
805
TGLBaseSpritePFXManager = class(TGLLifeColoredPFXManager)
808
FTexHandle: TGLTextureHandle;
809
Fvx, Fvy, Fvz: TAffineVector; // NOT persistent
810
FVertices: TAffineVectorList; // NOT persistent
811
FVertBuf: TAffineVectorList; // NOT persistent
812
FAspectRatio: Single;
814
FShareSprites: TGLBaseSpritePFXManager;
816
FSpritesPerTexture: TSpritesPerTexture;
817
FColorMode: TSpriteColorMode;
821
{ Subclasses should draw their stuff in this bmp32. }822
procedure PrepareImage(bmp32: TGLBitmap32; var texFormat: Integer); virtual; abstract;
824
procedure BindTexture(var rci: TGLRenderContextInfo);
825
procedure SetSpritesPerTexture(const val: TSpritesPerTexture); virtual;
826
procedure SetColorMode(const val: TSpriteColorMode);
827
procedure SetAspectRatio(const val: Single);
828
function StoreAspectRatio: Boolean;
829
procedure SetRotation(const val: Single);
830
procedure SetShareSprites(const val: TGLBaseSpritePFXManager);
832
function TexturingMode: Cardinal; override;
833
procedure InitializeRendering(var rci: TGLRenderContextInfo); override;
834
procedure BeginParticles(var rci: TGLRenderContextInfo); override;
835
procedure RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle); override;
836
procedure EndParticles(var rci: TGLRenderContextInfo); override;
837
procedure FinalizeRendering(var rci: TGLRenderContextInfo); override;
839
property SpritesPerTexture: TSpritesPerTexture read FSpritesPerTexture write SetSpritesPerTexture;
843
constructor Create(aOwner: TComponent); override;
844
destructor Destroy; override;
846
property ColorMode: TSpriteColorMode read FColorMode write SetColorMode;
850
{ Ratio between width and height.851
An AspectRatio of 1 (default) will result in square sprite particles,
852
values higher than one will result in horizontally stretched sprites,
853
values below one will stretch vertically (assuming no rotation is applied). }
854
property AspectRatio: Single read FAspectRatio write SetAspectRatio stored StoreAspectRatio;
855
{ Particle sprites rotation (in degrees).856
All particles of the PFX manager share this rotation. }
857
property Rotation: Single read FRotation write SetRotation;
858
{ If specified the manager will reuse the other manager's sprites.859
Sharing sprites between PFX managers can help at the rendering stage
860
if particles of the managers are mixed by helping reduce the number
861
of texture switches. Note that only the texture is shared, not the
862
colors, sizes or other dynamic parameters. }
863
property ShareSprites: TGLBaseSpritePFXManager read FShareSprites write FShareSprites;
866
// TPFXPrepareTextureImageEvent
868
TPFXPrepareTextureImageEvent = procedure(Sender: TObject; destBmp32: TGLBitmap32; var texFormat: Integer) of object;
870
// TGLPointLightPFXManager
872
{ A sprite-based particles FX managers using user-specified code to prepare the texture. }873
TGLCustomSpritePFXManager = class(TGLBaseSpritePFXManager)
876
FOnPrepareTextureImage: TPFXPrepareTextureImageEvent;
880
procedure PrepareImage(bmp32: TGLBitmap32; var texFormat: Integer); override;
884
constructor Create(aOwner: TComponent); override;
885
destructor Destroy; override;
889
{ Place your texture rendering code in this event. }890
property OnPrepareTextureImage: TPFXPrepareTextureImageEvent read FOnPrepareTextureImage write FOnPrepareTextureImage;
892
property ColorMode default scmInner;
893
property SpritesPerTexture default sptOne;
894
property ParticleSize;
900
// TGLPointLightPFXManager
902
{ A sprite-based particles FX managers using point light maps.903
The texture map is a round, distance-based transparency map (center "opaque"),
904
you can adjust the quality (size) of the underlying texture map with the
906
This PFX manager renders particles similar to what you can get with
907
TGLPolygonPFXManager but stresses fillrate more than T&L rate (and will
908
usually be slower than the PolygonPFX when nbSides is low or T&L acceleration
909
available). Consider this implementation as a sample for your own PFX managers
910
that may use particles with more complex textures. }
911
TGLPointLightPFXManager = class(TGLBaseSpritePFXManager)
914
FTexMapSize: Integer;
918
procedure PrepareImage(bmp32: TGLBitmap32; var texFormat: Integer); override;
920
procedure SetTexMapSize(const val: Integer);
924
constructor Create(aOwner: TComponent); override;
925
destructor Destroy; override;
929
{ Underlying texture map size, as a power of two.930
Min value is 3 (size=8), max value is 9 (size=512). }
931
property TexMapSize: Integer read FTexMapSize write SetTexMapSize default 5;
933
property ColorMode default scmInner;
934
property ParticleSize;
940
{ Returns or creates the TGLBInertia within the given object's behaviours. }941
function GetOrCreateSourcePFX(obj: TGLBaseSceneObject; const name: string = ''): TGLSourcePFXEffect;
943
// ------------------------------------------------------------------
944
// ------------------------------------------------------------------
945
// ------------------------------------------------------------------
947
// ------------------------------------------------------------------
948
// ------------------------------------------------------------------
949
// ------------------------------------------------------------------
951
// GetOrCreateSourcePFX
954
function GetOrCreateSourcePFX(obj: TGLBaseSceneObject; const name: string = ''): TGLSourcePFXEffect;
962
i := IndexOfClass(TGLSourcePFXEffect);
964
Result := TGLSourcePFXEffect(Items[i])
966
Result := TGLSourcePFXEffect.Create(obj.Effects);
970
i := IndexOfName(name);
972
Result := (Items[i] as TGLSourcePFXEffect)
975
Result := TGLSourcePFXEffect.Create(obj.Effects);
983
// ------------------ TGLParticle ------------------
988
constructor TGLParticle.Create;
996
destructor TGLParticle.Destroy;
1001
function TGLParticle.GetPosition(const Index: Integer): Single;
1003
Result := FPosition.V[Index];
1006
procedure TGLParticle.WritePosition(const Index: Integer; const aValue: Single);
1008
if (aValue <> FPosition.V[Index]) then
1009
FPosition.V[Index] := aValue;
1012
function TGLParticle.GetVelocity(const Index: Integer): Single;
1014
Result := FVelocity.V[0];
1017
procedure TGLParticle.WriteVelocity(const Index: Integer; const aValue: Single);
1019
if (aValue <> FVelocity.V[Index]) then
1020
FVelocity.V[Index] := aValue;
1025
procedure TGLParticle.WriteToFiler(writer: TVirtualWriter);
1027
inherited WriteToFiler(writer);
1030
WriteInteger(0); // Archive Version 0
1032
Write(FPosition, SizeOf(FPosition));
1033
Write(FVelocity, SizeOf(FVelocity));
1034
WriteFloat(FCreationTime);
1042
procedure TGLParticle.ReadFromFiler(reader: TVirtualReader);
1044
archiveVersion: integer;
1046
inherited ReadFromFiler(reader);
1047
archiveVersion := reader.ReadInteger;
1048
if archiveVersion = 0 then
1052
Read(FPosition, SizeOf(FPosition));
1053
Read(FVelocity, SizeOf(FVelocity));
1054
FCreationTime := ReadFloat;
1057
RaiseFilerException(archiveVersion);
1060
// ------------------
1061
// ------------------ TGLParticleList ------------------
1062
// ------------------
1067
constructor TGLParticleList.Create;
1070
FItemList := TPersistentObjectList.Create;
1071
FitemList.GrowthDelta := 64;
1078
destructor TGLParticleList.Destroy;
1080
FItemList.CleanFree;
1087
procedure TGLParticleList.WriteToFiler(writer: TVirtualWriter);
1089
inherited WriteToFiler(writer);
1092
WriteInteger(0); // Archive Version 0
1093
FItemList.WriteToFiler(writer);
1100
procedure TGLParticleList.ReadFromFiler(reader: TVirtualReader);
1102
archiveVersion: integer;
1104
inherited ReadFromFiler(reader);
1105
archiveVersion := reader.ReadInteger;
1106
if archiveVersion = 0 then
1109
FItemList.ReadFromFilerWithEvent(reader, AfterItemCreated);
1110
FDirectList := PGLParticleArray(FItemList.List);
1113
RaiseFilerException(archiveVersion);
1119
function TGLParticleList.GetItems(index: Integer): TGLParticle;
1121
Result := TGLParticle(FItemList[index]);
1127
procedure TGLParticleList.SetItems(index: Integer; val: TGLParticle);
1129
FItemList[index] := val;
1135
procedure TGLParticleList.AfterItemCreated(Sender: TObject);
1137
(Sender as TGLParticle).Manager := Self.Owner;
1143
function TGLParticleList.ItemCount: Integer;
1145
Result := FItemList.Count;
1151
function TGLParticleList.AddItem(aItem: TGLParticle): Integer;
1153
aItem.Manager := Self.Owner;
1154
Result := FItemList.Add(aItem);
1155
FDirectList := PGLParticleArray(FItemList.List);
1161
procedure TGLParticleList.RemoveAndFreeItem(aItem: TGLParticle);
1165
i := FItemList.IndexOf(aItem);
1168
if aItem.Manager = Self.Owner then
1169
aItem.Manager := nil;
1171
FItemList.List^[i] := nil;
1178
function TGLParticleList.IndexOfItem(aItem: TGLParticle): Integer;
1180
Result := FItemList.IndexOf(aItem);
1186
procedure TGLParticleList.Pack;
1189
FDirectList := PGLParticleArray(FItemList.List);
1192
// ------------------
1193
// ------------------ TGLParticleFXManager ------------------
1194
// ------------------
1199
constructor TGLParticleFXManager.Create(aOwner: TComponent);
1202
FUsers := TList.create;
1203
FParticles := TGLParticleList.Create;
1204
FParticles.Owner := Self;
1205
FBlendingMode := bmAdditive;
1206
RegisterManager(Self);
1212
destructor TGLParticleFXManager.Destroy;
1217
for i := FUsers.Count - 1 downto 0 do
1218
TGLParticleFXEffect(FUsers[i]).managerNotification(self, opRemove);
1219
DeRegisterManager(Self);
1228
procedure TGLParticleFXManager.NotifyChange(Sender: TObject);
1230
if Assigned(FRenderer) then
1231
Renderer.StructureChanged;
1237
procedure TGLParticleFXManager.DoProgress(const progressTime: TProgressTimes);
1240
if FAutoFreeWhenEmpty and (FParticles.ItemCount = 0) then
1247
class function TGLParticleFXManager.ParticlesClass: TGLParticleClass;
1249
Result := TGLParticle;
1255
function TGLParticleFXManager.CreateParticle: TGLParticle;
1257
Result := ParticlesClass.Create;
1258
Result.FID := FNextID;
1259
if Assigned(cadencer) then
1260
Result.FCreationTime := Cadencer.CurrentTime;
1262
FParticles.AddItem(Result);
1263
if Assigned(FOnCreateParticle) then
1264
FOnCreateParticle(Self, Result);
1270
procedure TGLParticleFXManager.CreateParticles(nbParticles: Integer);
1274
FParticles.FItemList.RequiredCapacity(FParticles.ItemCount + nbParticles);
1275
for i := 1 to nbParticles do
1282
procedure TGLParticleFXManager.SetRenderer(const val: TGLParticleFXRenderer);
1284
if FRenderer <> val then
1286
if Assigned(FRenderer) then
1287
FRenderer.UnRegisterManager(Self);
1289
if Assigned(FRenderer) then
1290
FRenderer.RegisterManager(Self);
1297
procedure TGLParticleFXManager.SetParticles(const aParticles: TGLParticleList);
1299
FParticles.Assign(aParticles);
1305
function TGLParticleFXManager.ParticleCount: Integer;
1307
Result := FParticles.FItemList.Count;
1313
procedure TGLParticleFXManager.ApplyBlendingMode;
1315
if Renderer.BlendingMode <> BlendingMode then
1317
// case disjunction to minimize OpenGL State changes
1318
if Renderer.BlendingMode in [bmAdditive, bmTransparency] then
1320
case BlendingMode of
1322
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
1324
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1326
rci.GLStates.Disable(stBlend);
1331
case BlendingMode of
1334
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
1335
rci.GLStates.Enable(stBlend);
1339
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1340
rci.GLStates.Enable(stBlend);
1343
// bmOpaque, do nothing
1352
procedure TGLParticleFXManager.UnapplyBlendingMode;
1354
if Renderer.BlendingMode <> BlendingMode then
1356
// case disjunction to minimize OpenGL State changes
1357
if BlendingMode in [bmAdditive, bmTransparency] then
1359
case Renderer.BlendingMode of
1361
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
1363
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1365
rci.GLStates.Disable(stBlend);
1370
case Renderer.BlendingMode of
1373
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
1374
rci.GLStates.Enable(stBlend);
1378
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1379
rci.GLStates.Enable(stBlend);
1382
// bmOpaque, do nothing
1391
procedure TGLParticleFXManager.registerUser(obj: TGLParticleFXEffect);
1393
if FUsers.IndexOf(obj) = -1 then
1400
procedure TGLParticleFXManager.unregisterUser(obj: TGLParticleFXEffect);
1405
// ------------------
1406
// ------------------ TGLParticleFXEffect ------------------
1407
// ------------------
1412
constructor TGLParticleFXEffect.Create(aOwner: TGLXCollection);
1421
destructor TGLParticleFXEffect.Destroy;
1430
procedure TGLParticleFXEffect.WriteToFiler(writer: TWriter);
1436
// ArchiveVersion 1, added EffectScale
1437
// ArchiveVersion 2, added inherited call
1440
if Manager <> nil then
1441
st := Manager.GetNamePath
1445
WriteFloat(FEffectScale);
1452
procedure TGLParticleFXEffect.ReadFromFiler(reader: TReader);
1454
archiveVersion: integer;
1458
archiveVersion := ReadInteger;
1459
Assert(archiveVersion in [0..2]);
1460
if archiveVersion >= 2 then
1462
if archiveVersion >= 0 then
1464
FManagerName := ReadString;
1467
if archiveVersion >= 1 then
1469
FEffectScale := ReadFloat;
1477
procedure TGLParticleFXEffect.Loaded;
1482
if FManagerName <> '' then
1484
mng := FindManager(TGLParticleFXManager, FManagerName);
1485
if Assigned(mng) then
1486
Manager := TGLParticleFXManager(mng);
1494
procedure TGLParticleFXEffect.SetManager(val: TGLParticleFXManager);
1496
if assigned(FManager) then
1497
FManager.unregisterUser(self);
1499
if assigned(FManager) then
1500
FManager.registerUser(self);
1503
procedure TGLParticleFXEffect.SetEffectScale(const Value: single);
1505
FEffectScale := Value;
1508
// managerNotification
1511
procedure TGLParticleFXEffect.managerNotification(
1512
aManager: TGLParticleFXManager; Operation: TOperation);
1514
if (Operation = opRemove) and (aManager = manager) then
1518
// ------------------
1519
// ------------------ TGLParticleFXRenderer ------------------
1520
// ------------------
1525
constructor TGLParticleFXRenderer.Create(aOwner: TComponent);
1528
ObjectStyle := ObjectStyle + [osNoVisibilityCulling, osDirectDraw];
1531
FZSortAccuracy := saHigh;
1532
FManagerList := TList.Create;
1533
FBlendingMode := bmAdditive;
1539
destructor TGLParticleFXRenderer.Destroy;
1543
for i := 0 to cPFXNbRegions - 1 do
1545
FreeMem(FRegions[i].particleRef);
1546
FreeMem(FRegions[i].particleOrder);
1557
procedure TGLParticleFXRenderer.RegisterManager(aManager: TGLParticleFXManager);
1559
FManagerList.Add(aManager);
1565
procedure TGLParticleFXRenderer.UnRegisterManager(aManager: TGLParticleFXManager);
1567
FManagerList.Remove(aManager);
1573
procedure TGLParticleFXRenderer.UnRegisterAll;
1575
while FManagerList.Count > 0 do
1576
TGLParticleFXManager(FManagerList[FManagerList.Count - 1]).Renderer := nil;
1581
// (beware, large and complex stuff below... this is the heart of the ParticleFX)
1583
procedure TGLParticleFXRenderer.BuildList(var rci: TGLRenderContextInfo);
1585
Quick Explanation of what is below:
1587
The purpose is to depth-sort a large number (thousandths) of particles and
1588
render them back to front. The rendering part is not particularly complex,
1589
it just invokes the various PFX managers involved and request particle
1591
The sort uses a first-pass region partition (the depth range is split into
1592
regions, and particles are assigned directly to the region they belong to),
1593
then each region is sorted with a QuickSort.
1594
The QuickSort itself is the regular classic variant, but the comparison is
1595
made on singles as if they were integers, this is allowed by the IEEE format
1596
in a very efficient manner if all values are superior to 1, which is ensured
1597
by the distance calculation and a fixed offset of 1.
1600
dist, distDelta, invRegionSize: Single;
1601
managerIdx, particleIdx, regionIdx: Integer;
1603
procedure QuickSortRegion(startIndex, endIndex: Integer; region: PPFXRegion);
1607
poptr: PPointerArray;
1610
if endIndex - startIndex > 1 then
1612
poptr := @region^.particleOrder^[0];
1616
P := PParticleReference(poptr^[(I + J) shr 1])^.distance;
1618
while PParticleReference(poptr^[I])^.distance < P do
1620
while PParticleReference(poptr^[J])^.distance > P do
1625
poptr^[I] := poptr^[J];
1631
if startIndex < J then
1632
QuickSortRegion(startIndex, J, region);
1634
until I >= endIndex;
1636
else if endIndex - startIndex > 0 then
1638
poptr := @region^.particleOrder^[0];
1639
if PParticleReference(poptr^[endIndex])^.distance < PParticleReference(poptr^[startIndex])^.distance then
1641
buf := poptr^[startIndex];
1642
poptr^[startIndex] := poptr^[endIndex];
1643
poptr^[endIndex] := buf;
1648
procedure DistToRegionIdx; register;
1650
regionIdx := Trunc((dist - distDelta) * invRegionSize);
1654
minDist, maxDist, sortMaxRegion: Integer;
1655
curManager: TGLParticleFXManager;
1656
curList: PGLParticleArray;
1657
curParticle: TGLParticle;
1658
curRegion: PPFXRegion;
1659
curParticleOrder: PPointerArray;
1660
cameraPos, cameraVector: TAffineVector;
1662
currentTexturingMode: Cardinal;
1664
if csDesigning in ComponentState then Exit;
1667
timer := StartPrecisionTimer;
1669
PSingle(@minDist)^ := rci.rcci.nearClippingDistance + 1;
1670
if ZMaxDistance <= 0 then
1672
PSingle(@maxDist)^ := rci.rcci.farClippingDistance + 1;
1673
invRegionSize := (cPFXNbRegions - 2) / (rci.rcci.farClippingDistance - rci.rcci.nearClippingDistance);
1677
PSingle(@maxDist)^ := rci.rcci.nearClippingDistance + ZMaxDistance + 1;
1678
invRegionSize := (cPFXNbRegions - 2) / ZMaxDistance;
1680
distDelta := rci.rcci.nearClippingDistance + 1 + 0.49999 / invRegionSize;
1682
SetVector(cameraPos, rci.cameraPosition);
1683
SetVector(cameraVector, rci.cameraDirection);
1685
// Collect particles
1686
// only depth-clipping performed as of now.
1687
FLastParticleCount := 0;
1688
for managerIdx := 0 to FManagerList.Count - 1 do
1690
curManager := TGLParticleFXManager(FManagerList[managerIdx]);
1691
curList := curManager.FParticles.List;
1692
Inc(FLastParticleCount, curManager.ParticleCount);
1693
for particleIdx := 0 to curManager.ParticleCount - 1 do
1695
curParticle := curList^[particleIdx];
1696
dist := PointProject(curParticle.FPosition, cameraPos, cameraVector) + 1;
1699
if PInteger(@dist)^ < minDist then
1700
PInteger(@dist)^ := minDist;
1702
if (PInteger(@dist)^ >= minDist) and (PInteger(@dist)^ <= maxDist) then
1705
curRegion := @FRegions[regionIdx];
1706
// add particle to region
1707
if curRegion^.count = curRegion^.capacity then
1709
Inc(curRegion^.capacity, cPFXGranularity);
1710
ReallocMem(curRegion^.particleRef, curRegion^.capacity * SizeOf(TParticleReference));
1711
ReallocMem(curRegion^.particleOrder, curRegion^.capacity * SizeOf(Pointer));
1713
with curRegion^.particleRef^[curRegion^.count] do
1715
particle := curParticle;
1716
distance := PInteger(@dist)^;
1718
Inc(curRegion^.count);
1723
case ZSortAccuracy of
1724
saLow: sortMaxRegion := 0;
1725
saOneTenth: sortMaxRegion := cPFXNbRegions div 10;
1726
saOneThird: sortMaxRegion := cPFXNbRegions div 3;
1727
saOneHalf: sortMaxRegion := cPFXNbRegions div 2;
1729
sortMaxRegion := cPFXNbRegions;
1731
for regionIdx := 0 to cPFXNbRegions - 1 do
1733
curRegion := @FRegions[regionIdx];
1734
if curRegion^.count > 1 then
1736
// Prepare order table
1738
for particleIdx := 0 to count - 1 do
1739
particleOrder^[particleIdx] := @particleRef[particleIdx];
1741
if (regionIdx < sortMaxRegion) and (FBlendingMode <> bmAdditive) then
1742
QuickSortRegion(0, curRegion^.count - 1, curRegion);
1744
else if curRegion^.Count = 1 then
1746
// Prepare order table
1747
curRegion^.particleOrder^[0] := @curRegion^.particleRef[0];
1750
FLastSortTime := StopPrecisionTimer(timer) * 1000;
1752
rci.PipelineTransformation.Push;
1753
rci.PipelineTransformation.ModelMatrix := IdentityHmgMatrix;
1755
rci.GLStates.Disable(stCullFace);
1756
rci.GLStates.ActiveTextureEnabled[ttTexture2D] := True;
1757
currentTexturingMode := 0;
1758
rci.GLStates.Disable(stLighting);
1759
rci.GLStates.PolygonMode := pmFill;
1761
case FBlendingMode of
1764
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOne);
1765
rci.GLStates.Enable(stBlend);
1769
rci.GLStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1770
rci.GLStates.Enable(stBlend);
1773
// bmOpaque, do nothing
1775
rci.GLStates.DepthFunc := cfLEqual;
1778
rci.GLStates.DepthWriteMask := False;
1781
rci.GLStates.Disable(stDepthTest);
1784
// Initialize managers
1785
for managerIdx := 0 to FManagerList.Count - 1 do
1786
TGLParticleFXManager(FManagerList.Items[managerIdx]).InitializeRendering(rci);
1787
// Start Rendering... at last ;)
1790
for regionIdx := cPFXNbRegions - 1 downto 0 do
1792
curRegion := @FRegions[regionIdx];
1793
if curRegion^.count > 0 then
1795
curParticleOrder := @curRegion^.particleOrder^[0];
1796
for particleIdx := curRegion^.count - 1 downto 0 do
1798
curParticle := PParticleReference(curParticleOrder^[particleIdx])^.particle;
1799
if curParticle.Manager <> curManager then
1801
if Assigned(curManager) then
1802
curManager.EndParticles(rci);
1803
curManager := curParticle.Manager;
1804
if curManager.TexturingMode <> currentTexturingMode then
1806
if currentTexturingMode <> 0 then
1807
GL.Disable(currentTexturingMode);
1808
currentTexturingMode := curManager.TexturingMode;
1809
if currentTexturingMode <> 0 then
1810
GL.Enable(currentTexturingMode);
1812
curManager.BeginParticles(rci);
1814
curManager.RenderParticle(rci, curParticle);
1818
if Assigned(curManager) then
1819
curManager.EndParticles(rci);
1821
// Finalize managers
1822
for managerIdx := 0 to FManagerList.Count - 1 do
1823
TGLParticleFXManager(FManagerList.Items[managerIdx]).FinalizeRendering(rci);
1826
rci.PipelineTransformation.Pop;
1828
rci.GLStates.ActiveTextureEnabled[ttTexture2D] := False;
1829
rci.GLStates.DepthWriteMask := True;
1832
for regionIdx := cPFXNbRegions - 1 downto 0 do
1833
FRegions[regionIdx].count := 0;
1840
function TGLParticleFXRenderer.StoreZMaxDistance: Boolean;
1842
Result := (FZMaxDistance <> 0);
1845
// ------------------
1846
// ------------------ TGLSourcePFXEffect ------------------
1847
// ------------------
1852
constructor TGLSourcePFXEffect.Create(aOwner: TGLXCollection);
1855
FInitialVelocity := TGLCoordinates.CreateInitialized(Self, NullHmgVector, csVector);
1856
FInitialPosition := TGLCoordinates.CreateInitialized(Self, NullHmgVector, csPoint);
1857
FPositionDispersionRange := TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csPoint);
1858
FVelocityDispersion := 0;
1859
FPositionDispersion := 0;
1860
FParticleInterval := 0.1;
1861
FVelocityMode := svmAbsolute;
1862
FPositionMode := spmAbsoluteOffset;
1863
FDispersionMode := sdmFast;
1865
FDisabledIfOwnerInvisible := False;
1866
FSeed := 2389;//GetTickCount64;
1870
destructor TGLSourcePFXEffect.Destroy;
1872
FPositionDispersionRange.Free;
1873
FInitialVelocity.Free;
1874
FInitialPosition.Free;
1878
class function TGLSourcePFXEffect.FriendlyName: string;
1880
Result := 'PFX Source';
1883
class function TGLSourcePFXEffect.FriendlyDescription: string;
1885
Result := 'Simple Particles FX Source';
1888
procedure TGLSourcePFXEffect.WriteToFiler(writer: TWriter);
1893
WriteInteger(6); // ArchiveVersion 6, added FPositionMode
1894
// ArchiveVersion 5, added FDisabledIfOwnerInvisible:
1895
// ArchiveVersion 4, added FRotationDispersion
1896
// ArchiveVersion 3, added FEnabled
1897
// ArchiveVersion 2, added FPositionDispersionRange
1898
// ArchiveVersion 1, added FDispersionMode
1899
FInitialVelocity.WriteToFiler(writer);
1900
FInitialPosition.WriteToFiler(writer);
1901
FPositionDispersionRange.WriteToFiler(writer);
1902
WriteFloat(FVelocityDispersion);
1903
WriteFloat(FPositionDispersion);
1904
WriteFloat(FParticleInterval);
1905
WriteInteger(Integer(FVelocityMode));
1906
WriteInteger(Integer(FDispersionMode));
1907
WriteBoolean(FEnabled);
1908
WriteFloat(FRotationDispersion);
1909
WriteBoolean(FDisabledIfOwnerInvisible);
1910
WriteInteger(Integer(FPositionMode));
1914
procedure TGLSourcePFXEffect.ReadFromFiler(reader: TReader);
1916
archiveVersion: Integer;
1921
archiveVersion := ReadInteger;
1922
Assert(archiveVersion in [0..6]);
1923
FInitialVelocity.ReadFromFiler(reader);
1924
FInitialPosition.ReadFromFiler(reader);
1925
if archiveVersion >= 2 then
1926
FPositionDispersionRange.ReadFromFiler(reader);
1927
FVelocityDispersion := ReadFloat;
1928
FPositionDispersion := ReadFloat;
1929
FParticleInterval := ReadFloat;
1930
FVelocityMode := TGLSourcePFXVelocityMode(ReadInteger);
1931
if archiveVersion >= 1 then
1932
FDispersionMode := TGLSourcePFXDispersionMode(ReadInteger);
1933
if archiveVersion >= 3 then
1934
FEnabled := ReadBoolean;
1935
if archiveVersion >= 4 then
1936
FRotationDispersion := ReadFloat;
1937
if archiveVersion >= 5 then
1938
FDisabledIfOwnerInvisible := ReadBoolean;
1939
if archiveVersion >= 6 then
1940
FPositionMode := TGLSourcePFXPositionMode(ReadInteger);
1944
Procedure TGLSourcePFXEffect.SetSeed(aValue: Integer);
1950
procedure TGLSourcePFXEffect.RndVector(const dispersion: TGLSourcePFXDispersionMode; var v: TAffineVector; var f: Single;dispersionRange: TGLCoordinates);
1957
OldSeed := RandSeed;
1960
if Assigned(dispersionRange) then
1961
p := VectorScale(dispersionRange.DirectVector, f2)
1963
p := VectorScale(XYZHmgVector, f2);
1967
v.V[0] := (GLS_RNG.Random - 0.5) * p.V[0];
1968
v.V[1] := (GLS_RNG.Random - 0.5) * p.V[1];
1969
v.V[2] := (GLS_RNG.Random - 0.5) * p.V[2];
1974
v.V[0] := (GLS_RNG.Random - 0.5);
1975
v.V[1] := (GLS_RNG.Random - 0.5);
1976
v.V[2] := (GLS_RNG.Random - 0.5);
1977
until VectorNorm(v) <= fsq;
1978
v.V[0] := v.V[0] * p.V[0];
1979
v.V[1] := v.V[1] * p.V[1];
1980
v.V[2] := v.V[2] * p.V[2];
1984
procedure TGLSourcePFXEffect.SetInitialVelocity(const val: TGLCoordinates);
1986
FInitialVelocity.Assign(val);
1989
// SetInitialPosition
1992
procedure TGLSourcePFXEffect.SetInitialPosition(const val: TGLCoordinates);
1994
FInitialPosition.Assign(val);
1997
// SetPositionDispersionRange
2000
procedure TGLSourcePFXEffect.SetPositionDispersionRange(const val: TGLCoordinates);
2002
FPositionDispersionRange.Assign(val);
2005
// SetParticleInterval
2008
procedure TGLSourcePFXEffect.SetParticleInterval(const val: Single);
2010
if FParticleInterval <> val then
2012
FParticleInterval := val;
2013
if FParticleInterval < 0 then
2014
FParticleInterval := 0;
2015
if FTimeRemainder > FParticleInterval then
2016
FTimeRemainder := FParticleInterval;
2023
procedure TGLSourcePFXEffect.DoProgress(const progressTime: TProgressTimes);
2027
if Enabled and Assigned(Manager) and (ParticleInterval > 0) then
2029
if OwnerBaseSceneObject.Visible or (not DisabledIfOwnerInvisible) then
2031
FTimeRemainder := FTimeRemainder + progressTime.deltaTime;
2032
if FTimeRemainder > FParticleInterval then
2034
n := Trunc((FTimeRemainder - FParticleInterval) / FParticleInterval);
2035
Burst(progressTime.newTime, n);
2036
FTimeRemainder := FTimeRemainder - n * FParticleInterval;
2042
// ParticleAbsoluteInitialPos
2045
function TGLSourcePFXEffect.ParticleAbsoluteInitialPos: TAffineVector;
2047
if PositionMode = spmRelative then
2049
Result := OwnerBaseSceneObject.LocalToAbsolute(InitialPosition.AsAffineVector);
2053
SetVector(Result, OwnerBaseSceneObject.AbsolutePosition);
2054
AddVector(Result, InitialPosition.AsAffineVector);
2061
procedure TGLSourcePFXEffect.Burst(time: Double; nb: Integer);
2064
particle: TGLParticle;
2065
av, pos: TAffineVector;
2066
OwnerObjRelPos: TAffineVector;
2069
if Manager = nil then Exit;
2070
OldSeed := RandSeed;
2073
OwnerObjRelPos := OwnerBaseSceneObject.LocalToAbsolute(NullVector);
2074
pos := ParticleAbsoluteInitialPos;
2076
// if FManager is TGLDynamicPFXManager then
2077
// TGLDynamicPFXManager(FManager).FRotationCenter := pos;
2081
particle := Manager.CreateParticle;
2082
particle.FEffectScale := FEffectScale;
2083
RndVector(DispersionMode, av, FPositionDispersion, FPositionDispersionRange);
2084
if VelocityMode = svmRelative then
2085
av := VectorSubtract(OwnerBaseSceneObject.LocalToAbsolute(av), OwnerObjRelPos);
2087
ScaleVector(av, FEffectScale);
2088
VectorAdd(pos, av, @particle.Position);
2090
RndVector(DispersionMode, av, FVelocityDispersion, nil);
2091
VectorAdd(InitialVelocity.AsAffineVector, av, @particle.Velocity);
2093
particle.Velocity := VectorScale(particle.Velocity, FEffectScale);
2094
if VelocityMode = svmRelative then
2095
particle.FVelocity := VectorSubtract(OwnerBaseSceneObject.LocalToAbsolute(particle.FVelocity), OwnerObjRelPos);
2097
particle.CreationTime := time;
2098
if FRotationDispersion <> 0 then
2100
particle.FRotation := GLS_RNG.Random * FRotationDispersion
2103
particle.FRotation := 0;
2111
procedure TGLSourcePFXEffect.RingExplosion(time: Double;
2112
minInitialSpeed, maxInitialSpeed: Single;
2113
nbParticles: Integer);
2115
particle: TGLParticle;
2116
av, pos, tmp: TAffineVector;
2117
ringVectorX, ringVectorY: TAffineVector;
2121
if (Manager = nil) or (nbParticles <= 0) then Exit;
2122
OldSeed := RandSeed;
2124
pos := ParticleAbsoluteInitialPos;
2125
SetVector(ringVectorY, OwnerBaseSceneObject.AbsoluteUp);
2126
SetVector(ringVectorX, OwnerBaseSceneObject.AbsoluteDirection);
2127
ringVectorY := VectorCrossProduct(ringVectorX, ringVectorY);
2128
while (nbParticles > 0) do
2130
// okay, ain't exactly an "isotropic" ring...
2131
fx := GLS_RNG.Random - 0.5;
2132
fy := GLS_RNG.Random - 0.5;
2133
d := RLength(fx, fy);
2134
tmp := VectorCombine(ringVectorX, ringVectorY, fx * d, fy * d);
2135
ScaleVector(tmp, minInitialSpeed + GLS_RNG.Random * (maxInitialSpeed - minInitialSpeed));
2136
AddVector(tmp, InitialVelocity.AsVector);
2137
particle := Manager.CreateParticle;
2140
RndVector(DispersionMode, av, FPositionDispersion, FPositionDispersionRange);
2141
VectorAdd(pos, av, @Position);
2142
RndVector(DispersionMode, av, FVelocityDispersion, nil);
2143
VectorAdd(tmp, av, @Velocity);
2144
if VelocityMode = svmRelative then
2145
Velocity := OwnerBaseSceneObject.LocalToAbsolute(Velocity);
2146
particle.CreationTime := time;
2152
// ------------------
2153
// ------------------ TPFXLifeColor ------------------
2154
// ------------------
2159
constructor TPFXLifeColor.Create(Collection: TCollection);
2161
inherited Create(Collection);
2162
FColorInner := TGLColor.CreateInitialized(Self, NullHmgVector);
2163
FColorOuter := TGLColor.CreateInitialized(Self, NullHmgVector);
2173
destructor TPFXLifeColor.Destroy;
2183
procedure TPFXLifeColor.Assign(Source: TPersistent);
2185
if Source is TPFXLifeColor then
2187
FColorInner.Assign(TPFXLifeColor(Source).ColorInner);
2188
FColorOuter.Assign(TPFXLifeColor(Source).ColorOuter);
2189
FLifeTime := TPFXLifeColor(Source).LifeTime;
2190
FRotateAngle := TPFXLifeColor(Source).RotateAngle;
2199
function TPFXLifeColor.GetDisplayName: string;
2201
Result := Format('LifeTime %f - Inner [%.2f, %.2f, %.2f, %.2f] - Outer [%.2f, %.2f, %.2f, %.2f]',2203
ColorInner.Red, ColorInner.Green, ColorInner.Blue, ColorInner.Alpha,
2204
ColorOuter.Red, ColorOuter.Green, ColorOuter.Blue, ColorOuter.Alpha]);
2210
procedure TPFXLifeColor.SetColorInner(const val: TGLColor);
2212
FColorInner.Assign(val);
2218
procedure TPFXLifeColor.SetColorOuter(const val: TGLColor);
2220
FColorOuter.Assign(val);
2226
procedure TPFXLifeColor.SetLifeTime(const val: Single);
2228
if FLifeTime <> val then
2231
if FLifeTime <= 0 then
2233
FInvLifeTime := 1 / FLifeTime;
2240
procedure TPFXLifeColor.SetSizeScale(const val: Single);
2242
if FSizeScale <> val then
2245
FDoScale := (FSizeScale <> 1);
2249
procedure TPFXLifeColor.SetRotateAngle(const Value: Single);
2251
if FRotateAngle <> Value then
2253
FRotateAngle := Value;
2254
FDoRotate := (FRotateAngle <> 0);
2258
// ------------------
2259
// ------------------ TPFXLifeColors ------------------
2260
// ------------------
2262
constructor TPFXLifeColors.Create(AOwner: TPersistent);
2264
inherited Create(AOwner, TPFXLifeColor);
2267
procedure TPFXLifeColors.SetItems(index: Integer; const val: TPFXLifeColor);
2269
inherited Items[index] := val;
2272
function TPFXLifeColors.GetItems(index: Integer): TPFXLifeColor;
2274
Result := TPFXLifeColor(inherited Items[index]);
2277
function TPFXLifeColors.Add: TPFXLifeColor;
2279
Result := (inherited Add) as TPFXLifeColor;
2285
function TPFXLifeColors.FindItemID(ID: Integer): TPFXLifeColor;
2287
Result := (inherited FindItemID(ID)) as TPFXLifeColor;
2293
function TPFXLifeColors.MaxLifeTime: Double;
2296
Result := Items[Count - 1].LifeTime
2304
function TPFXLifeColors.RotationsDefined: Boolean;
2308
for i := 0 to Count - 1 do
2310
if Items[i].RotateAngle <> 0 then
2322
function TPFXLifeColors.ScalingDefined: Boolean;
2326
for i := 0 to Count - 1 do
2328
if Items[i].SizeScale <> 1 then
2337
// PrepareIntervalRatios
2340
procedure TPFXLifeColors.PrepareIntervalRatios;
2344
for i := 0 to Count - 2 do
2345
Items[i].FIntervalRatio := 1 / (Items[i + 1].LifeTime - Items[i].LifeTime);
2348
// ------------------
2349
// ------------------ TGLDynamicPFXManager ------------------
2350
// ------------------
2355
constructor TGLDynamicPFXManager.Create(aOwner: TComponent);
2358
FAcceleration := TGLCoordinates.CreateInitialized(Self, NullHmgVector, csVector);
2365
destructor TGLDynamicPFXManager.Destroy;
2374
procedure TGLDynamicPFXManager.DoProgress(const progressTime: TProgressTimes);
2377
curParticle: TGLParticle;
2379
{pos, pos1, axis,}accelVector: TAffineVector;2381
list: PGLParticleArray;
2382
doFriction, doPack: Boolean;
2383
frictionScale: Single;
2386
maxAge := MaxParticleAge;
2387
accelVector := Acceleration.AsAffineVector;
2388
dt := progressTime.deltaTime;
2389
doFriction := (FFriction <> 1);
2392
frictionScale := Power(FFriction, dt)
2396
FCurrentTime := progressTime.newTime;
2399
list := Particles.List;
2400
for i := 0 to Particles.ItemCount - 1 do
2402
curParticle := list^[i];
2403
if (progressTime.newTime - curParticle.CreationTime) < maxAge then
2405
// particle alive, just update velocity and position
2408
CombineVector(FPosition, FVelocity, dt);
2410
// DanB - this doesn't seem to fit here, rotation is already
2411
// calculated when rendering
2412
{if (FRotation <> 0) and (Renderer <> nil) then begin2416
CombineVector(pos1, FVelocity, ff);
2418
SetVector(axis, Renderer.Scene.CurrentGLCamera.AbsolutePosition);
2419
SetVector(axis, VectorSubtract(axis, FRotationCenter));
2420
NormalizeVector(axis);
2421
MakeVector(pos4, pos1);
2422
pos4[0] := pos4[0] - FRotationCenter[0];
2423
pos4[1] := pos4[1] - FRotationCenter[1];
2424
pos4[2] := pos4[2] - FRotationCenter[2];
2425
RotateVector(pos4, axis, FRotation * dt);
2426
pos4[0] := pos4[0] + FRotationCenter[0];
2427
pos4[1] := pos4[1] + FRotationCenter[1];
2428
pos4[2] := pos4[2] + FRotationCenter[2];
2429
MakeVector(pos1, pos4[0], pos4[1], pos4[2]);
2431
FVelocity := VectorSubtract(pos1, pos);
2432
CombineVector(FPosition, FVelocity, dt);
2435
CombineVector(FVelocity, accelVector, dt);
2437
ScaleVector(FVelocity, frictionScale);
2455
procedure TGLDynamicPFXManager.SetAcceleration(const val: TGLCoordinates);
2457
FAcceleration.Assign(val);
2460
// ------------------
2461
// ------------------ TGLLifeColoredPFXManager ------------------
2462
// ------------------
2467
constructor TGLLifeColoredPFXManager.Create(aOwner: TComponent);
2470
FLifeColors := TPFXLifeColors.Create(Self);
2471
FColorInner := TGLColor.CreateInitialized(Self, clrYellow);
2472
FColorOuter := TGLColor.CreateInitialized(Self, NullHmgVector);
2473
with FLifeColors.Add do
2483
destructor TGLLifeColoredPFXManager.Destroy;
2494
procedure TGLLifeColoredPFXManager.SetColorInner(const val: TGLColor);
2496
FColorInner.Assign(val);
2502
procedure TGLLifeColoredPFXManager.SetColorOuter(const val: TGLColor);
2504
FColorOuter.Assign(val);
2510
procedure TGLLifeColoredPFXManager.SetLifeColors(const val: TPFXLifeColors);
2512
FLifeColors.Assign(Self);
2515
// InitializeRendering
2518
procedure TGLLifeColoredPFXManager.InitializeRendering(var rci: TGLRenderContextInfo);
2522
n := LifeColors.Count;
2523
FLifeColorsLookup := TList.Create;
2524
FLifeColorsLookup.Capacity := n;
2525
for i := 0 to n - 1 do
2526
FLifeColorsLookup.Add(LifeColors[i]);
2527
FLifeRotations := LifeColors.RotationsDefined;
2528
FLifeScaling := LifeColors.ScalingDefined;
2529
LifeColors.PrepareIntervalRatios;
2535
procedure TGLLifeColoredPFXManager.FinalizeRendering(var rci: TGLRenderContextInfo);
2537
FLifeColorsLookup.Free;
2543
function TGLLifeColoredPFXManager.MaxParticleAge: Single;
2545
Result := LifeColors.MaxLifeTime;
2551
procedure TGLLifeColoredPFXManager.ComputeColors(var lifeTime: Single; var inner, outer: TColorVector);
2555
lck, lck1: TPFXLifeColor;
2562
inner := ColorInner.Color;
2563
outer := ColorOuter.Color;
2571
if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then
2581
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2582
f := lifeTime * lck.InvLifeTime;
2583
VectorLerp(ColorInner.Color, lck.ColorInner.Color, f, inner);
2584
VectorLerp(ColorOuter.Color, lck.ColorOuter.Color, f, outer);
2587
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2588
lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]);
2589
f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio;
2590
VectorLerp(lck1.ColorInner.Color, lck.ColorInner.Color, f, inner);
2591
VectorLerp(lck1.ColorOuter.Color, lck.ColorOuter.Color, f, outer);
2600
procedure TGLLifeColoredPFXManager.ComputeInnerColor(var lifeTime: Single; var inner: TColorVector);
2604
lck, lck1: TPFXLifeColor;
2605
lifeColorsLookupList: PFXPointerList;
2611
inner := ColorInner.Color
2614
lifeColorsLookupList := @FLifeColorsLookup.List[0];
2619
if TPFXLifeColor(lifeColorsLookupList^[i]).LifeTime < lifeTime then
2628
lck := TPFXLifeColor(lifeColorsLookupList^[k]);
2629
f := lifeTime * lck.InvLifeTime;
2630
VectorLerp(ColorInner.Color, lck.ColorInner.Color, f, inner);
2634
lck := TPFXLifeColor(lifeColorsLookupList^[k]);
2635
lck1 := TPFXLifeColor(lifeColorsLookupList^[k - 1]);
2636
f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio;
2637
VectorLerp(lck1.ColorInner.Color, lck.ColorInner.Color, f, inner);
2646
procedure TGLLifeColoredPFXManager.ComputeOuterColor(var lifeTime: Single; var outer: TColorVector);
2650
lck, lck1: TPFXLifeColor;
2656
outer := ColorOuter.Color
2663
if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then
2673
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2674
f := lifeTime * lck.InvLifeTime;
2675
VectorLerp(ColorOuter.Color, lck.ColorOuter.Color, f, outer);
2678
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2679
lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]);
2680
f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio;
2681
VectorLerp(lck1.ColorOuter.Color, lck.ColorOuter.Color, f, outer);
2690
function TGLLifeColoredPFXManager.ComputeSizeScale(var lifeTime: Single; var sizeScale: Single): Boolean;
2694
lck, lck1: TPFXLifeColor;
2707
if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then
2717
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2718
Result := lck.FDoScale;
2721
f := lifeTime * lck.InvLifeTime;
2722
sizeScale := Lerp(1, lck.SizeScale, f);
2726
lck := TPFXLifeColor(FLifeColorsLookup.Items[k]);
2727
lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]);
2728
Result := lck.FDoScale or lck1.FDoScale;
2731
f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio;
2732
sizeScale := Lerp(lck1.SizeScale, lck.SizeScale, f);
2739
// ComputeRotateAngle
2742
function TGLLifeColoredPFXManager.ComputeRotateAngle(var lifeTime: Single; var rotateAngle: Single): Boolean;
2746
lck, lck1: TPFXLifeColor;
2759
if Items[i].LifeTime < lifeTime then
2769
lck := LifeColors[k];
2770
Result := lck.FDoRotate;
2773
f := lifeTime * lck.InvLifeTime;
2774
rotateAngle := Lerp(1, lck.rotateAngle, f);
2778
lck := LifeColors[k];
2779
lck1 := LifeColors[k - 1];
2780
Result := lck.FDoRotate or lck1.FDoRotate;
2783
f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio;
2784
rotateAngle := Lerp(lck1.rotateAngle, lck.rotateAngle, f);
2794
procedure TGLLifeColoredPFXManager.RotateVertexBuf(buf: TAffineVectorList;
2795
lifeTime: Single; const axis: TAffineVector; offsetAngle: Single);
2797
rotateAngle: Single;
2800
lifeRotationApplied: Boolean;
2803
lifeRotationApplied := ComputeRotateAngle(lifeTime, rotateAngle);
2804
rotateAngle := rotateAngle + offsetAngle;
2805
if lifeRotationApplied or (rotateAngle <> 0) then
2807
diff := DegToRad(rotateAngle);
2808
rotMatrix := CreateRotationMatrix(axis, diff);
2809
buf.TransformAsVectors(rotMatrix);
2813
// ------------------
2814
// ------------------ TGLCustomPFXManager ------------------
2815
// ------------------
2820
procedure TGLCustomPFXManager.DoProgress(const progressTime: TProgressTimes);
2823
list: PGLParticleArray;
2824
curParticle: TGLParticle;
2825
defaultProgress, killParticle, doPack: Boolean;
2827
if Assigned(FOnProgress) then
2829
defaultProgress := False;
2830
FOnProgress(Self, progressTime, defaultProgress);
2831
if defaultProgress then
2836
if Assigned(FOnParticleProgress) then
2839
list := Particles.List;
2840
for i := 0 to Particles.ItemCount - 1 do
2842
killParticle := True;
2843
curParticle := list^[i];
2844
FOnParticleProgress(Self, progressTime, curParticle, killParticle);
2845
if killParticle then
2860
function TGLCustomPFXManager.TexturingMode: Cardinal;
2865
// InitializeRendering
2868
procedure TGLCustomPFXManager.InitializeRendering(var rci: TGLRenderContextInfo);
2871
if Assigned(FOnInitializeRendering) then
2872
FOnInitializeRendering(Self, rci);
2878
procedure TGLCustomPFXManager.BeginParticles(var rci: TGLRenderContextInfo);
2880
if Assigned(FOnBeginParticles) then
2881
FOnBeginParticles(Self, rci);
2887
procedure TGLCustomPFXManager.RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle);
2889
if Assigned(FOnRenderParticle) then
2890
FOnRenderParticle(Self, aParticle, rci);
2896
procedure TGLCustomPFXManager.EndParticles(var rci: TGLRenderContextInfo);
2898
if Assigned(FOnEndParticles) then
2899
FOnEndParticles(Self, rci);
2905
procedure TGLCustomPFXManager.FinalizeRendering(var rci: TGLRenderContextInfo);
2907
if Assigned(FOnFinalizeRendering) then
2908
FOnFinalizeRendering(Self, rci);
2915
function TGLCustomPFXManager.ParticleCount: Integer;
2917
if Assigned(FOnGetParticleCountEvent) then
2918
Result := FOnGetParticleCountEvent(Self)
2920
Result := FParticles.FItemList.Count;
2923
// ------------------
2924
// ------------------ TGLPolygonPFXManager ------------------
2925
// ------------------
2930
constructor TGLPolygonPFXManager.Create(aOwner: TComponent);
2939
destructor TGLPolygonPFXManager.Destroy;
2947
procedure TGLPolygonPFXManager.SetNbSides(const val: Integer);
2949
if val <> FNbSides then
2952
if FNbSides < 3 then
2961
function TGLPolygonPFXManager.TexturingMode: Cardinal;
2966
// InitializeRendering
2969
procedure TGLPolygonPFXManager.InitializeRendering(var rci: TGLRenderContextInfo);
2976
GL.GetFloatv(GL_MODELVIEW_MATRIX, @matrix);
2979
Fvx.V[i] := matrix.V[i].V[0] * FParticleSize;
2980
Fvy.V[i] := matrix.V[i].V[1] * FParticleSize;
2982
FVertices := TAffineVectorList.Create;
2983
FVertices.Capacity := FNbSides;
2984
for i := 0 to FNbSides - 1 do
2986
SinCos(i * c2PI / FNbSides, s, c);
2987
FVertices.Add(VectorCombine(FVx, Fvy, c, s));
2989
FVertBuf := TAffineVectorList.Create;
2990
FVertBuf.Count := FVertices.Count;
2996
procedure TGLPolygonPFXManager.BeginParticles(var rci: TGLRenderContextInfo);
2998
ApplyBlendingMode(rci);
3004
procedure TGLPolygonPFXManager.RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle);
3007
lifeTime, sizeScale: Single;
3008
inner, outer: TColorVector;
3010
vertexList: PAffineVectorArray;
3012
lifeTime := FCurrentTime - aParticle.CreationTime;
3013
ComputeColors(lifeTime, inner, outer);
3015
pos := aParticle.Position;
3017
vertexList := FVertBuf.List;
3020
for I := 0 to FVertBuf.Count - 1 do
3021
vertexList[i] := FVertices[i];
3023
// rotate vertices (if needed)
3024
if FLifeRotations or (aParticle.FRotation <> 0) then
3025
RotateVertexBuf(FVertBuf, lifeTime, AffineVectorMake(rci.cameraDirection), aParticle.FRotation);
3027
// scale vertices (if needed) then translate to particle position
3028
if FLifeScaling or (aParticle.FEffectScale <> 1) then
3030
if FLifeScaling and ComputeSizeScale(lifeTime, sizeScale) then
3031
sizeScale := sizeScale * aParticle.FEffectScale
3033
sizeScale := aParticle.FEffectScale;
3035
for i := 0 to FVertBuf.Count - 1 do
3036
vertexList^[i] := VectorCombine(vertexList^[i], pos, sizeScale, 1);
3039
FVertBuf.Translate(pos);
3041
GL.Begin_(GL_TRIANGLE_FAN);
3042
GL.Color4fv(@inner);
3044
GL.Color4fv(@outer);
3045
for i := 0 to FVertBuf.Count - 1 do
3046
GL.Vertex3fv(@vertexList[i]);
3048
GL.Vertex3fv(@vertexList[0]);
3055
procedure TGLPolygonPFXManager.EndParticles(var rci: TGLRenderContextInfo);
3057
UnapplyBlendingMode(rci);
3063
procedure TGLPolygonPFXManager.FinalizeRendering(var rci: TGLRenderContextInfo);
3070
// ------------------
3071
// ------------------ TGLBaseSpritePFXManager ------------------
3072
// ------------------
3077
constructor TGLBaseSpritePFXManager.Create(aOwner: TComponent);
3080
FTexHandle := TGLTextureHandle.Create;
3081
FSpritesPerTexture := sptOne;
3088
destructor TGLBaseSpritePFXManager.Destroy;
3091
FShareSprites := nil;
3095
// SetSpritesPerTexture
3098
procedure TGLBaseSpritePFXManager.SetSpritesPerTexture(const val: TSpritesPerTexture);
3100
if val <> FSpritesPerTexture then
3102
FSpritesPerTexture := val;
3103
FTexHandle.DestroyHandle;
3111
procedure TGLBaseSpritePFXManager.SetColorMode(const val: TSpriteColorMode);
3113
if val <> FColorMode then
3123
procedure TGLBaseSpritePFXManager.SetAspectRatio(const val: Single);
3125
if FAspectRatio <> val then
3127
FAspectRatio := ClampValue(val, 1e-3, 1e3);
3135
function TGLBaseSpritePFXManager.StoreAspectRatio: Boolean;
3137
Result := (FAspectRatio <> 1);
3143
procedure TGLBaseSpritePFXManager.SetRotation(const val: Single);
3145
if FRotation <> val then
3155
procedure TGLBaseSpritePFXManager.SetShareSprites(const val: TGLBaseSpritePFXManager);
3157
if FShareSprites <> val then
3159
if Assigned(FShareSprites) then
3160
FShareSprites.RemoveFreeNotification(Self);
3161
FShareSprites := val;
3162
if Assigned(FShareSprites) then
3163
FShareSprites.FreeNotification(Self);
3170
procedure TGLBaseSpritePFXManager.BindTexture(var rci: TGLRenderContextInfo);
3173
tw, th, td, tf: Integer;
3175
if Assigned(FShareSprites) then
3176
FShareSprites.BindTexture(rci)
3179
if FTexHandle.Handle = 0 then
3181
FTexHandle.AllocateHandle;
3182
FTexHandle.Target := ttTexture2D;
3183
rci.GLStates.TextureBinding[0, ttTexture2D] := FTexHandle.Handle;
3184
GL.Hint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
3185
rci.GLStates.UnpackAlignment := 4;
3186
rci.GLStates.UnpackRowLength := 0;
3187
rci.GLStates.UnpackSkipRows := 0;
3188
rci.GLStates.UnpackSkipPixels := 0;
3190
GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
3191
GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
3193
bmp32 := TGLBitmap32.Create;
3196
PrepareImage(bmp32, tf);
3197
bmp32.RegisterAsOpenGLTexture(
3208
rci.GLStates.TextureBinding[0, ttTexture2D] := FTexHandle.Handle;
3216
function TGLBaseSpritePFXManager.TexturingMode: Cardinal;
3218
Result := GL_TEXTURE_2D;
3221
// InitializeRendering
3224
procedure TGLBaseSpritePFXManager.InitializeRendering(var rci: TGLRenderContextInfo);
3231
GL.GetFloatv(GL_MODELVIEW_MATRIX, @matrix);
3233
w := FParticleSize * Sqrt(FAspectRatio);
3234
h := Sqr(FParticleSize) / w;
3238
Fvx.V[i] := matrix.V[i].V[0] * w;
3239
Fvy.V[i] := matrix.V[i].V[1] * h;
3240
Fvz.V[i] := matrix.V[i].V[2];
3243
FVertices := TAffineVectorList.Create;
3246
SinCos(i * cPIdiv2 + cPIdiv4, s, c);
3247
FVertices.Add(VectorCombine(Fvx, Fvy, c, s));
3249
if FRotation <> 0 then
3251
matrix := CreateRotationMatrix(Fvz, -FRotation);
3252
FVertices.TransformAsPoints(matrix);
3255
FVertBuf := TAffineVectorList.Create;
3256
FVertBuf.Count := FVertices.Count;
3262
procedure TGLBaseSpritePFXManager.BeginParticles(var rci: TGLRenderContextInfo);
3265
if ColorMode = scmNone then
3266
GL.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE)
3268
GL.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
3269
ApplyBlendingMode(rci);
3270
if ColorMode <> scmFade then
3271
GL.Begin_(GL_QUADS);
3277
procedure TGLBaseSpritePFXManager.RenderParticle(var rci: TGLRenderContextInfo; aParticle: TGLParticle);
3279
TTexCoordsSet = array[0..3] of TTexPoint;
3280
PTexCoordsSet = ^TTexCoordsSet;
3282
cBaseTexCoordsSet: TTexCoordsSet = ((S: 1; T: 1), (S: 0; T: 1), (S: 0; T: 0), (S: 1; T: 0));
3283
cTexCoordsSets: array[0..3] of TTexCoordsSet =
3284
(((S: 1.0; T: 1.0), (S: 0.5; T: 1.0), (S: 0.5; T: 0.5), (S: 1.0; T: 0.5)),
3285
((S: 0.5; T: 1.0), (S: 0.0; T: 1.0), (S: 0.0; T: 0.5), (S: 0.5; T: 0.5)),
3286
((S: 1.0; T: 0.5), (S: 0.5; T: 0.5), (S: 0.5; T: 0.0), (S: 1.0; T: 0.0)),
3287
((S: 0.5; T: 0.5), (S: 0.0; T: 0.5), (S: 0.0; T: 0.0), (S: 0.5; T: 0.0)));
3289
lifeTime, sizeScale: Single;
3290
inner, outer: TColorVector;
3292
vertexList: PAffineVectorArray;
3295
spt: TSpritesPerTexture;
3297
procedure IssueVertices;
3299
GL.TexCoord2fv(@tcs[0]);
3300
GL.Vertex3fv(@vertexList[0]);
3301
GL.TexCoord2fv(@tcs[1]);
3302
GL.Vertex3fv(@vertexList[1]);
3303
GL.TexCoord2fv(@tcs[2]);
3304
GL.Vertex3fv(@vertexList[2]);
3305
GL.TexCoord2fv(@tcs[3]);
3306
GL.Vertex3fv(@vertexList[3]);
3310
lifeTime := FCurrentTime - aParticle.CreationTime;
3312
if Assigned(ShareSprites) then
3313
spt := ShareSprites.SpritesPerTexture
3315
spt := SpritesPerTexture;
3317
sptFour: tcs := @cTexCoordsSets[(aParticle.ID and 3)];
3319
tcs := @cBaseTexCoordsSet;
3322
pos := aParticle.Position;
3323
vertexList := FVertBuf.List;
3327
for i := 0 to FVertBuf.Count - 1 do
3328
vertexList^[i] := FVertices[i];
3330
// rotate vertices (if needed)
3331
if FLifeRotations or (aParticle.FRotation <> 0) then
3332
RotateVertexBuf(FVertBuf, lifeTime, AffineVectorMake(rci.cameraDirection), aParticle.FRotation);
3334
// scale vertices (if needed) then translate to particle position
3335
if FLifeScaling or (aParticle.FEffectScale <> 1) then
3337
if FLifeScaling and ComputeSizeScale(lifeTime, sizeScale) then
3338
sizeScale := sizeScale * aParticle.FEffectScale
3340
sizeScale := aParticle.FEffectScale;
3342
for i := 0 to FVertBuf.Count - 1 do
3343
vertexList^[i] := VectorCombine(vertexList^[i], pos, sizeScale, 1);
3346
FVertBuf.Translate(pos);
3351
ComputeColors(lifeTime, inner, outer);
3352
GL.Begin_(GL_TRIANGLE_FAN);
3353
GL.Color4fv(@inner);
3354
GL.TexCoord2f((tcs^[0].S + tcs^[2].S) * 0.5, (tcs^[0].T + tcs^[2].T) * 0.5);
3356
GL.Color4fv(@outer);
3358
GL.TexCoord2fv(@tcs[0]);
3359
GL.Vertex3fv(@vertexList[0]);
3364
ComputeInnerColor(lifeTime, inner);
3365
GL.Color4fv(@inner);
3370
ComputeOuterColor(lifeTime, outer);
3371
GL.Color4fv(@outer);
3386
procedure TGLBaseSpritePFXManager.EndParticles(var rci: TGLRenderContextInfo);
3388
if ColorMode <> scmFade then
3390
UnApplyBlendingMode(rci);
3396
procedure TGLBaseSpritePFXManager.FinalizeRendering(var rci: TGLRenderContextInfo);
3403
// ------------------
3404
// ------------------ TGLCustomSpritePFXManager ------------------
3405
// ------------------
3410
constructor TGLCustomSpritePFXManager.Create(aOwner: TComponent);
3413
FColorMode := scmInner;
3414
FSpritesPerTexture := sptOne;
3420
destructor TGLCustomSpritePFXManager.Destroy;
3428
procedure TGLCustomSpritePFXManager.PrepareImage(bmp32: TGLBitmap32; var texFormat: Integer);
3430
if Assigned(FOnPrepareTextureImage) then
3431
FOnPrepareTextureImage(Self, bmp32, texFormat);
3434
// ------------------
3435
// ------------------ TGLPointLightPFXManager ------------------
3436
// ------------------
3441
constructor TGLPointLightPFXManager.Create(aOwner: TComponent);
3445
FColorMode := scmInner;
3451
destructor TGLPointLightPFXManager.Destroy;
3459
procedure TGLPointLightPFXManager.SetTexMapSize(const val: Integer);
3461
if val <> FTexMapSize then
3464
if FTexMapSize < 3 then
3466
if FTexMapSize > 9 then
3475
procedure TGLPointLightPFXManager.PrepareImage(bmp32: TGLBitmap32; var texFormat: Integer);
3478
x, y, d, h2: Integer;
3480
scanLine1, scanLine2: PGLPixel32Array;
3482
s := (1 shl TexMapSize);
3485
bmp32.Blank := false;
3486
texFormat := GL_LUMINANCE_ALPHA;
3490
for y := 0 to h2 - 1 do
3492
fy := Sqr((y + 0.5 - h2) * ih2);
3493
scanLine1 := bmp32.ScanLine[y];
3494
scanLine2 := bmp32.ScanLine[s - 1 - y];
3495
for x := 0 to h2 - 1 do
3497
f := Sqr((x + 0.5 - h2) * ih2) + fy;
3500
d := Trunc((1 - Sqrt(f)) * 256);
3501
d := d + (d shl 8) + (d shl 16) + (d shl 24);
3505
PInteger(@scanLine1[x])^ := d;
3506
PInteger(@scanLine2[x])^ := d;
3507
PInteger(@scanLine1[s - 1 - x])^ := d;
3508
PInteger(@scanLine2[s - 1 - x])^ := d;
3513
// ------------------------------------------------------------------
3514
// ------------------------------------------------------------------
3515
// ------------------------------------------------------------------
3517
// ------------------------------------------------------------------
3518
// ------------------------------------------------------------------
3519
// ------------------------------------------------------------------
3521
// class registrations
3522
RegisterClasses([TGLParticle, TGLParticleList,
3523
TGLParticleFXEffect, TGLParticleFXRenderer,
3524
TGLCustomPFXManager,
3525
TGLPolygonPFXManager,
3526
TGLCustomSpritePFXManager,
3527
TGLPointLightPFXManager]);
3528
RegisterXCollectionItemClass(TGLSourcePFXEffect);
3532
UnregisterXCollectionItemClass(TGLSourcePFXEffect);