// GLParticles
{: Egg<p>

	Particle systems for GLScene<p>

	<b>Historique : </b><font size=-1><ul>
		<li>17/04/00 - Egg - Added Assign, Removed ActivateParticle
	   <li>16/04/00 - Egg - Creation
	</ul></font>
}
unit GLParticles;

interface

uses Classes, GLScene, Geometry, OpenGL12, GLTexture, GLMisc;

type

   TGLParticleEvent = procedure (Sender : TObject; particle : TGLBaseSceneObject) of object;

	// TGLParticles
	//
	{: Manager object of a particle system.<p>
		Particle systems in GLScene are described as normal scene objects,
		however their children are to be :<ul>
		<li>"particle template" : the first object (index=0), this one will be
			duplicated to create new particles, it does not receive progression
			events and is visible at design-time only.
		<li>"live particle" : the other objects (index>0), this ones are rendered
			and receive progression events.
		</ul><br>TGLParticles may also maintain an internal, non-persistent
		("freezed") set of objects : the allocated objects pool. Why ? Creating
		and freeing objects takes cpu-cycles, especially for the TComponent class,
		and GLScene objects are TComponent. To reduce this load (and at the expense
		of memory space), the particle systems can move "dead" particles to a pool
		instead of freeing them, and will pick in the pool instead of creating
		new objects when new particles are requested. To take advantage of this
		behaviour, you should set the ParticlePoolSize property to a non-null
		value and use the KillParticle function instead of "Free" to kill a
      particle.<p>
      All direct access to a TGLParticles children should be avoided.
	}
	TGLParticles = class (TGLImmaterialSceneObject)
		private
			{ Private Declarations }
			FCubeSize : TGLFloat;
			FEdgeColor : TGLColor;
			FVisibleAtRunTime : Boolean;
			particlePool : TList;
         FParticlePoolSize : Integer;
         FOnCreateParticle : TGLParticleEvent;
         FOnActivateParticle : TGLParticleEvent;
         FOnKillParticle : TGLParticleEvent;
         FOnDestroyParticle : TGLParticleEvent;

		protected
			{ Protected Declarations }
			procedure SetCubeSize(const val : TGLFloat);
			procedure SetEdgeColor(const val : TGLColor);
			procedure SetVisibleAtRunTime(const val : Boolean);
			procedure SetParticlePoolSize(val : Integer);

			procedure ClearParticlePool;

		public
			{ Public Declarations }
			constructor Create(AOwner : TComponent); override;
			destructor Destroy; override;

			procedure Assign(Source: TPersistent); override;
			procedure BuildList(var rci : TRenderContextInfo); override;
			procedure DoRender(var rci : TRenderContextInfo); override;
			procedure DoProgress(const deltaTime, newTime : Double); override;

			{: Request creation of a new particle.<p>
				Particle will be either created or retrieved from the particlePool. }
			function CreateParticle : TGLBaseSceneObject;
			{: Kill given particle.<p>
				If particlePool is not full, particle will be sent to the pool,
				if not, it will be freed. }
			procedure KillParticle(aParticle : TGLBaseSceneObject);

		published
			{ Published Declarations }
			property CubeSize : TGLFloat read FCubeSize write SetCubeSize;
			property EdgeColor : TGLColor read FEdgeColor write SetEdgeColor;
			property VisibleAtRunTime : Boolean read FVisibleAtRunTime write SetVisibleAtRunTime default False;

			{: Size of the particle pool (for storing killed particles).<p>
            Default size is zero, meaning the particlePool is disabled. }
			property ParticlePoolSize : Integer read FParticlePoolSize write SetParticlePoolSize default 0; 

         {: Fired a particle has been created as a template duplicate.<p>
            When the event is triggered, the particle has yet been added  to
            the scene. }
         property OnCreateParticle : TGLParticleEvent read FOnCreateParticle write FOnCreateParticle;
         {: Fired when a particle will get in the "live" list.<p>
            The particle has just been "Assigned" with the template, may happen
            after a creation or a pick from the particle pool. }
         property OnActivateParticle : TGLParticleEvent read FOnActivateParticle write FOnActivateParticle;
			{: Triggered when a particle is killed.<p>
            When the event is fired, the particle is still parented, after this
            event, the particle will either go to the pool or be destroyed if
            the pool is full. }
         property OnKillParticle : TGLParticleEvent read FOnKillParticle write FOnKillParticle;
         {: Triggered just before destroying a particle.<p>
            The particle can be in the pool (ie. not parented). }
         property OnDestroyParticle : TGLParticleEvent read FOnDestroyParticle write FOnDestroyParticle;
	end;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

uses SysUtils;

//----------------- TGLParticles -----------------------------------------------------

// Create
//
constructor TGLParticles.Create(AOwner : TComponent);
begin
	inherited;
   ObjectStyle:=ObjectStyle+[osDirectDraw];
	FCubeSize:=1;
	FEdgeColor:=TGLColor.Create(Self);
	FEdgeColor.Initialize(clrWhite);
	particlePool:=TList.Create;
end;

// Destroy
//
destructor TGLParticles.Destroy;
begin
	ClearParticlePool;
	particlePool.Free;
	inherited;
end;

// Assign
//
procedure TGLParticles.Assign(Source: TPersistent);
begin
	if Source is TGLParticles then begin
		FCubeSize:=TGLParticles(Source).FCubeSize;
		FEdgeColor.Color:=TGLParticles(Source).FEdgeColor.Color;
		FVisibleAtRunTime:=TGLParticles(Source).FVisibleAtRunTime;
		ClearParticlePool;
		FParticlePoolSize:=TGLParticles(Source).FParticlePoolSize;
		FOnCreateParticle:=TGLParticles(Source).FOnCreateParticle;
		FOnActivateParticle:=TGLParticles(Source).FOnActivateParticle;
		FOnKillParticle:=TGLParticles(Source).FOnKillParticle;
		FOnDestroyParticle:=TGLParticles(Source).FOnDestroyParticle;
	end;
	inherited Assign(Source);
end;

// ClearParticlePool
//
procedure TGLParticles.ClearParticlePool;
var
	particle : TGLBaseSceneObject;
	i : Integer;
begin
	if Assigned(FOnDestroyParticle) then begin
		for i:=0 to particlePool.Count-1 do begin
			particle:=TGLBaseSceneObject(particlePool[i]);
			FOnDestroyParticle(Self, particle);
			particle.Free;
		end;
	end else for i:=0 to particlePool.Count-1 do
		TGLBaseSceneObject(particlePool[i]).Free;
	particlePool.Clear;
end;

// BuildList
//
procedure TGLParticles.BuildList(var rci : TRenderContextInfo);
var
	mi, ma : Single;
begin
   glPushAttrib(GL_ENABLE_BIT or GL_CURRENT_BIT or GL_LIGHTING_BIT or GL_LINE_BIT or GL_COLOR_BUFFER_BIT);
   glDisable(GL_LIGHTING);
   glEnable(GL_LINE_STIPPLE);
   glEnable(GL_LINE_SMOOTH);
   glEnable(GL_BLEND);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
   glLineWidth(1);
   glLineStipple(1, $AAAA);
   ma:=FCubeSize*0.5;
   mi:=-ma;
   with EdgeColor do glColor3f(Color[0], Color[1], Color[2]);
   glBegin(GL_LINE_STRIP);
      // front face
      glVertex3f(ma, mi, mi); glVertex3f(ma, ma, mi);
      glVertex3f(ma, ma, ma); glVertex3f(ma, mi, ma);
      glVertex3f(ma, mi, mi);
      // partial up back fac
      glVertex3f(mi, mi, mi); glVertex3f(mi, mi, ma);
      glVertex3f(mi, ma, ma); glVertex3f(mi, ma, mi);
      // right side low
      glVertex3f(ma, ma, mi);
   glEnd;
   glBegin(GL_LINES);
      // right high
      glVertex3f(ma, ma, ma);	glVertex3f(mi, ma, ma);
      // back low
      glVertex3f(mi, mi, mi); glVertex3f(mi, ma, mi);
      // left high
      glVertex3f(ma, mi, ma); glVertex3f(mi, mi, ma);
   glEnd;
   glPopAttrib;
end;

// DoRender
//
procedure TGLParticles.DoRender(var rci : TRenderContextInfo);
begin
   if (csDesigning in ComponentState) or (FVisibleAtRunTime) then
      BuildList(rci);
   if csDesigning in ComponentState then begin
      // design-time, everything is visible for user convenience
      if Count>0 then
         RenderChildren(0, Count-1, rci);
   end else begin
      // run-time, template is NOT visible
      if Count>1 then
         RenderChildren(1, Count-1, rci);
   end;
end;

// DoProgress
//
procedure TGLParticles.DoProgress(const deltaTime, newTime : Double);
var
   i : Integer;
begin
	for i:=Count-1 downto 1 do
		Children[i].DoProgress(deltaTime, newTime);
	Behaviours.DoProgress(deltaTime, newTime);
   if Assigned(OnProgress) then
		OnProgress(Self, deltaTime, newTime);
end;

// SetCubeSize
//
procedure TGLParticles.SetCubeSize(const val : TGLFloat);
begin
	if val<>FCubeSize then begin
		FCubeSize:=val;
		StructureChanged;
	end;
end;

// SetEdgeColor
//
procedure TGLParticles.SetEdgeColor(const val : TGLColor);
begin
	if val<>FEdgeColor then begin
		FEdgeColor.Assign(val);
		StructureChanged;
	end;
end;

// SetVisibleAtRunTime
//
procedure TGLParticles.SetVisibleAtRunTime(const val : Boolean);
begin
	if val<>FVisibleAtRunTime then begin
		FVisibleAtRunTime:=val;
		StructureChanged;
	end;
end;

// SetParticlePoolSize
//
procedure TGLParticles.SetParticlePoolSize(val : Integer);
var
   particle : TGLBaseSceneObject;
begin
	if val<0 then val:=0;
	if FParticlePoolSize<>val then begin
		FParticlePoolSize:=val;
      with particlePool do while Count>val do begin
         particle:=TGLBaseSceneObject(Items[Count-1]);
         if Assigned(FOnDestroyParticle) then
            FOnDestroyParticle(Self, particle);
         particle.Free;
         Delete(Count-1);
      end;
   end;
end;

// CreateParticle
//
function TGLParticles.CreateParticle : TGLBaseSceneObject;
begin
   if Count>0 then begin
		if particlePool.Count>0 then begin
			Result:=TGLBaseSceneObject(particlePool[particlePool.Count-1]);
			particlePool.Delete(particlePool.Count-1);
			Result.Assign(Children[0]);
		end else begin
			Result:=TGLSceneObjectClass(Children[0].ClassType).Create(Self);
			Result.Assign(Children[0]);
			if Assigned(FOnCreateParticle) then
				FOnCreateParticle(Self, Result);
		end;
		AddChild(Result);
		if Assigned(FOnActivateParticle) then
         FOnActivateParticle(Self, Result);
   end else Result:=nil;
end;

// KillParticle
//
procedure TGLParticles.KillParticle(aParticle : TGLBaseSceneObject);
begin
	Assert(aParticle.Parent=Self, 'KillParticle : particle is not mine !');
   if Assigned(FOnKillParticle) then
      FOnKillParticle(Self, aParticle);
	if particlePool.Count<FParticlePoolSize then begin
		Remove(aParticle, False);
		particlePool.Add(aParticle)
	end else begin
      if Assigned(FOnDestroyParticle) then
         FOnDestroyParticle(Self, aParticle);
      aParticle.Free;
   end;
end;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
initialization
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

   RegisterClass(TGLParticles);

end.

