// // The graphics engine GLXEngine. The unit of GXScene for Delphi // unit GXS.ParticleFX; (* Base classes for scene-wide blended particles FX. These provide a mechanism to render heterogenous particles systems with per particle depth-sorting (allowing correct rendering of interwoven separate fire and smoke particle systems for instance). *) interface {$I Stage.Defines.inc} uses Winapi.OpenGL, System.Classes, System.SysUtils, System.Types, System.Math, Stage.VectorTypes, Stage.VectorGeometry, Stage.Utils, GXS.PersistentClasses, GXS.VectorLists, Stage.Manager, GXS.Scene, GXS.ImageUtils, GXS.State, GXS.Material, GXS.Cadencer, GXS.Graphics, GXS.Context, GXS.Color, GXS.BaseClasses, GXS.Coordinates, GXS.RenderContextInfo, Stage.PipelineTransform, GXS.XCollection, Stage.TextureFormat; const cPFXNbRegions = 128; // number of distance regions cPFXGranularity = 128; // granularity of particles per region type TgxParticleList = class; TgxParticleFXManager = class; TgxParticleFXEffect = class; (* Base class for particles. The class implements properties for position, velocity and time, whatever you need in excess of that will have to be placed in subclasses (this class should remain as compact as possible). *) TgxParticle = class(TgxPersistentObject) private FID, FTag: Integer; FManager: TgxParticleFXManager; // NOT persistent FPosition: TAffineVector; FVelocity: TAffineVector; FRotation: Single; FCreationTime: Double; FEffectScale: Single; function GetPosition(const Index: Integer): Single; procedure WritePosition(const Index: Integer; const aValue: Single); function GetVelocity(const Index: Integer): Single; procedure WriteVelocity(const Index: Integer; const aValue: Single); public constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TgxVirtualWriter); override; procedure ReadFromFiler(reader: TgxVirtualReader); override; property Manager: TgxParticleFXManager read FManager write FManager; (* Particle's ID, given at birth. ID is a value unique per manager. *) property ID: Integer read FID; (* Particle's absolute position. Note that this property is read-accessed directly at rendering time in the innards of the depth-sorting code. *) property Position: TAffineVector read FPosition write FPosition; (* Particle's velocity. This velocity is indicative and is NOT automatically applied to the position during progression events by this class (subclasses may implement that). *) property Velocity: TAffineVector read FVelocity write FVelocity; // Time at which particle was created property CreationTime: Double read FCreationTime write FCreationTime; property PosX : Single index 0 read GetPosition write WritePosition; property PosY : Single index 1 read GetPosition write WritePosition; property PosZ : Single index 2 read GetPosition write WritePosition; property VelX : Single index 0 read GetVelocity write WriteVelocity; property VelY : Single index 1 read GetVelocity write WriteVelocity; property VelZ : Single index 2 read GetVelocity write WriteVelocity; property Tag: Integer read FTag write FTag; end; TgxParticleClass = class of TgxParticle; TgxParticleArray = array[0..MaxInt shr 4] of TgxParticle; PGLParticleArray = ^TgxParticleArray; (* List of particles. This list is managed with particles and performance in mind, make sure to check methods doc. *) TgxParticleList = class(TgxPersistentObject) private FOwner: TgxParticleFXManager; // NOT persistent FItemList: TgxPersistentObjectList; FDirectList: PGLParticleArray; // NOT persistent protected function GetItems(index: Integer): TgxParticle; procedure SetItems(index: Integer; val: TgxParticle); procedure AfterItemCreated(Sender: TObject); public constructor Create; override; destructor Destroy; override; procedure WriteToFiler(writer: TgxVirtualWriter); override; procedure ReadFromFiler(reader: TgxVirtualReader); override; // Refers owner manager property Owner: TgxParticleFXManager read FOwner write FOwner; property Items[index: Integer]: TgxParticle read GetItems write SetItems; default; function ItemCount: Integer; (* Adds a particle to the list. Particle owneship is defined blindly, if the particle was previously in another list, it won't be automatically removed from that list. *) function AddItem(aItem: TgxParticle): Integer; (* Removes and frees a particular item for the list. If the item is not part of the list, nothing is done. If found in the list, the item's "slot" is set to nil and item is freed (after setting its ownership to nil). The nils can be removed with a call to Pack. *) procedure RemoveAndFreeItem(aItem: TgxParticle); function IndexOfItem(aItem: TgxParticle): Integer; (* Packs the list by removing all "nil" items. Note: this functions is orders of magnitude faster than the TList version. *) procedure Pack; property List: PGLParticleArray read FDirectList; end; TgxParticleFXRenderer = class; TPFXCreateParticleEvent = procedure(Sender: TObject; aParticle: TgxParticle) of object; (* Base class for particle FX managers. Managers take care of life and death of particles for a particular particles FX system. You can have multiple scene-wide particle FX managers in a scene, handled by the same ParticleFxRenderer. Before subclassing, make sure you understood how the Initialize/Finalize Rendering, Begin/End Particles and RenderParticles methods (and also understood that rendering of manager's particles may be interwoven). *) TgxParticleFXManager = class(TgxCadencedComponent) private FBlendingMode: TgxBlendingMode; FRenderer: TgxParticleFXRenderer; FParticles: TgxParticleList; FNextID: Integer; FOnCreateParticle: TPFXCreateParticleEvent; FAutoFreeWhenEmpty: Boolean; FUsers: TList; //list of objects that use this manager protected procedure SetRenderer(const val: TgxParticleFXRenderer); procedure SetParticles(const aParticles: TgxParticleList); (* Texturing mode for the particles. Subclasses should return GL_TEXTURE_1D, 2D or 3D depending on their needs, and zero if they don't use texturing. This method is used to reduce the number of texturing activations/deactivations. *) function TexturingMode: Cardinal; virtual; abstract; (* Invoked when the particles of the manager will be rendered. This method is fired with the "base" OpenGL states and matrices that will be used throughout the whole rendering, per-frame initialization should take place here. OpenGL states/matrices should not be altered in any way here. *) procedure InitializeRendering(var rci: TgxRenderContextInfo); virtual; abstract; (* Triggered just before rendering a set of particles. The current OpenGL state should be assumed to be the "base" one as was found during InitializeRendering. Manager-specific states should be established here. Multiple BeginParticles can occur during a render (but all will be between InitializeRendering and Finalizerendering, and at least one particle will be rendered before EndParticles is invoked). *) procedure BeginParticles(var rci: TgxRenderContextInfo); virtual; abstract; (* Request to render a particular particle. Due to the nature of the rendering, no particular order should be assumed. If possible, no OpenGL state changes should be made in this method, but should be placed in Begin/EndParticles. *) procedure RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); virtual; abstract; (* Triggered after a set of particles as been rendered. If OpenGL state were altered directly (ie. not through the states caches of GLMisc), it should be restored back to the "base" state. *) procedure EndParticles(var rci: TgxRenderContextInfo); virtual; abstract; // Invoked when rendering of particles for this manager is done. procedure FinalizeRendering(var rci: TgxRenderContextInfo); virtual; abstract; // ID for the next created particle. property NextID: Integer read FNextID write FNextID; (* Blending mode for the particles. Protected and unused in the base class. *) property BlendingMode: TgxBlendingMode read FBlendingMode write FBlendingMode; // Apply BlendingMode relatively to the renderer's blending mode. procedure ApplyBlendingMode(var rci: TgxRenderContextInfo); // Unapply BlendingMode relatively by restoring the renderer's blending mode. procedure UnapplyBlendingMode(var rci: TgxRenderContextInfo); procedure registerUser(obj: TgxParticleFXEffect); procedure unregisterUser(obj: TgxParticleFXEffect); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; procedure NotifyChange(Sender: TObject); override; procedure DoProgress(const progressTime: TgxProgressTimes); override; // Class of particles created by this manager. } class function ParticlesClass: TgxParticleClass; virtual; // Creates a new particle controlled by the manager. function CreateParticle: TgxParticle; virtual; // Create several particles at once. procedure CreateParticles(nbParticles: Integer); // A TgxParticleList property. property Particles: TgxParticleList read FParticles write SetParticles; (* Return the number of particles. Note that subclasses may decide to return a particle count inferior to Particles.ItemCount, and the value returned by this method will be the one honoured at render time. *) function ParticleCount: Integer; virtual; (* If True the manager will free itself when its particle count reaches zero. Check happens in the progression event, use with caution and only if you know what you're doing! *) property AutoFreeWhenEmpty: Boolean read FAutoFreeWhenEmpty write FAutoFreeWhenEmpty; published (* References the renderer. The renderer takes care of ordering the particles of the manager (and other managers linked to it) and rendering them all depth-sorted. *) property Renderer: TgxParticleFXRenderer read FRenderer write SetRenderer; // Event triggered after standard particle creation and initialization. property OnCreateParticle: TPFXCreateParticleEvent read FOnCreateParticle write FOnCreateParticle; property Cadencer; end; // Base class for linking scene objects to a particle FX manager. TgxParticleFXEffect = class(TgxObjectPostEffect) private FManager: TgxParticleFXManager; FManagerName: string; FEffectScale: single; procedure SetEffectScale(const Value: single); // NOT persistent, temporarily used for persistence protected procedure SetManager(val: TgxParticleFXManager); procedure WriteToFiler(writer: TWriter); override; procedure ReadFromFiler(reader: TReader); override; procedure Loaded; override; procedure managerNotification(aManager: TgxParticleFXManager; Operation: TOperation); public constructor Create(aOwner: TXCollection); override; destructor Destroy; override; published // Reference to the Particle FX manager property Manager: TgxParticleFXManager read FManager write SetManager; property EffectScale: single read FEffectScale write SetEffectScale; end; // PFX region rendering structures TParticleReference = packed record particle: TgxParticle; distance: Integer; // stores an IEEE single! end; PParticleReference = ^TParticleReference; TParticleReferenceArray = packed array[0..MaxInt shr 8-1] of TParticleReference; PParticleReferenceArray = ^TParticleReferenceArray; PFXPointerList = ^TFXPointerList; TFXPointerList = array[0..MaxInt shr 8-1] of Pointer; TPFXRegion = record count, capacity: Integer; particleRef: PParticleReferenceArray; particleOrder: PFXPointerList; end; PPFXRegion = ^TPFXRegion; TPFXSortAccuracy = (saLow, saOneTenth, saOneThird, saOneHalf, saHigh); (* Rendering interface for scene-wide particle FX. A renderer can take care of rendering any number of particle systems, its main task being to depth-sort the particles so that they are blended appropriately. This object will usually be placed at the end of the scene hierarchy, just before the HUD overlays, its position, rotation etc. is of no importance and has no effect on the rendering of the particles. *) TgxParticleFXRenderer = class(TgxBaseSceneObject) private FManagerList: TList; FLastSortTime: Double; FLastParticleCount: Integer; FZWrite, FZTest, FZCull: Boolean; FZSortAccuracy: TPFXSortAccuracy; FZMaxDistance: Single; FBlendingMode: TgxBlendingMode; FRegions: array[0..cPFXNbRegions - 1] of TPFXRegion; protected function StoreZMaxDistance: Boolean; // Register a manager procedure RegisterManager(aManager: TgxParticleFXManager); // UnRegister a manager procedure UnRegisterManager(aManager: TgxParticleFXManager); procedure UnRegisterAll; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; (* Quick Explanation of what is below: The purpose is to depth-sort a large number (thousandths) of particles and render them back to front. The rendering part is not particularly complex, it just invokes the various PFX managers involved and request particle renderings. The sort uses a first-pass region partition (the depth range is split into regions, and particles are assigned directly to the region they belong to), then each region is sorted with a QuickSort. The QuickSort itself is the regular classic variant, but the comparison is made on singles as if they were integers, this is allowed by the IEEE format in a very efficient manner if all values are superior to 1, which is ensured by the distance calculation and a fixed offset of 1 *) procedure BuildList(var rci: TgxRenderContextInfo); override; // Time (in msec) spent sorting the particles for last render. property LastSortTime: Double read FLastSortTime; // Amount of particles during the last render. property LastParticleCount: Integer read FLastParticleCount; published (*Specifies if particles should write to ZBuffer. If the PFXRenderer is the last object to be rendered in the scene, it is not necessary to write to the ZBuffer since the particles are depth-sorted. Writing to the ZBuffer has a performance penalty. *) property ZWrite: Boolean read FZWrite write FZWrite default False; // Specifies if particles should write to test ZBuffer. property ZTest: Boolean read FZTest write FZTest default True; // If true the renderer will cull particles that are behind the camera. property ZCull: Boolean read FZCull write FZCull default True; (* If true particles will be accurately sorted back to front. When false, only a rough ordering is used, which can result in visual glitches but may be faster. *) property ZSortAccuracy: TPFXSortAccuracy read FZSortAccuracy write FZSortAccuracy default saHigh; (* Maximum distance for rendering PFX particles. If zero, camera's DepthOfView is used. *) property ZMaxDistance: Single read FZMaxDistance write FZMaxDistance stored StoreZMaxDistance; (* Default blending mode for particles. "Additive" blending is the usual mode (increases brightness and saturates), "transparency" may be used for smoke or systems that opacify view, "opaque" is more rarely used. Note: specific PFX managers may override/ignore this setting. *) property BlendingMode: TgxBlendingMode read FBlendingMode write FBlendingMode default bmAdditive; property Visible; end; TgxSourcePFXVelocityMode = (svmAbsolute, svmRelative); TgxSourcePFXPositionMode = (spmAbsoluteOffset, spmRelative); TgxSourcePFXDispersionMode = (sdmFast, sdmIsotropic); // Simple Particles Source. TgxSourcePFXEffect = class(TgxParticleFXEffect) private FInitialVelocity: TgxCoordinates; FInitialPosition: TgxCoordinates; FPositionDispersionRange: TgxCoordinates; FVelocityDispersion: Single; FPositionDispersion: Single; FParticleInterval: Single; FVelocityMode: TgxSourcePFXVelocityMode; FPositionMode: TgxSourcePFXPositionMode; FDispersionMode: TgxSourcePFXDispersionMode; FEnabled: Boolean; FDisabledIfOwnerInvisible: Boolean; FTimeRemainder: Double; FRotationDispersion: Single; protected procedure SetInitialVelocity(const val: TgxCoordinates); procedure SetInitialPosition(const val: TgxCoordinates); procedure SetPositionDispersionRange(const val: TgxCoordinates); procedure SetParticleInterval(const val: Single); procedure WriteToFiler(writer: TWriter); override; procedure ReadFromFiler(reader: TReader); override; function ParticleAbsoluteInitialPos: TAffineVector; public constructor Create(aOwner: TXCollection); override; destructor Destroy; override; class function FriendlyName: string; override; class function FriendlyDescription: string; override; procedure DoProgress(const progressTime: TgxProgressTimes); override; // Instantaneously creates nb particles procedure Burst(time: Double; nb: Integer); procedure RingExplosion(time: Double; minInitialSpeed, maxInitialSpeed: Single; nbParticles: Integer); published property InitialVelocity: TgxCoordinates read FInitialVelocity write SetInitialVelocity; property VelocityDispersion: Single read FVelocityDispersion write FVelocityDispersion; property InitialPosition: TgxCoordinates read FInitialPosition write SetInitialPosition; property PositionDispersion: Single read FPositionDispersion write FPositionDispersion; property PositionDispersionRange: TgxCoordinates read FPositionDispersionRange write SetPositionDispersionRange; property ParticleInterval: Single read FParticleInterval write SetParticleInterval; property VelocityMode: TgxSourcePFXVelocityMode read FVelocityMode write FVelocityMode default svmAbsolute; property PositionMode: TgxSourcePFXPositionMode read FPositionMode write FPositionMode default spmAbsoluteOffset; property DispersionMode: TgxSourcePFXDispersionMode read FDispersionMode write FDispersionMode default sdmFast; property RotationDispersion: Single read FRotationDispersion write FRotationDispersion; property Enabled: boolean read FEnabled write FEnabled; property DisabledIfOwnerInvisible: boolean read FDisabledIfOwnerInvisible write FDisabledIfOwnerInvisible; end; (* An abstract PFX manager for simple dynamic particles. Adds properties and progress implementation for handling moving particles (simple velocity and const acceleration integration). *) TgxDynamicPFXManager = class(TgxParticleFXManager) private FAcceleration: TgxCoordinates; FFriction: Single; FCurrentTime: Double; //FRotationCenter: TAffineVector; protected procedure SetAcceleration(const val: TgxCoordinates); (* Returns the maximum age for a particle. Particles older than that will be killed by DoProgress. *) function MaxParticleAge: Single; virtual; abstract; property CurrentTime: Double read FCurrentTime; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; procedure DoProgress(const progressTime: TgxProgressTimes); override; published // Oriented acceleration applied to the particles. property Acceleration: TgxCoordinates read FAcceleration write SetAcceleration; (* Friction applied to the particles. Friction is applied as a speed scaling factor over 1 second, ie. a friction of 0.5 will half speed over 1 second, a friction of 3 will triple speed over 1 second, and a friction of 1 (default value) will have no effect. *) property Friction: Single read FFriction write FFriction; end; TPFXLifeColor = class(TCollectionItem) private FColorInner: TgxColor; FColorOuter: TgxColor; FLifeTime, FInvLifeTime: Single; FIntervalRatio: Single; FSizeScale: Single; FDoScale: Boolean; FDoRotate: boolean; FRotateAngle: Single; protected function GetDisplayName: string; override; procedure SetColorInner(const val: TgxColor); procedure SetColorOuter(const val: TgxColor); procedure SetLifeTime(const val: Single); procedure SetSizeScale(const val: Single); procedure SetRotateAngle(const Value: Single); // indirectly persistent public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; // Stores 1/LifeTime property InvLifeTime: Single read FInvLifeTime; // Stores 1/(LifeTime[Next]-LifeTime[Self]) property InvIntervalRatio: Single read FIntervalRatio; published property ColorInner: TgxColor read FColorInner write SetColorInner; property ColorOuter: TgxColor read FColorOuter write SetColorOuter; property LifeTime: Single read FLifeTime write SetLifeTime; property SizeScale: Single read FSizeScale write SetSizeScale; property RotateAngle: Single read FRotateAngle write SetRotateAngle; end; TPFXLifeColors = class(TOwnedCollection) protected procedure SetItems(index: Integer; const val: TPFXLifeColor); function GetItems(index: Integer): TPFXLifeColor; public constructor Create(AOwner: TPersistent); function Add: TPFXLifeColor; function FindItemID(ID: Integer): TPFXLifeColor; property Items[index: Integer]: TPFXLifeColor read GetItems write SetItems; default; function MaxLifeTime: Double; function RotationsDefined: Boolean; function ScalingDefined: Boolean; procedure PrepareIntervalRatios; end; (* Base PFX manager for particles with life colors. Particles have a core and edge color, for subclassing. *) TgxLifeColoredPFXManager = class(TgxDynamicPFXManager) private FLifeColors: TPFXLifeColors; FLifeColorsLookup: TList; FLifeRotations: Boolean; FLifeScaling: Boolean; FColorInner: TgxColor; FColorOuter: TgxColor; FParticleSize: Single; protected procedure SetLifeColors(const val: TPFXLifeColors); procedure SetColorInner(const val: TgxColor); procedure SetColorOuter(const val: TgxColor); procedure InitializeRendering(var rci: TgxRenderContextInfo); override; procedure FinalizeRendering(var rci: TgxRenderContextInfo); override; function MaxParticleAge: Single; override; procedure ComputeColors(var lifeTime: Single; var inner, outer: TgxColorVector); procedure ComputeInnerColor(var lifeTime: Single; var inner: TgxColorVector); procedure ComputeOuterColor(var lifeTime: Single; var outer: TgxColorVector); function ComputeSizeScale(var lifeTime: Single; var sizeScale: Single): Boolean; function ComputeRotateAngle(var lifeTime, rotateAngle: Single): Boolean; procedure RotateVertexBuf(buf: TgxAffineVectorList; lifeTime: Single; const axis: TAffineVector; offsetAngle: Single); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; property ParticleSize: Single read FParticleSize write FParticleSize; property ColorInner: TgxColor read FColorInner write SetColorInner; property ColorOuter: TgxColor read FColorOuter write SetColorOuter; property LifeColors: TPFXLifeColors read FLifeColors write SetLifeColors; published property BlendingMode default bmAdditive; end; TPFXDirectRenderEvent = procedure(Sender: TObject; aParticle: TgxParticle; var rci: TgxRenderContextInfo) of object; TPFXProgressEvent = procedure(Sender: TObject; const progressTime: TgxProgressTimes; var defaultProgress: Boolean) of object; TPFXParticleProgress = procedure(Sender: TObject; const progressTime: TgxProgressTimes; aParticle: TgxParticle; var killParticle: Boolean) of object; TPFXGetParticleCountEvent = function(Sender: TObject): Integer of object; (* A particles FX manager offering events for customization/experimentation. This manager essentially surfaces the PFX methods as events, and is best suited when you have specific particles that don't fall into any existing category, or when you want to experiment with particles and later plan to wrap things up in a full-blown manager. If the events aren't handled, nothing will be rendered. *) TgxCustomPFXManager = class(TgxLifeColoredPFXManager) private FOnInitializeRendering: TDirectRenderEvent; FOnBeginParticles: TDirectRenderEvent; FOnRenderParticle: TPFXDirectRenderEvent; FOnEndParticles: TDirectRenderEvent; FOnFinalizeRendering: TDirectRenderEvent; FOnProgress: TPFXProgressEvent; FOnParticleProgress: TPFXParticleProgress; FOnGetParticleCountEvent: TPFXGetParticleCountEvent; protected function TexturingMode: Cardinal; override; procedure InitializeRendering(var rci: TgxRenderContextInfo); override; procedure BeginParticles(var rci: TgxRenderContextInfo); override; procedure RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); override; procedure EndParticles(var rci: TgxRenderContextInfo); override; procedure FinalizeRendering(var rci: TgxRenderContextInfo); override; public procedure DoProgress(const progressTime: TgxProgressTimes); override; function ParticleCount: Integer; override; published property OnInitializeRendering: TDirectRenderEvent read FOnInitializeRendering write FOnInitializeRendering; property OnBeginParticles: TDirectRenderEvent read FOnBeginParticles write FOnBeginParticles; property OnRenderParticle: TPFXDirectRenderEvent read FOnRenderParticle write FOnRenderParticle; property OnEndParticles: TDirectRenderEvent read FOnEndParticles write FOnEndParticles; property OnFinalizeRendering: TDirectRenderEvent read FOnFinalizeRendering write FOnFinalizeRendering; property OnProgress: TPFXProgressEvent read FOnProgress write FOnProgress; property OnParticleProgress: TPFXParticleProgress read FOnParticleProgress write FOnParticleProgress; property OnGetParticleCountEvent: TPFXGetParticleCountEvent read FOnGetParticleCountEvent write FOnGetParticleCountEvent; property ParticleSize; property ColorInner; property ColorOuter; property LifeColors; end; (* Polygonal particles FX manager. The particles of this manager are made of N-face regular polygon with a core and edge color. No texturing is available. If you render large particles and don't have T&L acceleration, consider using TgxPointLightPFXManager. *) TgxPolygonPFXManager = class(TgxLifeColoredPFXManager) private FNbSides: Integer; Fvx, Fvy: TAffineVector; // NOT persistent FVertices: TgxAffineVectorList; // NOT persistent FVertBuf: TgxAffineVectorList; // NOT persistent protected procedure SetNbSides(const val: Integer); function TexturingMode: Cardinal; override; procedure InitializeRendering(var rci: TgxRenderContextInfo); override; procedure BeginParticles(var rci: TgxRenderContextInfo); override; procedure RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); override; procedure EndParticles(var rci: TgxRenderContextInfo); override; procedure FinalizeRendering(var rci: TgxRenderContextInfo); override; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; published property NbSides: Integer read FNbSides write SetNbSides default 6; property ParticleSize; property ColorInner; property ColorOuter; property LifeColors; end; (* Sprite color modes. scmFade: vertex coloring is used to fade inner-outer scmInner: vertex coloring uses inner color only scmOuter: vertex coloring uses outer color only scmNone: vertex coloring is NOT used (colors are ignored). *) TSpriteColorMode = (scmFade, scmInner, scmOuter, scmNone); // Sprites per sprite texture for the SpritePFX. TSpritesPerTexture = (sptOne, sptFour); (* Base class for sprite-based particles FX managers. The particles are made of optionally centered single-textured quads. *) TgxBaseSpritePFXManager = class(TgxLifeColoredPFXManager) private FTexHandle: TgxTextureHandle; Fvx, Fvy, Fvz: TAffineVector; // NOT persistent FVertices: TgxAffineVectorList; // NOT persistent FVertBuf: TgxAffineVectorList; // NOT persistent FAspectRatio: Single; FRotation: Single; FShareSprites: TgxBaseSpritePFXManager; FSpritesPerTexture: TSpritesPerTexture; FColorMode: TSpriteColorMode; protected // Subclasses should draw their stuff in this bmp32. procedure PrepareImage(bmp32: TgxBitmap32; var texFormat: Integer); virtual; abstract; procedure BindTexture(var rci: TgxRenderContextInfo); procedure SetSpritesPerTexture(const val: TSpritesPerTexture); virtual; procedure SetColorMode(const val: TSpriteColorMode); procedure SetAspectRatio(const val: Single); function StoreAspectRatio: Boolean; procedure SetRotation(const val: Single); procedure SetShareSprites(const val: TgxBaseSpritePFXManager); function TexturingMode: Cardinal; override; procedure InitializeRendering(var rci: TgxRenderContextInfo); override; procedure BeginParticles(var rci: TgxRenderContextInfo); override; procedure RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); override; procedure EndParticles(var rci: TgxRenderContextInfo); override; procedure FinalizeRendering(var rci: TgxRenderContextInfo); override; property SpritesPerTexture: TSpritesPerTexture read FSpritesPerTexture write SetSpritesPerTexture; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; property ColorMode: TSpriteColorMode read FColorMode write SetColorMode; published (* Ratio between width and height. An AspectRatio of 1 (default) will result in square sprite particles, values higher than one will result in horizontally stretched sprites, values below one will stretch vertically (assuming no rotation is applied). *) property AspectRatio: Single read FAspectRatio write SetAspectRatio stored StoreAspectRatio; (* Particle sprites rotation (in degrees). All particles of the PFX manager share this rotation. *) property Rotation: Single read FRotation write SetRotation; (* If specified the manager will reuse the other manager's sprites. Sharing sprites between PFX managers can help at the rendering stage if particles of the managers are mixed by helping reduce the number of texture switches. Note that only the texture is shared, not the colors, sizes or other dynamic parameters. *) property ShareSprites: TgxBaseSpritePFXManager read FShareSprites write FShareSprites; end; TPFXPrepareTextureImageEvent = procedure(Sender: TObject; destBmp32: TgxBitmap32; var texFormat: Integer) of object; (* A sprite-based particles FX managers using user-specified code to prepare the texture .*) TgxCustomSpritePFXManager = class(TgxBaseSpritePFXManager) private FOnPrepareTextureImage: TPFXPrepareTextureImageEvent; protected procedure PrepareImage(bmp32: TgxBitmap32; var texFormat: Integer); override; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; published // Place your texture rendering code in this event. property OnPrepareTextureImage: TPFXPrepareTextureImageEvent read FOnPrepareTextureImage write FOnPrepareTextureImage; property ColorMode default scmInner; property SpritesPerTexture default sptOne; property ParticleSize; property ColorInner; property ColorOuter; property LifeColors; end; (* A sprite-based particles FX managers using point light maps. The texture map is a round, distance-based transparency map (center "opaque"), you can adjust the quality (size) of the underlying texture map with the TexMapSize property. This PFX manager renders particles similar to what you can get with TgxPolygonPFXManager but stresses fillrate more than T&L rate (and will usually be slower than the PolygonPFX when nbSides is low or T&L acceleration available). Consider this implementation as a sample for your own PFX managers that may use particles with more complex textures. *) TgxPointLightPFXManager = class(TgxBaseSpritePFXManager) private FTexMapSize: Integer; protected procedure PrepareImage(bmp32: TgxBitmap32; var texFormat: Integer); override; procedure SetTexMapSize(const val: Integer); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; published (* Underlying texture map size, as a power of two. Min value is 3 (size=8), max value is 9 (size=512). *) property TexMapSize: Integer read FTexMapSize write SetTexMapSize default 5; property ColorMode default scmInner; property ParticleSize; property ColorInner; property ColorOuter; property LifeColors; end; { Returns or creates the TgxBInertia within the given object's behaviours. } function GetOrCreateSourcePFX(obj: TgxBaseSceneObject; const name: string = ''): TgxSourcePFXEffect; // ------------------------------------------------------------------ implementation // ------------------------------------------------------------------ function GetOrCreateSourcePFX(obj: TgxBaseSceneObject; const name: string = ''): TgxSourcePFXEffect; var i: Integer; begin with obj.Effects do begin if name = '' then begin i := IndexOfClass(TgxSourcePFXEffect); if i >= 0 then Result := TgxSourcePFXEffect(Items[i]) else Result := TgxSourcePFXEffect.Create(obj.Effects); end else begin i := IndexOfName(name); if i >= 0 then Result := (Items[i] as TgxSourcePFXEffect) else begin Result := TgxSourcePFXEffect.Create(obj.Effects); Result.Name := name; end; end; end; end; procedure RndVector(const dispersion: TgxSourcePFXDispersionMode; var v: TAffineVector; var f: Single; dispersionRange: TgxCoordinates); var f2, fsq: Single; p: TVector4f; begin f2 := 2 * f; if Assigned(dispersionRange) then p := VectorScale(dispersionRange.DirectVector, f2) else p := VectorScale(XYZHmgVector, f2); case dispersion of sdmFast: begin v.X := (Random - 0.5) * p.X; v.Y := (Random - 0.5) * p.Y; v.Z := (Random - 0.5) * p.Z; end; else fsq := Sqr(0.5); repeat v.X := (Random - 0.5); v.Y := (Random - 0.5); v.Z := (Random - 0.5); until VectorNorm(v) <= fsq; v.X := v.X * p.X; v.Y := v.Y * p.Y; v.Z := v.Z * p.Z; end; end; // ------------------ // ------------------ TgxParticle ------------------ // ------------------ constructor TgxParticle.Create; begin FEffectScale := 1; inherited Create; end; destructor TgxParticle.Destroy; begin inherited Destroy; end; function TgxParticle.GetPosition(const Index: Integer): Single; begin Result := FPosition.V[Index]; end; procedure TgxParticle.WritePosition(const Index: Integer; const aValue: Single); begin if (aValue <> FPosition.V[Index]) then FPosition.V[Index] := aValue; end; function TgxParticle.GetVelocity(const Index: Integer): Single; begin Result := FVelocity.X; end; procedure TgxParticle.WriteVelocity(const Index: Integer; const aValue: Single); begin if (aValue <> FVelocity.V[Index]) then FVelocity.V[Index] := aValue; end; procedure TgxParticle.WriteToFiler(writer: TgxVirtualWriter); begin inherited WriteToFiler(writer); with writer do begin WriteInteger(0); // Archive Version 0 WriteInteger(FID); Write(FPosition, SizeOf(FPosition)); Write(FVelocity, SizeOf(FVelocity)); WriteFloat(FCreationTime); end; end; procedure TgxParticle.ReadFromFiler(reader: TgxVirtualReader); var archiveVersion: integer; begin inherited ReadFromFiler(reader); archiveVersion := reader.ReadInteger; if archiveVersion = 0 then with reader do begin FID := ReadInteger; Read(FPosition, SizeOf(FPosition)); Read(FVelocity, SizeOf(FVelocity)); FCreationTime := ReadFloat; end else RaiseFilerException(archiveVersion); end; // ------------------ // ------------------ TgxParticleList ------------------ // ------------------ constructor TgxParticleList.Create; begin inherited Create; FItemList := TgxPersistentObjectList.Create; FitemList.GrowthDelta := 64; FDirectList := nil; end; destructor TgxParticleList.Destroy; begin FItemList.CleanFree; inherited Destroy; end; procedure TgxParticleList.WriteToFiler(writer: TgxVirtualWriter); begin inherited WriteToFiler(writer); with writer do begin WriteInteger(0); // Archive Version 0 FItemList.WriteToFiler(writer); end; end; procedure TgxParticleList.ReadFromFiler(reader: TgxVirtualReader); var archiveVersion: integer; begin inherited ReadFromFiler(reader); archiveVersion := reader.ReadInteger; if archiveVersion = 0 then with reader do begin FItemList.ReadFromFilerWithEvent(reader, AfterItemCreated); FDirectList := PGLParticleArray(FItemList.List); end else RaiseFilerException(archiveVersion); end; function TgxParticleList.GetItems(index: Integer): TgxParticle; begin Result := TgxParticle(FItemList[index]); end; procedure TgxParticleList.SetItems(index: Integer; val: TgxParticle); begin FItemList[index] := val; end; procedure TgxParticleList.AfterItemCreated(Sender: TObject); begin (Sender as TgxParticle).Manager := Self.Owner; end; function TgxParticleList.ItemCount: Integer; begin Result := FItemList.Count; end; function TgxParticleList.AddItem(aItem: TgxParticle): Integer; begin aItem.Manager := Self.Owner; Result := FItemList.Add(aItem); FDirectList := PGLParticleArray(FItemList.List); end; procedure TgxParticleList.RemoveAndFreeItem(aItem: TgxParticle); var i: Integer; begin i := FItemList.IndexOf(aItem); if i >= 0 then begin if aItem.Manager = Self.Owner then aItem.Manager := nil; aItem.Free; FItemList.List^[i] := nil; end; end; function TgxParticleList.IndexOfItem(aItem: TgxParticle): Integer; begin Result := FItemList.IndexOf(aItem); end; procedure TgxParticleList.Pack; begin FItemList.Pack; FDirectList := PGLParticleArray(FItemList.List); end; // ------------------ // ------------------ TgxParticleFXManager ------------------ // ------------------ constructor TgxParticleFXManager.Create(aOwner: TComponent); begin inherited; FUsers := TList.create; FParticles := TgxParticleList.Create; FParticles.Owner := Self; FBlendingMode := bmAdditive; RegisterManager(Self); end; destructor TgxParticleFXManager.Destroy; var i: integer; begin inherited Destroy; for i := FUsers.Count - 1 downto 0 do TgxParticleFXEffect(FUsers[i]).managerNotification(self, opRemove); DeRegisterManager(Self); Renderer := nil; FParticles.Free; FUsers.Free; end; procedure TgxParticleFXManager.NotifyChange(Sender: TObject); begin if Assigned(FRenderer) then Renderer.StructureChanged; end; procedure TgxParticleFXManager.DoProgress(const progressTime: TgxProgressTimes); begin inherited; if FAutoFreeWhenEmpty and (FParticles.ItemCount = 0) then Free; end; class function TgxParticleFXManager.ParticlesClass: TgxParticleClass; begin Result := TgxParticle; end; function TgxParticleFXManager.CreateParticle: TgxParticle; begin Result := ParticlesClass.Create; Result.FID := FNextID; if Assigned(cadencer) then Result.FCreationTime := Cadencer.CurrentTime; Inc(FNextID); FParticles.AddItem(Result); if Assigned(FOnCreateParticle) then FOnCreateParticle(Self, Result); end; procedure TgxParticleFXManager.CreateParticles(nbParticles: Integer); var i: Integer; begin FParticles.FItemList.RequiredCapacity(FParticles.ItemCount + nbParticles); for i := 1 to nbParticles do CreateParticle; end; procedure TgxParticleFXManager.SetRenderer(const val: TgxParticleFXRenderer); begin if FRenderer <> val then begin if Assigned(FRenderer) then FRenderer.UnRegisterManager(Self); FRenderer := val; if Assigned(FRenderer) then FRenderer.RegisterManager(Self); end; end; procedure TgxParticleFXManager.SetParticles(const aParticles: TgxParticleList); begin FParticles.Assign(aParticles); end; function TgxParticleFXManager.ParticleCount: Integer; begin Result := FParticles.FItemList.Count; end; procedure TgxParticleFXManager.ApplyBlendingMode; begin if Renderer.BlendingMode <> BlendingMode then begin // case disjunction to minimize OpenGL State changes if Renderer.BlendingMode in [bmAdditive, bmTransparency] then begin case BlendingMode of bmAdditive: rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); bmTransparency: rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); else // bmOpaque rci.gxStates.Disable(stBlend); end; end else begin case BlendingMode of bmAdditive: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); rci.gxStates.Enable(stBlend); end; bmTransparency: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); rci.gxStates.Enable(stBlend); end; else // bmOpaque, do nothing end; end; end; end; procedure TgxParticleFXManager.UnapplyBlendingMode; begin if Renderer.BlendingMode <> BlendingMode then begin // case disjunction to minimize OpenGL State changes if BlendingMode in [bmAdditive, bmTransparency] then begin case Renderer.BlendingMode of bmAdditive: rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); bmTransparency: rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); else // bmOpaque rci.gxStates.Disable(stBlend); end; end else begin case Renderer.BlendingMode of bmAdditive: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); rci.gxStates.Enable(stBlend); end; bmTransparency: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); rci.gxStates.Enable(stBlend); end; else // bmOpaque, do nothing end; end; end; end; procedure TgxParticleFXManager.RegisterUser(obj: TgxParticleFXEffect); begin if FUsers.IndexOf(obj) = -1 then FUsers.Add(obj); end; procedure TgxParticleFXManager.UnregisterUser(obj: TgxParticleFXEffect); begin FUsers.Remove(obj); end; // ------------------ // ------------------ TgxParticleFXEffect ------------------ // ------------------ constructor TgxParticleFXEffect.Create(aOwner: TXCollection); begin FEffectScale := 1; inherited; end; destructor TgxParticleFXEffect.Destroy; begin Manager := nil; inherited Destroy; end; procedure TgxParticleFXEffect.WriteToFiler(writer: TWriter); var st: string; begin with writer do begin // ArchiveVersion 1, added EffectScale // ArchiveVersion 2, added inherited call WriteInteger(2); inherited; if Manager <> nil then st := Manager.GetNamePath else st := ''; WriteString(st); WriteFloat(FEffectScale); end; end; procedure TgxParticleFXEffect.ReadFromFiler(reader: TReader); var archiveVersion: integer; begin with reader do begin archiveVersion := ReadInteger; Assert(archiveVersion in [0..2]); if archiveVersion >= 2 then inherited; if archiveVersion >= 0 then begin FManagerName := ReadString; Manager := nil; end; if archiveVersion >= 1 then begin FEffectScale := ReadFloat; end; end; end; procedure TgxParticleFXEffect.Loaded; var mng: TComponent; begin inherited; if FManagerName <> '' then begin mng := FindManager(TgxParticleFXManager, FManagerName); if Assigned(mng) then Manager := TgxParticleFXManager(mng); FManagerName := ''; end; end; procedure TgxParticleFXEffect.SetManager(val: TgxParticleFXManager); begin if assigned(FManager) then FManager.unregisterUser(self); FManager := val; if assigned(FManager) then FManager.registerUser(self); end; procedure TgxParticleFXEffect.SetEffectScale(const Value: single); begin FEffectScale := Value; end; procedure TgxParticleFXEffect.managerNotification( aManager: TgxParticleFXManager; Operation: TOperation); begin if (Operation = opRemove) and (aManager = manager) then manager := nil; end; // ------------------ // ------------------ TgxParticleFXRenderer ------------------ // ------------------ constructor TgxParticleFXRenderer.Create(aOwner: TComponent); begin inherited; ObjectStyle := ObjectStyle + [osNoVisibilityCulling, osDirectDraw]; FZTest := True; FZCull := True; FZSortAccuracy := saHigh; FManagerList := TList.Create; FBlendingMode := bmAdditive; end; destructor TgxParticleFXRenderer.Destroy; var i: Integer; begin for i := 0 to cPFXNbRegions - 1 do begin FreeMem(FRegions[i].particleRef); FreeMem(FRegions[i].particleOrder); end; UnRegisterAll; FManagerList.Free; inherited Destroy; end; procedure TgxParticleFXRenderer.RegisterManager(aManager: TgxParticleFXManager); begin FManagerList.Add(aManager); end; procedure TgxParticleFXRenderer.UnRegisterManager(aManager: TgxParticleFXManager); begin FManagerList.Remove(aManager); end; procedure TgxParticleFXRenderer.UnRegisterAll; begin while FManagerList.Count > 0 do TgxParticleFXManager(FManagerList[FManagerList.Count - 1]).Renderer := nil; end; // (beware, large and complex stuff below... this is the heart of the ParticleFX) procedure TgxParticleFXRenderer.BuildList(var rci: TgxRenderContextInfo); (* Quick Explanation of what is below: The purpose is to depth-sort a large number (thousandths) of particles and render them back to front. The rendering part is not particularly complex, it just invokes the various PFX managers involved and request particle renderings. The sort uses a first-pass region partition (the depth range is split into regions, and particles are assigned directly to the region they belong to), then each region is sorted with a QuickSort. The QuickSort itself is the regular classic variant, but the comparison is made on singles as if they were integers, this is allowed by the IEEE format in a very efficient manner if all values are superior to 1, which is ensured by the distance calculation and a fixed offset of 1.*) var dist, distDelta, invRegionSize: Single; managerIdx, particleIdx, regionIdx: Integer; procedure QuickSortRegion(startIndex, endIndex: Integer; region: PPFXRegion); var I, J: Integer; P: Integer; poptr: PPointerArray; buf: Pointer; begin if endIndex - startIndex > 1 then begin poptr := @region^.particleOrder^[0]; repeat I := startIndex; J := endIndex; P := PParticleReference(poptr^[(I + J) shr 1])^.distance; repeat while PParticleReference(poptr^[I])^.distance < P do Inc(I); while PParticleReference(poptr^[J])^.distance > P do Dec(J); if I <= J then begin buf := poptr^[I]; poptr^[I] := poptr^[J]; poptr^[J] := buf; Inc(I); Dec(J); end; until I > J; if startIndex < J then QuickSortRegion(startIndex, J, region); startIndex := I; until I >= endIndex; end else if endIndex - startIndex > 0 then begin poptr := @region^.particleOrder^[0]; if PParticleReference(poptr^[endIndex])^.distance < PParticleReference(poptr^[startIndex])^.distance then begin buf := poptr^[startIndex]; poptr^[startIndex] := poptr^[endIndex]; poptr^[endIndex] := buf; end; end; end; procedure DistToRegionIdx; register; {$IFOPT O-} begin regionIdx := Trunc((dist - distDelta) * invRegionSize); {$ELSE} // !! WARNING !! This may cause incorrect behaviour if optimization is turned // off for the project. asm FLD dist FSUB distDelta FMUL invRegionSize FISTP regionIdx {$ENDIF} end; var minDist, maxDist, sortMaxRegion: Integer; curManager: TgxParticleFXManager; curList: PGLParticleArray; curParticle: TgxParticle; curRegion: PPFXRegion; curParticleOrder: PPointerArray; cameraPos, cameraVector: TAffineVector; timer: Int64; currentTexturingMode: Cardinal; begin if csDesigning in ComponentState then Exit; timer := StartPrecisionTimer; // precalcs PSingle(@minDist)^ := rci.rcci.nearClippingDistance + 1; if ZMaxDistance <= 0 then begin PSingle(@maxDist)^ := rci.rcci.farClippingDistance + 1; invRegionSize := (cPFXNbRegions - 2) / (rci.rcci.farClippingDistance - rci.rcci.nearClippingDistance); end else begin PSingle(@maxDist)^ := rci.rcci.nearClippingDistance + ZMaxDistance + 1; invRegionSize := (cPFXNbRegions - 2) / ZMaxDistance; end; distDelta := rci.rcci.nearClippingDistance + 1 + 0.49999 / invRegionSize; SetVector(cameraPos, rci.cameraPosition); SetVector(cameraVector, rci.cameraDirection); try // Collect particles // only depth-clipping performed as of now. FLastParticleCount := 0; for managerIdx := 0 to FManagerList.Count - 1 do begin curManager := TgxParticleFXManager(FManagerList[managerIdx]); curList := curManager.FParticles.List; Inc(FLastParticleCount, curManager.ParticleCount); for particleIdx := 0 to curManager.ParticleCount - 1 do begin curParticle := curList^[particleIdx]; dist := PointProject(curParticle.FPosition, cameraPos, cameraVector) + 1; if not FZCull then begin if PInteger(@dist)^ < minDist then PInteger(@dist)^ := minDist; end; if (PInteger(@dist)^ >= minDist) and (PInteger(@dist)^ <= maxDist) then begin DistToRegionIdx; curRegion := @FRegions[regionIdx]; // add particle to region if curRegion^.count = curRegion^.capacity then begin Inc(curRegion^.capacity, cPFXGranularity); ReallocMem(curRegion^.particleRef, curRegion^.capacity * SizeOf(TParticleReference)); ReallocMem(curRegion^.particleOrder, curRegion^.capacity * SizeOf(Pointer)); end; with curRegion^.particleRef^[curRegion^.count] do begin particle := curParticle; distance := PInteger(@dist)^; end; Inc(curRegion^.count); end; end; end; // Sort regions case ZSortAccuracy of saLow: sortMaxRegion := 0; saOneTenth: sortMaxRegion := cPFXNbRegions div 10; saOneThird: sortMaxRegion := cPFXNbRegions div 3; saOneHalf: sortMaxRegion := cPFXNbRegions div 2; else sortMaxRegion := cPFXNbRegions; end; for regionIdx := 0 to cPFXNbRegions - 1 do begin curRegion := @FRegions[regionIdx]; if curRegion^.count > 1 then begin // Prepare order table with curRegion^ do for particleIdx := 0 to count - 1 do particleOrder^[particleIdx] := @particleRef[particleIdx]; // QuickSort if (regionIdx < sortMaxRegion) and (FBlendingMode <> bmAdditive) then QuickSortRegion(0, curRegion^.count - 1, curRegion); end else if curRegion^.Count = 1 then begin // Prepare order table curRegion^.particleOrder^[0] := @curRegion^.particleRef[0]; end; end; FLastSortTime := StopPrecisionTimer(timer) * 1000; rci.PipelineTransformation.Push; rci.PipelineTransformation.SetModelMatrix(IdentityHmgMatrix); rci.gxStates.Disable(stCullFace); rci.gxStates.ActiveTextureEnabled[ttTexture2D] := True; currentTexturingMode := 0; rci.gxStates.Disable(stLighting); rci.gxStates.PolygonMode := pmFill; case FBlendingMode of bmAdditive: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOne); rci.gxStates.Enable(stBlend); end; bmTransparency: begin rci.gxStates.SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha); rci.gxStates.Enable(stBlend); end; else // bmOpaque, do nothing end; rci.gxStates.DepthFunc := cfLEqual; if not FZWrite then begin rci.gxStates.DepthWriteMask := False; end; if not FZTest then rci.gxStates.Disable(stDepthTest); try // Initialize managers for managerIdx := 0 to FManagerList.Count - 1 do TgxParticleFXManager(FManagerList.Items[managerIdx]).InitializeRendering(rci); // Start Rendering... at last ;) try curManager := nil; for regionIdx := cPFXNbRegions - 1 downto 0 do begin curRegion := @FRegions[regionIdx]; if curRegion^.count > 0 then begin curParticleOrder := @curRegion^.particleOrder^[0]; for particleIdx := curRegion^.count - 1 downto 0 do begin curParticle := PParticleReference(curParticleOrder^[particleIdx])^.particle; if curParticle.Manager <> curManager then begin if Assigned(curManager) then curManager.EndParticles(rci); curManager := curParticle.Manager; if curManager.TexturingMode <> currentTexturingMode then begin if currentTexturingMode <> 0 then glDisable(currentTexturingMode); currentTexturingMode := curManager.TexturingMode; if currentTexturingMode <> 0 then glEnable(currentTexturingMode); end; curManager.BeginParticles(rci); end; curManager.RenderParticle(rci, curParticle); end; end; end; if Assigned(curManager) then curManager.EndParticles(rci); finally // Finalize managers for managerIdx := 0 to FManagerList.Count - 1 do TgxParticleFXManager(FManagerList.Items[managerIdx]).FinalizeRendering(rci); end; finally rci.PipelineTransformation.Pop; end; rci.gxStates.ActiveTextureEnabled[ttTexture2D] := False; rci.gxStates.DepthWriteMask := True; finally // cleanup for regionIdx := cPFXNbRegions - 1 downto 0 do FRegions[regionIdx].count := 0; end; end; function TgxParticleFXRenderer.StoreZMaxDistance: Boolean; begin Result := (FZMaxDistance <> 0); end; // ------------------ // ------------------ TgxSourcePFXEffect ------------------ // ------------------ constructor TgxSourcePFXEffect.Create(aOwner: TXCollection); begin inherited; FInitialVelocity := TgxCoordinates.CreateInitialized(Self, NullHmgVector, csVector); FInitialPosition := TgxCoordinates.CreateInitialized(Self, NullHmgVector, csPoint); FPositionDispersionRange := TgxCoordinates.CreateInitialized(Self, XYZHmgVector, csPoint); FVelocityDispersion := 0; FPositionDispersion := 0; FParticleInterval := 0.1; FVelocityMode := svmAbsolute; FPositionMode := spmAbsoluteOffset; FDispersionMode := sdmFast; FEnabled := true; FDisabledIfOwnerInvisible := False; end; destructor TgxSourcePFXEffect.Destroy; begin FPositionDispersionRange.Free; FInitialVelocity.Free; FInitialPosition.Free; inherited Destroy; end; class function TgxSourcePFXEffect.FriendlyName: string; begin Result := 'PFX Source'; end; class function TgxSourcePFXEffect.FriendlyDescription: string; begin Result := 'Simple Particles FX Source'; end; procedure TgxSourcePFXEffect.WriteToFiler(writer: TWriter); begin inherited; with writer do begin WriteInteger(6); // ArchiveVersion 6, added FPositionMode // ArchiveVersion 5, added FDisabledIfOwnerInvisible: // ArchiveVersion 4, added FRotationDispersion // ArchiveVersion 3, added FEnabled // ArchiveVersion 2, added FPositionDispersionRange // ArchiveVersion 1, added FDispersionMode FInitialVelocity.WriteToFiler(writer); FInitialPosition.WriteToFiler(writer); FPositionDispersionRange.WriteToFiler(writer); WriteFloat(FVelocityDispersion); WriteFloat(FPositionDispersion); WriteFloat(FParticleInterval); WriteInteger(Integer(FVelocityMode)); WriteInteger(Integer(FDispersionMode)); WriteBoolean(FEnabled); WriteFloat(FRotationDispersion); WriteBoolean(FDisabledIfOwnerInvisible); WriteInteger(Integer(FPositionMode)); end; end; procedure TgxSourcePFXEffect.ReadFromFiler(reader: TReader); var archiveVersion: Integer; begin inherited; with reader do begin archiveVersion := ReadInteger; Assert(archiveVersion in [0..6]); FInitialVelocity.ReadFromFiler(reader); FInitialPosition.ReadFromFiler(reader); if archiveVersion >= 2 then FPositionDispersionRange.ReadFromFiler(reader); FVelocityDispersion := ReadFloat; FPositionDispersion := ReadFloat; FParticleInterval := ReadFloat; FVelocityMode := TgxSourcePFXVelocityMode(ReadInteger); if archiveVersion >= 1 then FDispersionMode := TgxSourcePFXDispersionMode(ReadInteger); if archiveVersion >= 3 then FEnabled := ReadBoolean; if archiveVersion >= 4 then FRotationDispersion := ReadFloat; if archiveVersion >= 5 then FDisabledIfOwnerInvisible := ReadBoolean; if archiveVersion >= 6 then FPositionMode := TgxSourcePFXPositionMode(ReadInteger); end; end; procedure TgxSourcePFXEffect.SetInitialVelocity(const val: TgxCoordinates); begin FInitialVelocity.Assign(val); end; procedure TgxSourcePFXEffect.SetInitialPosition(const val: TgxCoordinates); begin FInitialPosition.Assign(val); end; procedure TgxSourcePFXEffect.SetPositionDispersionRange(const val: TgxCoordinates); begin FPositionDispersionRange.Assign(val); end; procedure TgxSourcePFXEffect.SetParticleInterval(const val: Single); begin if FParticleInterval <> val then begin FParticleInterval := val; if FParticleInterval < 0 then FParticleInterval := 0; if FTimeRemainder > FParticleInterval then FTimeRemainder := FParticleInterval; end; end; procedure TgxSourcePFXEffect.DoProgress(const progressTime: TgxProgressTimes); var n: Integer; begin if Enabled and Assigned(Manager) and (ParticleInterval > 0) then begin if OwnerBaseSceneObject.Visible or (not DisabledIfOwnerInvisible) then begin FTimeRemainder := FTimeRemainder + progressTime.deltaTime; if FTimeRemainder > FParticleInterval then begin n := Trunc((FTimeRemainder - FParticleInterval) / FParticleInterval); Burst(progressTime.newTime, n); FTimeRemainder := FTimeRemainder - n * FParticleInterval; end; end; end; end; function TgxSourcePFXEffect.ParticleAbsoluteInitialPos: TAffineVector; begin if PositionMode = spmRelative then begin Result := OwnerBaseSceneObject.LocalToAbsolute(InitialPosition.AsAffineVector); end else begin SetVector(Result, OwnerBaseSceneObject.AbsolutePosition); AddVector(Result, InitialPosition.AsAffineVector); end; end; procedure TgxSourcePFXEffect.Burst(time: Double; nb: Integer); var particle: TgxParticle; av, pos: TAffineVector; OwnerObjRelPos: TAffineVector; begin if Manager = nil then Exit; OwnerObjRelPos := OwnerBaseSceneObject.LocalToAbsolute(NullVector); pos := ParticleAbsoluteInitialPos; // if FManager is TgxDynamicPFXManager then // TgxDynamicPFXManager(FManager).FRotationCenter := pos; while nb > 0 do begin particle := Manager.CreateParticle; particle.FEffectScale := FEffectScale; RndVector(DispersionMode, av, FPositionDispersion, FPositionDispersionRange); if VelocityMode = svmRelative then av := VectorSubtract(OwnerBaseSceneObject.LocalToAbsolute(av), OwnerObjRelPos); ScaleVector(av, FEffectScale); VectorAdd(pos, av, @particle.Position); RndVector(DispersionMode, av, FVelocityDispersion, nil); VectorAdd(InitialVelocity.AsAffineVector, av, @particle.Velocity); particle.Velocity := VectorScale(particle.Velocity, FEffectScale); if VelocityMode = svmRelative then particle.FVelocity := VectorSubtract(OwnerBaseSceneObject.LocalToAbsolute(particle.FVelocity), OwnerObjRelPos); particle.CreationTime := time; if FRotationDispersion <> 0 then particle.FRotation := Random * FRotationDispersion else particle.FRotation := 0; Dec(nb); end; end; procedure TgxSourcePFXEffect.RingExplosion(time: Double; minInitialSpeed, maxInitialSpeed: Single; nbParticles: Integer); var particle: TgxParticle; av, pos, tmp: TAffineVector; ringVectorX, ringVectorY: TAffineVector; fx, fy, d: Single; begin if (Manager = nil) or (nbParticles <= 0) then Exit; pos := ParticleAbsoluteInitialPos; SetVector(ringVectorY, OwnerBaseSceneObject.AbsoluteUp); SetVector(ringVectorX, OwnerBaseSceneObject.AbsoluteDirection); ringVectorY := VectorCrossProduct(ringVectorX, ringVectorY); while (nbParticles > 0) do begin // okay, ain't exactly an "isotropic" ring... fx := Random - 0.5; fy := Random - 0.5; d := RLength(fx, fy); tmp := VectorCombine(ringVectorX, ringVectorY, fx * d, fy * d); ScaleVector(tmp, minInitialSpeed + Random * (maxInitialSpeed - minInitialSpeed)); AddVector(tmp, InitialVelocity.AsVector); particle := Manager.CreateParticle; with particle do begin RndVector(DispersionMode, av, FPositionDispersion, FPositionDispersionRange); VectorAdd(pos, av, @Position); RndVector(DispersionMode, av, FVelocityDispersion, nil); VectorAdd(tmp, av, @Velocity); if VelocityMode = svmRelative then Velocity := OwnerBaseSceneObject.LocalToAbsolute(Velocity); particle.CreationTime := time; end; Dec(nbParticles); end; end; // ------------------ // ------------------ TPFXLifeColor ------------------ // ------------------ constructor TPFXLifeColor.Create(Collection: TCollection); begin inherited Create(Collection); FColorInner := TgxColor.CreateInitialized(Self, NullHmgVector); FColorOuter := TgxColor.CreateInitialized(Self, NullHmgVector); FLifeTime := 1; FInvLifeTime := 1; FSizeScale := 1; FRotateAngle := 0; end; destructor TPFXLifeColor.Destroy; begin FColorOuter.Free; FColorInner.Free; inherited Destroy; end; procedure TPFXLifeColor.Assign(Source: TPersistent); begin if Source is TPFXLifeColor then begin FColorInner.Assign(TPFXLifeColor(Source).ColorInner); FColorOuter.Assign(TPFXLifeColor(Source).ColorOuter); FLifeTime := TPFXLifeColor(Source).LifeTime; FRotateAngle := TPFXLifeColor(Source).RotateAngle; end else inherited; end; function TPFXLifeColor.GetDisplayName: string; begin Result := Format('LifeTime %f - Inner [%.2f, %.2f, %.2f, %.2f] - Outer [%.2f, %.2f, %.2f, %.2f]', [LifeTime, ColorInner.Red, ColorInner.Green, ColorInner.Blue, ColorInner.Alpha, ColorOuter.Red, ColorOuter.Green, ColorOuter.Blue, ColorOuter.Alpha]); end; procedure TPFXLifeColor.SetColorInner(const val: TgxColor); begin FColorInner.Assign(val); end; procedure TPFXLifeColor.SetColorOuter(const val: TgxColor); begin FColorOuter.Assign(val); end; procedure TPFXLifeColor.SetLifeTime(const val: Single); begin if FLifeTime <> val then begin FLifeTime := val; if FLifeTime <= 0 then FLifeTime := 1e-6; FInvLifeTime := 1 / FLifeTime; end; end; procedure TPFXLifeColor.SetSizeScale(const val: Single); begin if FSizeScale <> val then begin FSizeScale := val; FDoScale := (FSizeScale <> 1); end; end; procedure TPFXLifeColor.SetRotateAngle(const Value: Single); begin if FRotateAngle <> Value then begin FRotateAngle := Value; FDoRotate := (FRotateAngle <> 0); end; end; // ------------------ // ------------------ TPFXLifeColors ------------------ // ------------------ constructor TPFXLifeColors.Create(AOwner: TPersistent); begin inherited Create(AOwner, TPFXLifeColor); end; procedure TPFXLifeColors.SetItems(index: Integer; const val: TPFXLifeColor); begin inherited Items[index] := val; end; function TPFXLifeColors.GetItems(index: Integer): TPFXLifeColor; begin Result := TPFXLifeColor(inherited Items[index]); end; function TPFXLifeColors.Add: TPFXLifeColor; begin Result := (inherited Add) as TPFXLifeColor; end; function TPFXLifeColors.FindItemID(ID: Integer): TPFXLifeColor; begin Result := (inherited FindItemID(ID)) as TPFXLifeColor; end; function TPFXLifeColors.MaxLifeTime: Double; begin if Count > 0 then Result := Items[Count - 1].LifeTime else Result := 1e30; end; function TPFXLifeColors.RotationsDefined: Boolean; var i: Integer; begin for i := 0 to Count - 1 do begin if Items[i].RotateAngle <> 0 then begin Result := True; Exit; end; end; Result := False; end; function TPFXLifeColors.ScalingDefined: Boolean; var i: Integer; begin for i := 0 to Count - 1 do begin if Items[i].SizeScale <> 1 then begin Result := True; Exit; end; end; Result := False; end; procedure TPFXLifeColors.PrepareIntervalRatios; var i: Integer; begin for i := 0 to Count - 2 do Items[i].FIntervalRatio := 1 / (Items[i + 1].LifeTime - Items[i].LifeTime); end; // ------------------ // ------------------ TgxDynamicPFXManager ------------------ // ------------------ constructor TgxDynamicPFXManager.Create(aOwner: TComponent); begin inherited; FAcceleration := TgxCoordinates.CreateInitialized(Self, NullHmgVector, csVector); FFriction := 1; end; destructor TgxDynamicPFXManager.Destroy; begin FAcceleration.Free; inherited Destroy; end; procedure TgxDynamicPFXManager.DoProgress(const progressTime: TgxProgressTimes); var i: Integer; curParticle: TgxParticle; maxAge: Double; {pos, pos1, axis,}accelVector: TAffineVector; {ff,}dt: Single; list: PGLParticleArray; doFriction, doPack: Boolean; frictionScale: Single; //pos4: TVector4f; begin maxAge := MaxParticleAge; accelVector := Acceleration.AsAffineVector; dt := progressTime.deltaTime; doFriction := (FFriction <> 1); if doFriction then begin frictionScale := Power(FFriction, dt) end else frictionScale := 1; FCurrentTime := progressTime.newTime; doPack := False; list := Particles.List; for i := 0 to Particles.ItemCount - 1 do begin curParticle := list^[i]; if (progressTime.newTime - curParticle.CreationTime) < maxAge then begin // particle alive, just update velocity and position with curParticle do begin CombineVector(FPosition, FVelocity, dt); // DanB - this doesn't seem to fit here, rotation is already // calculated when rendering {if (FRotation <> 0) and (Renderer <> nil) then begin pos := FPosition; pos1 := FPosition; ff := 1; CombineVector(pos1, FVelocity, ff); SetVector(axis, Renderer.Scene.CurrentGLCamera.AbsolutePosition); SetVector(axis, VectorSubtract(axis, FRotationCenter)); NormalizeVector(axis); MakeVector(pos4, pos1); pos4[0] := pos4[0] - FRotationCenter[0]; pos4[1] := pos4[1] - FRotationCenter[1]; pos4[2] := pos4[2] - FRotationCenter[2]; RotateVector(pos4, axis, FRotation * dt); pos4[0] := pos4[0] + FRotationCenter[0]; pos4[1] := pos4[1] + FRotationCenter[1]; pos4[2] := pos4[2] + FRotationCenter[2]; MakeVector(pos1, pos4[0], pos4[1], pos4[2]); FVelocity := VectorSubtract(pos1, pos); CombineVector(FPosition, FVelocity, dt); end;} CombineVector(FVelocity, accelVector, dt); if doFriction then ScaleVector(FVelocity, frictionScale); end; end else begin // kill particle curParticle.Free; list^[i] := nil; doPack := True; end; end; if doPack then Particles.Pack; end; procedure TgxDynamicPFXManager.SetAcceleration(const val: TgxCoordinates); begin FAcceleration.Assign(val); end; // ------------------ // ------------------ TgxLifeColoredPFXManager ------------------ // ------------------ constructor TgxLifeColoredPFXManager.Create(aOwner: TComponent); begin inherited; FLifeColors := TPFXLifeColors.Create(Self); FColorInner := TgxColor.CreateInitialized(Self, clrYellow); FColorOuter := TgxColor.CreateInitialized(Self, NullHmgVector); with FLifeColors.Add do begin LifeTime := 3; end; FParticleSize := 1; end; destructor TgxLifeColoredPFXManager.Destroy; begin FLifeColors.Free; FColorInner.Free; FColorOuter.Free; inherited Destroy; end; procedure TgxLifeColoredPFXManager.SetColorInner(const val: TgxColor); begin FColorInner.Assign(val); end; procedure TgxLifeColoredPFXManager.SetColorOuter(const val: TgxColor); begin FColorOuter.Assign(val); end; procedure TgxLifeColoredPFXManager.SetLifeColors(const val: TPFXLifeColors); begin FLifeColors.Assign(Self); end; procedure TgxLifeColoredPFXManager.InitializeRendering(var rci: TgxRenderContextInfo); var i, n: Integer; begin n := LifeColors.Count; FLifeColorsLookup := TList.Create; FLifeColorsLookup.Capacity := n; for i := 0 to n - 1 do FLifeColorsLookup.Add(LifeColors[i]); FLifeRotations := LifeColors.RotationsDefined; FLifeScaling := LifeColors.ScalingDefined; LifeColors.PrepareIntervalRatios; end; procedure TgxLifeColoredPFXManager.FinalizeRendering(var rci: TgxRenderContextInfo); begin FLifeColorsLookup.Free; end; function TgxLifeColoredPFXManager.MaxParticleAge: Single; begin Result := LifeColors.MaxLifeTime; end; procedure TgxLifeColoredPFXManager.ComputeColors(var lifeTime: Single; var inner, outer: TgxColorVector); var i, k, n: Integer; f: Single; lck, lck1: TPFXLifeColor; begin with LifeColors do begin n := Count - 1; if n < 0 then begin inner := ColorInner.Color; outer := ColorOuter.Color; end else begin if n > 0 then begin k := -1; for i := 0 to n do if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then k := i; if k < n then Inc(k); end else k := 0; case k of 0: begin lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); f := lifeTime * lck.InvLifeTime; VectorLerp(ColorInner.Color, lck.ColorInner.Color, f, inner); VectorLerp(ColorOuter.Color, lck.ColorOuter.Color, f, outer); end; else lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]); f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio; VectorLerp(lck1.ColorInner.Color, lck.ColorInner.Color, f, inner); VectorLerp(lck1.ColorOuter.Color, lck.ColorOuter.Color, f, outer); end; end; end; end; procedure TgxLifeColoredPFXManager.ComputeInnerColor(var lifeTime: Single; var inner: TgxColorVector); var i, k, n: Integer; f: Single; lck, lck1: TPFXLifeColor; lifeColorsLookupList: PFXPointerList; begin with LifeColors do begin n := Count - 1; if n < 0 then inner := ColorInner.Color else begin lifeColorsLookupList := @FLifeColorsLookup.List[0]; if n > 0 then begin k := -1; for i := 0 to n do if TPFXLifeColor(lifeColorsLookupList^[i]).LifeTime < lifeTime then k := i; if k < n then Inc(k); end else k := 0; if k = 0 then begin lck := TPFXLifeColor(lifeColorsLookupList^[k]); f := lifeTime * lck.InvLifeTime; VectorLerp(ColorInner.Color, lck.ColorInner.Color, f, inner); end else begin lck := TPFXLifeColor(lifeColorsLookupList^[k]); lck1 := TPFXLifeColor(lifeColorsLookupList^[k - 1]); f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio; VectorLerp(lck1.ColorInner.Color, lck.ColorInner.Color, f, inner); end; end; end; end; procedure TgxLifeColoredPFXManager.ComputeOuterColor(var lifeTime: Single; var outer: TgxColorVector); var i, k, n: Integer; f: Single; lck, lck1: TPFXLifeColor; begin with LifeColors do begin n := Count - 1; if n < 0 then outer := ColorOuter.Color else begin if n > 0 then begin k := -1; for i := 0 to n do if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then k := i; if k < n then Inc(k); end else k := 0; case k of 0: begin lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); f := lifeTime * lck.InvLifeTime; VectorLerp(ColorOuter.Color, lck.ColorOuter.Color, f, outer); end; else lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]); f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio; VectorLerp(lck1.ColorOuter.Color, lck.ColorOuter.Color, f, outer); end; end; end; end; function TgxLifeColoredPFXManager.ComputeSizeScale(var lifeTime: Single; var sizeScale: Single): Boolean; var i, k, n: Integer; f: Single; lck, lck1: TPFXLifeColor; begin with LifeColors do begin n := Count - 1; if n < 0 then Result := False else begin if n > 0 then begin k := -1; for i := 0 to n do if TPFXLifeColor(FLifeColorsLookup.Items[i]).LifeTime < lifeTime then k := i; if k < n then Inc(k); end else k := 0; case k of 0: begin lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); Result := lck.FDoScale; if Result then begin f := lifeTime * lck.InvLifeTime; sizeScale := Lerp(1, lck.SizeScale, f); end; end; else lck := TPFXLifeColor(FLifeColorsLookup.Items[k]); lck1 := TPFXLifeColor(FLifeColorsLookup.Items[k - 1]); Result := lck.FDoScale or lck1.FDoScale; if Result then begin f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio; sizeScale := Lerp(lck1.SizeScale, lck.SizeScale, f); end; end; end; end; end; function TgxLifeColoredPFXManager.ComputeRotateAngle(var lifeTime: Single; var rotateAngle: Single): Boolean; var i, k, n: Integer; f: Single; lck, lck1: TPFXLifeColor; begin with LifeColors do begin n := Count - 1; if n < 0 then Result := False else begin if n > 0 then begin k := -1; for i := 0 to n do if Items[i].LifeTime < lifeTime then k := i; if k < n then Inc(k); end else k := 0; case k of 0: begin lck := LifeColors[k]; Result := lck.FDoRotate; if Result then begin f := lifeTime * lck.InvLifeTime; rotateAngle := Lerp(1, lck.rotateAngle, f); end; end; else lck := LifeColors[k]; lck1 := LifeColors[k - 1]; Result := lck.FDoRotate or lck1.FDoRotate; if Result then begin f := (lifeTime - lck1.LifeTime) * lck1.InvIntervalRatio; rotateAngle := Lerp(lck1.rotateAngle, lck.rotateAngle, f); end; end; end; end; end; procedure TgxLifeColoredPFXManager.RotateVertexBuf(buf: TgxAffineVectorList; lifeTime: Single; const axis: TAffineVector; offsetAngle: Single); var rotateAngle: Single; rotMatrix: TMatrix4f; diff: Single; lifeRotationApplied: Boolean; begin rotateAngle := 0; lifeRotationApplied := ComputeRotateAngle(lifeTime, rotateAngle); rotateAngle := rotateAngle + offsetAngle; if lifeRotationApplied or (rotateAngle <> 0) then begin diff := DegToRad(rotateAngle); rotMatrix := CreateRotationMatrix(axis, diff); buf.TransformAsVectors(rotMatrix); end; end; // ------------------ // ------------------ TgxCustomPFXManager ------------------ // ------------------ procedure TgxCustomPFXManager.DoProgress(const progressTime: TgxProgressTimes); var i: Integer; list: PGLParticleArray; curParticle: TgxParticle; defaultProgress, killParticle, doPack: Boolean; begin if Assigned(FOnProgress) then begin defaultProgress := False; FOnProgress(Self, progressTime, defaultProgress); if defaultProgress then inherited; end else inherited; if Assigned(FOnParticleProgress) then begin doPack := False; list := Particles.List; for i := 0 to Particles.ItemCount - 1 do begin killParticle := True; curParticle := list^[i]; FOnParticleProgress(Self, progressTime, curParticle, killParticle); if killParticle then begin curParticle.Free; list^[i] := nil; doPack := True; end; end; if doPack then Particles.Pack; end; end; function TgxCustomPFXManager.TexturingMode: Cardinal; begin Result := 0; end; procedure TgxCustomPFXManager.InitializeRendering(var rci: TgxRenderContextInfo); begin inherited; if Assigned(FOnInitializeRendering) then FOnInitializeRendering(Self, rci); end; procedure TgxCustomPFXManager.BeginParticles(var rci: TgxRenderContextInfo); begin if Assigned(FOnBeginParticles) then FOnBeginParticles(Self, rci); end; procedure TgxCustomPFXManager.RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); begin if Assigned(FOnRenderParticle) then FOnRenderParticle(Self, aParticle, rci); end; procedure TgxCustomPFXManager.EndParticles(var rci: TgxRenderContextInfo); begin if Assigned(FOnEndParticles) then FOnEndParticles(Self, rci); end; procedure TgxCustomPFXManager.FinalizeRendering(var rci: TgxRenderContextInfo); begin if Assigned(FOnFinalizeRendering) then FOnFinalizeRendering(Self, rci); inherited; end; function TgxCustomPFXManager.ParticleCount: Integer; begin if Assigned(FOnGetParticleCountEvent) then Result := FOnGetParticleCountEvent(Self) else Result := FParticles.FItemList.Count; end; // ------------------ // ------------------ TgxPolygonPFXManager ------------------ // ------------------ constructor TgxPolygonPFXManager.Create(aOwner: TComponent); begin inherited; FNbSides := 6; end; destructor TgxPolygonPFXManager.Destroy; begin inherited Destroy; end; procedure TgxPolygonPFXManager.SetNbSides(const val: Integer); begin if val <> FNbSides then begin FNbSides := val; if FNbSides < 3 then FNbSides := 3; NotifyChange(Self); end; end; function TgxPolygonPFXManager.TexturingMode: Cardinal; begin Result := 0; end; procedure TgxPolygonPFXManager.InitializeRendering(var rci: TgxRenderContextInfo); var i: Integer; matrix: TMatrix4f; s, c: Single; begin inherited; glGetFloatv(GL_MODELVIEW_MATRIX, @matrix); for i := 0 to 2 do begin Fvx.V[i] := matrix.V[i].X * FParticleSize; Fvy.V[i] := matrix.V[i].Y * FParticleSize; end; FVertices := TgxAffineVectorList.Create; FVertices.Capacity := FNbSides; for i := 0 to FNbSides - 1 do begin SinCos(i * c2PI / FNbSides, s, c); FVertices.Add(VectorCombine(FVx, Fvy, c, s)); end; FVertBuf := TgxAffineVectorList.Create; FVertBuf.Count := FVertices.Count; end; procedure TgxPolygonPFXManager.BeginParticles(var rci: TgxRenderContextInfo); begin ApplyBlendingMode(rci); end; procedure TgxPolygonPFXManager.RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); var i: Integer; lifeTime, sizeScale: Single; inner, outer: TgxColorVector; pos: TAffineVector; vertexList: PAffineVectorArray; begin lifeTime := FCurrentTime - aParticle.CreationTime; ComputeColors(lifeTime, inner, outer); pos := aParticle.Position; vertexList := FVertBuf.List; // copy vertices for I := 0 to FVertBuf.Count - 1 do vertexList[i] := FVertices[i]; // rotate vertices (if needed) if FLifeRotations or (aParticle.FRotation <> 0) then RotateVertexBuf(FVertBuf, lifeTime, AffineVectorMake(rci.cameraDirection), aParticle.FRotation); // scale vertices (if needed) then translate to particle position if FLifeScaling or (aParticle.FEffectScale <> 1) then begin if FLifeScaling and ComputeSizeScale(lifeTime, sizeScale) then sizeScale := sizeScale * aParticle.FEffectScale else sizeScale := aParticle.FEffectScale; for i := 0 to FVertBuf.Count - 1 do vertexList^[i] := VectorCombine(vertexList^[i], pos, sizeScale, 1); end else FVertBuf.Translate(pos); glBegin(GL_TRIANGLE_FAN); glColor4fv(@inner); glVertex3fv(@pos); glColor4fv(@outer); for i := 0 to FVertBuf.Count - 1 do glVertex3fv(@vertexList[i]); glVertex3fv(@vertexList[0]); glEnd; end; procedure TgxPolygonPFXManager.EndParticles(var rci: TgxRenderContextInfo); begin UnapplyBlendingMode(rci); end; procedure TgxPolygonPFXManager.FinalizeRendering(var rci: TgxRenderContextInfo); begin FVertBuf.Free; FVertices.Free; inherited; end; // ------------------ // ------------------ TgxBaseSpritePFXManager ------------------ // ------------------ constructor TgxBaseSpritePFXManager.Create(aOwner: TComponent); begin inherited; FTexHandle := TgxTextureHandle.Create; FSpritesPerTexture := sptOne; FAspectRatio := 1; end; destructor TgxBaseSpritePFXManager.Destroy; begin FTexHandle.Free; FShareSprites := nil; inherited Destroy; end; procedure TgxBaseSpritePFXManager.SetSpritesPerTexture(const val: TSpritesPerTexture); begin if val <> FSpritesPerTexture then begin FSpritesPerTexture := val; FTexHandle.DestroyHandle; NotifyChange(Self); end; end; procedure TgxBaseSpritePFXManager.SetColorMode(const val: TSpriteColorMode); begin if val <> FColorMode then begin FColorMode := val; NotifyChange(Self); end; end; procedure TgxBaseSpritePFXManager.SetAspectRatio(const val: Single); begin if FAspectRatio <> val then begin FAspectRatio := ClampValue(val, 1e-3, 1e3); NotifyChange(Self); end; end; function TgxBaseSpritePFXManager.StoreAspectRatio: Boolean; begin Result := (FAspectRatio <> 1); end; procedure TgxBaseSpritePFXManager.SetRotation(const val: Single); begin if FRotation <> val then begin FRotation := val; NotifyChange(Self); end; end; procedure TgxBaseSpritePFXManager.SetShareSprites(const val: TgxBaseSpritePFXManager); begin if FShareSprites <> val then begin if Assigned(FShareSprites) then FShareSprites.RemoveFreeNotification(Self); FShareSprites := val; if Assigned(FShareSprites) then FShareSprites.FreeNotification(Self); end; end; procedure TgxBaseSpritePFXManager.BindTexture(var rci: TgxRenderContextInfo); var bmp32: TgxBitmap32; tw, th, td, tf: Integer; begin if Assigned(FShareSprites) then FShareSprites.BindTexture(rci) else begin if FTexHandle.Handle = 0 then begin FTexHandle.AllocateHandle; FTexHandle.Target := ttTexture2D; rci.gxStates.TextureBinding[0, ttTexture2D] := FTexHandle.Handle; glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); rci.gxStates.UnpackAlignment := 4; rci.gxStates.UnpackRowLength := 0; rci.gxStates.UnpackSkipRows := 0; rci.gxStates.UnpackSkipPixels := 0; glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); bmp32 := TgxBitmap32.Create; try tf := GL_RGBA; PrepareImage(bmp32, tf); bmp32.RegisterAsOpenRXTexture( FTexHandle, True, tf, tw, th, td); finally bmp32.Free; end; end else begin rci.gxStates.TextureBinding[0, ttTexture2D] := FTexHandle.Handle; end; end; end; function TgxBaseSpritePFXManager.TexturingMode: Cardinal; begin Result := GL_TEXTURE_2D; end; procedure TgxBaseSpritePFXManager.InitializeRendering(var rci: TgxRenderContextInfo); var i: Integer; matrix: TMatrix4f; s, c, w, h: Single; begin inherited; glGetFloatv(GL_MODELVIEW_MATRIX, @matrix); w := FParticleSize * Sqrt(FAspectRatio); h := Sqr(FParticleSize) / w; for i := 0 to 2 do begin Fvx.V[i] := matrix.V[i].X * w; Fvy.V[i] := matrix.V[i].Y * h; Fvz.V[i] := matrix.V[i].Z; end; FVertices := TgxAffineVectorList.Create; for i := 0 to 3 do begin SinCos(i * cPIdiv2 + cPIdiv4, s, c); FVertices.Add(VectorCombine(Fvx, Fvy, c, s)); end; if FRotation <> 0 then begin matrix := CreateRotationMatrix(Fvz, -FRotation); FVertices.TransformAsPoints(matrix); end; FVertBuf := TgxAffineVectorList.Create; FVertBuf.Count := FVertices.Count; end; procedure TgxBaseSpritePFXManager.BeginParticles(var rci: TgxRenderContextInfo); begin BindTexture(rci); if ColorMode = scmNone then glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE) else glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); ApplyBlendingMode(rci); if ColorMode <> scmFade then glBegin(GL_QUADS); end; procedure TgxBaseSpritePFXManager.RenderParticle(var rci: TgxRenderContextInfo; aParticle: TgxParticle); type TTexCoordsSet = array[0..3] of TTexPoint; PTexCoordsSet = ^TTexCoordsSet; const cBaseTexCoordsSet: TTexCoordsSet = ((S: 1; T: 1), (S: 0; T: 1), (S: 0; T: 0), (S: 1; T: 0)); cTexCoordsSets: array[0..3] of TTexCoordsSet = (((S: 1.0; T: 1.0), (S: 0.5; T: 1.0), (S: 0.5; T: 0.5), (S: 1.0; T: 0.5)), ((S: 0.5; T: 1.0), (S: 0.0; T: 1.0), (S: 0.0; T: 0.5), (S: 0.5; T: 0.5)), ((S: 1.0; T: 0.5), (S: 0.5; T: 0.5), (S: 0.5; T: 0.0), (S: 1.0; T: 0.0)), ((S: 0.5; T: 0.5), (S: 0.0; T: 0.5), (S: 0.0; T: 0.0), (S: 0.5; T: 0.0))); var lifeTime, sizeScale: Single; inner, outer: TgxColorVector; pos: TAffineVector; vertexList: PAffineVectorArray; i: Integer; tcs: PTexCoordsSet; spt: TSpritesPerTexture; procedure IssueVertices; begin glTexCoord2fv(@tcs[0]); glVertex3fv(@vertexList[0]); glTexCoord2fv(@tcs[1]); glVertex3fv(@vertexList[1]); glTexCoord2fv(@tcs[2]); glVertex3fv(@vertexList[2]); glTexCoord2fv(@tcs[3]); glVertex3fv(@vertexList[3]); end; begin lifeTime := FCurrentTime - aParticle.CreationTime; if Assigned(ShareSprites) then spt := ShareSprites.SpritesPerTexture else spt := SpritesPerTexture; case spt of sptFour: tcs := @cTexCoordsSets[(aParticle.ID and 3)]; else tcs := @cBaseTexCoordsSet; end; pos := aParticle.Position; vertexList := FVertBuf.List; sizeScale := 1; // copy vertices for i := 0 to FVertBuf.Count - 1 do vertexList^[i] := FVertices[i]; // rotate vertices (if needed) if FLifeRotations or (aParticle.FRotation <> 0) then RotateVertexBuf(FVertBuf, lifeTime, AffineVectorMake(rci.cameraDirection), aParticle.FRotation); // scale vertices (if needed) then translate to particle position if FLifeScaling or (aParticle.FEffectScale <> 1) then begin if FLifeScaling and ComputeSizeScale(lifeTime, sizeScale) then sizeScale := sizeScale * aParticle.FEffectScale else sizeScale := aParticle.FEffectScale; for i := 0 to FVertBuf.Count - 1 do vertexList^[i] := VectorCombine(vertexList^[i], pos, sizeScale, 1); end else FVertBuf.Translate(pos); case ColorMode of scmFade: begin ComputeColors(lifeTime, inner, outer); glBegin(GL_TRIANGLE_FAN); glColor4fv(@inner); glTexCoord2f((tcs^[0].S + tcs^[2].S) * 0.5, (tcs^[0].T + tcs^[2].T) * 0.5); glVertex3fv(@pos); glColor4fv(@outer); IssueVertices; glTexCoord2fv(@tcs[0]); glVertex3fv(@vertexList[0]); glEnd; end; scmInner: begin ComputeInnerColor(lifeTime, inner); glColor4fv(@inner); IssueVertices; end; scmOuter: begin ComputeOuterColor(lifeTime, outer); glColor4fv(@outer); IssueVertices; end; scmNone: begin IssueVertices; end; else Assert(False); end; end; procedure TgxBaseSpritePFXManager.EndParticles(var rci: TgxRenderContextInfo); begin if ColorMode <> scmFade then glEnd; UnApplyBlendingMode(rci); end; procedure TgxBaseSpritePFXManager.FinalizeRendering(var rci: TgxRenderContextInfo); begin FVertBuf.Free; FVertices.Free; inherited; end; // ------------------ // ------------------ TgxCustomSpritePFXManager ------------------ // ------------------ constructor TgxCustomSpritePFXManager.Create(aOwner: TComponent); begin inherited; FColorMode := scmInner; FSpritesPerTexture := sptOne; end; destructor TgxCustomSpritePFXManager.Destroy; begin inherited Destroy; end; procedure TgxCustomSpritePFXManager.PrepareImage(bmp32: TgxBitmap32; var texFormat: Integer); begin if Assigned(FOnPrepareTextureImage) then FOnPrepareTextureImage(Self, bmp32, texFormat); end; // ------------------ // ------------------ TgxPointLightPFXManager ------------------ // ------------------ constructor TgxPointLightPFXManager.Create(aOwner: TComponent); begin inherited; FTexMapSize := 5; FColorMode := scmInner; end; destructor TgxPointLightPFXManager.Destroy; begin inherited Destroy; end; procedure TgxPointLightPFXManager.SetTexMapSize(const val: Integer); begin if val <> FTexMapSize then begin FTexMapSize := val; if FTexMapSize < 3 then FTexMapSize := 3; if FTexMapSize > 9 then FTexMapSize := 9; NotifyChange(Self); end; end; procedure TgxPointLightPFXManager.PrepareImage(bmp32: TgxBitmap32; var texFormat: Integer); var s: Integer; x, y, d, h2: Integer; ih2, f, fy: Single; scanLine1, scanLine2: PgxPixel32Array; begin s := (1 shl TexMapSize); bmp32.Width := s; bmp32.Height := s; bmp32.Blank := false; texFormat := GL_LUMINANCE_ALPHA; h2 := s div 2; ih2 := 1 / h2; for y := 0 to h2 - 1 do begin fy := Sqr((y + 0.5 - h2) * ih2); scanLine1 := bmp32.ScanLine[y]; scanLine2 := bmp32.ScanLine[s - 1 - y]; for x := 0 to h2 - 1 do begin f := Sqr((x + 0.5 - h2) * ih2) + fy; if f < 1 then begin d := Trunc((1 - Sqrt(f)) * 256); d := d + (d shl 8) + (d shl 16) + (d shl 24); end else d := 0; PInteger(@scanLine1[x])^ := d; PInteger(@scanLine2[x])^ := d; PInteger(@scanLine1[s - 1 - x])^ := d; PInteger(@scanLine2[s - 1 - x])^ := d; end; end; end; // ------------------------------------------------------------------ initialization // ------------------------------------------------------------------ RegisterClasses([TgxParticle, TgxParticleList, TgxParticleFXEffect, TgxParticleFXRenderer, TgxCustomPFXManager, TgxPolygonPFXManager, TgxCustomSpritePFXManager, TgxPointLightPFXManager]); RegisterXCollectionItemClass(TgxSourcePFXEffect); finalization UnregisterXCollectionItemClass(TgxSourcePFXEffect); end.