{: GLFireFX<p>

	Fire special effect<p>

	<b>Historique : </b><font size=-1><ul>
      <li>13/01/01 - Egg - Another matrix compatibility update
      <li>22/12/00 - Egg - Compatibility for new Matrix rules, and sometime
                           ago, added in all new props from Danjel Grosar 
      <li>11/08/00 - Egg - A few speedups/enhancements
	   <li>08/08/00 - Egg - Creation, based on Roger Cao's "FireEffectUnit"
	</ul></font>
}
unit GLFireFX;

interface

uses Windows, Classes, GLScene, GLMisc, XCollection, Geometry, Graphics,
   GLTexture, GLCadencer;

type

   PFireParticle = ^TFireParticle;
   TFireParticle = record
      Position : TVector;  // Position
      V : TVector;         // dp/dt
      Alpha : Single;      // alpha
      T : Double;          // Time to die
   end;
   TFireParticleArray = array [0..MAXINT shr 6]of TFireParticle;
   PFireParticleArray = ^TFireParticleArray;

   TGLBFireFX = class;

	// TGLFireFXManager
	//
   {: Fire special effect manager. }
	TGLFireFXManager = class (TGLCadenceAbleComponent)
	   private
	      { Private Declarations }
         FClients : TList;
         FFireParticles : PFireParticleArray;
         FFireDir : TGLCoordinates;
         FCadencer : TGLCadencer;
         FMaxParticles, FParticleLife : Integer;
         FParticleSize, FFireDensity, FFireEvaporation,
         FFireCrown, FparticleInterval, IntervalDelta : single;
         NP : Integer;
         FInnerColor, FOuterColor: TGLColor;
         FFireBurst, FFireBlaze, FFireSowing : byte;
         FDisabled, FPaused, FUseInterval : boolean;

	   protected
	      { Protected Declarations }
	      procedure RegisterClient(aClient : TGLBFireFX);
	      procedure DeRegisterClient(aClient : TGLBFireFX);
	      procedure DeRegisterAllClients;

         procedure SetFireDir(const val : TGLCoordinates);
         procedure SetCadencer(const val : TGLCadencer);
         procedure SetMaxParticles(const val : Integer);
         function StoreParticleSize : Boolean;
         procedure SetInnerColor(const val : TGLcolor);
         procedure SetOuterColor(const val : TGLcolor);
         Procedure SetFireDensity(const val : single);
         Procedure SetFireEvaporation(const val : single);
         Procedure SetFireCrown(const val : single);
         Procedure SetParticleLife(const val : integer);
         Procedure SetFireBurst(const val : byte);
         Procedure SetFireBlaze(const val : byte);
         Procedure SetFireSowing(const val : byte);
         Procedure SetParticleInterval(const val : single);

			procedure Notification(AComponent: TComponent; Operation: TOperation); override;

         procedure FireInit;
         procedure CalcFire(deltaTime : Double; ParticleInterval, ParticleLife: Single;
                            FireAlpha: Single);
         procedure AffParticle3d(Color2: TColorVector; const mat : TMatrix);

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

			procedure DoProgress(const deltaTime, newTime : Double); override;

		published
			{ Published Declarations }
          property FireDir : TGLCoordinates read FFireDir write SetFireDir;
          property Cadencer : TGLCadencer read FCadencer write SetCadencer;
          property MaxParticles : Integer read FMaxParticles write SetMaxParticles default 256;
          property ParticleSize : Single read FParticleSize write FParticleSize stored StoreParticleSize;
          property InnerColor : TGLcolor read FInnerColor write SetInnerColor;
          property OuterColor : TGLcolor read FOuterColor write SetOuterColor;// default clrWhite;
          property FireDensity : Single read FFireDensity write SetFireDensity;
          property FireEvaporation : Single read FFireEvaporation write SetFireEvaporation;
          property FireCrown : Single read FFireCrown write SetFireCrown;
          property ParticleLife : integer read FParticleLife write SetParticleLife default 3;
          property FireBurst : byte read FFireBurst write SetFireBurst default 5;
          property FireBlaze : byte read FFireBlaze write SetFireBlaze default 0;
          property FireSowing : byte read FFireSowing write SetFireSowing default 0;
          property Disabled : boolean read FDisabled write FDisabled;
          property Paused : boolean read FPaused write FPaused;
          property ParticleInterval : single read FParticleInterval write SetParticleInterval;
          property UseInterval : boolean read FUseInterval write FUseInterval;
	end;

  	// TGLBFireFX
	//
	{: Fire special effect }
	TGLBFireFX = class (TGLObjectPostEffect)
		private
			{ Private Declarations }
         FManager : TGLFireFXManager;
         FManagerName : String; // NOT persistent, temporarily used for persistence

		protected
			{ Protected Declarations }
         procedure SetManager(const val : TGLFireFXManager);

			procedure WriteToFiler(writer : TWriter); override;
         procedure ReadFromFiler(reader : TReader); override;
         procedure Loaded; override;

		public
			{ Public Declarations }
			constructor Create(aOwner : TXCollection); override;
			destructor Destroy; override;

         procedure Assign(Source: TPersistent); override;

			class function FriendlyName : String; override;
			class function FriendlyDescription : String; override;

         procedure Render(sceneViewer : TGLSceneViewer;
								  var rci : TRenderContextInfo); override;

		published
			{ Published Declarations }
         {: Refers the collision manager. }
         property Manager : TGLFireFXManager read FManager write SetManager;
	end;

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

uses SysUtils, OpenGL12, VectorLists;

// ------------------
// ------------------ TGLFireFXManager ------------------
// ------------------

// Create
//
constructor TGLFireFXManager.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
   FClients:=TList.Create;
   RegisterManager(Self);
   FFireDir:=TGLCoordinates.CreateInitialized(Self, VectorMake(0, 0.5, 0));
   FMaxParticles:=256;
   FParticleSize:=1.0;
   FInnerColor:=TGLColor.Create(Self);
   FInnerColor.Initialize(clrYellow);
   FOuterColor:=TGLColor.Create(Self);
   FOuterColor.Initialize(clrOrange);
   FFireDensity:=0.3;
   FFireEvaporation:=0.86;
   FFireCrown:=0;
   FParticleLife:=3;
   FFireBurst:=5;
   FFireBlaze:=0;
   FFireSowing:=0;
   FParticleInterval:=10;
   FDisabled:=false;
   Fpaused:=false;
   FUseInterval:=false;
   IntervalDelta:=0;
   FireInit;
end;

// Destroy
//
destructor TGLFireFXManager.Destroy;
begin
   DeRegisterAllClients;
   DeRegisterManager(Self);
   FreeMem(FFireParticles);
   FClients.Free;
   FFireDir.Free;
	inherited Destroy;
end;

// RegisterClient
//
procedure TGLFireFXManager.RegisterClient(aClient : TGLBFireFX);
begin
   if Assigned(aClient) then
      if FClients.IndexOf(aClient)<0 then begin
         FClients.Add(aClient);
         aClient.FManager:=Self;
      end;
end;

// DeRegisterClient
//
procedure TGLFireFXManager.DeRegisterClient(aClient : TGLBFireFX);
begin
   if Assigned(aClient) then begin
      aClient.FManager:=nil;
      FClients.Remove(aClient);
   end;
end;

// DeRegisterAllClients
//
procedure TGLFireFXManager.DeRegisterAllClients;
var
   i : Integer;
begin
   // Fast deregistration
   for i:=0 to FClients.Count-1 do
      TGLBFireFX(FClients[i]).FManager:=nil;
   FClients.Clear;
end;

// SetFireDir
//
procedure TGLFireFXManager.SetFireDir(const val : TGLCoordinates);
begin
   FFireDir.Assign(val);
   FireInit;
end;

// SetCadencer
//
procedure TGLFireFXManager.SetCadencer(const val : TGLCadencer);
begin
   if FCadencer<>val then begin
      if Assigned(FCadencer) then
         FCadencer.UnSubscribe(Self);
      FCadencer:=val;
      if Assigned(FCadencer) then
         FCadencer.Subscribe(Self);
   end;
end;

// SetMaxParticles
//
procedure TGLFireFXManager.SetMaxParticles(const val : Integer);
begin
   if FMaxParticles<>val then begin
      FMaxParticles:=val;
      FireInit;
   end;
end;

// StoreParticleSize
//
function TGLFireFXManager.StoreParticleSize : Boolean;
begin
   Result:=(FParticleSize<>1);
end;

// SetInnerColor
//
procedure TGLFireFXManager.SetInnerColor(const val : TGLcolor);
begin
   if FInnerColor<>val then begin
      FInnerColor.color:=val.color;
      FireInit;
    end;
end;

// SetOuterColor
//
procedure TGLFireFXManager.SetOuterColor(const val : TGLcolor);
begin
   if FOuterColor<>val then begin
      FOuterColor.color:=val.color;
      FireInit;
   end;
end;

// SetFireDensity
//
procedure TGLFireFXManager.SetFireDensity(const val : Single);
begin
   if FFireDensity<>val then begin
      FFireDensity:=val;
      FireInit;
   end;
end;

// SetFireEvaporation
//
Procedure TGLFireFXManager.SetFireEvaporation(const val : single);
begin
   if FFireEvaporation<>val then begin
      FFireEvaporation:=val;
      FireInit;
   end;
end;

// SetFireCrown
//
Procedure TGLFireFXManager.SetFireCrown(const val : single);
begin
   if FFireCrown<>val then begin
      FFireCrown:=val;
      FireInit;
   end;
end;

// SetParticleLife
//
Procedure TGLFireFXManager.SetParticleLife(const val : integer);
begin
   if FParticleLife<>val then begin
      FParticleLife:=val;
      FireInit;
   end;
end;


// SetFireBurst
//
Procedure TGLFireFXManager.SetFireBurst(const val : byte);
begin
   if FFireBurst<>val then begin
      FFireBurst:=val;
      FireInit;
   end;
end;

// SetFireBlaze
//
Procedure TGLFireFXManager.SetFireBlaze(const val : byte);
begin
   if FFireBlaze<>val then begin
      FFireBlaze:=val;
      FireInit;
   end;
end;

// SetFireSowing
//
Procedure TGLFireFXManager.SetFireSowing(const val : byte);
begin
   if FFireSowing<>val then begin
      FFireSowing:=val;
      FireInit;
   end;
end;

// SetParticleInterval
//
Procedure TGLFireFXManager.SetParticleInterval(const val : single);
begin
   if FParticleInterval<>val then begin
      FParticleInterval:=val;
      FireInit;
   end;
end;

// Notification
//
procedure TGLFireFXManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
   if (Operation=opRemove) and (AComponent=FCadencer) then
      Cadencer:=nil;
end;

// DoProgress
//
procedure TGLFireFXManager.DoProgress(const deltaTime, newTime : Double);
var
   i : Integer;
begin
   // Progress the particles
   If (not FPaused) and (FParticleInterval > 0) then
     CalcFire(deltaTime+ FFireBurst / 500, FParticleInterval, FParticleLife, FFireDensity);

   // Invalidate all clients
   for i:=0 to FClients.Count-1 do
      TGLBFireFX(FClients[i]).OwnerBaseSceneObject.NotifyChange(TGLBFireFX(FClients[i]));
end;

// FireInit
//
procedure TGLFireFXManager.FireInit;
begin
  IntervalDelta:=0;
  ReallocMem(FFireParticles, FMaxParticles*Sizeof(TFireParticle));
end;

// CalcFire
//
procedure TGLFireFXManager.CalcFire(deltaTime : Double;
      ParticleInterval, ParticleLife: Single; FireAlpha: Single);
var
   N, I : Integer;
   DA, Fdelta : Single;
   tmp : TVector;

begin
   DA := Power(0.3, deltaTime);
   // Process live stuff
   N:=0;
   I:=0;
   while N<NP do begin
      FFireParticles[I].T := FFireParticles[I].T - deltaTime;
      if (FFireParticles[I].T<=0) then begin
         //Get the prev element
         Dec(NP);
         FFireParticles[I]:=FFireParticles[NP];
      end else begin
         //animate it
         with FFireParticles[I] do begin
            V:=VectorCombine(V, FireDir.AsVector, 1, deltaTime);
            Position:=VectorCombine(Position, V, 1, deltaTime);
         end;
         FFireParticles[I].Alpha := FFireParticles[I].Alpha * DA;
         Inc(N);
         Inc(I);
      end;
   end;
   // Spawn new particles
   If FDisabled then Exit;

   IntervalDelta:=IntervalDelta+(deltaTime*1000)/FParticleInterval;
   if (not FuseInterval) or (IntervalDelta>1) then
   begin
     fDelta:=Frac(IntervalDelta);
     While (NP<MaxParticles) do begin
       SetVector(tmp, Random, Random(FFireBlaze), FFireCrown + random(FFireSowing div 10));
       RotateVectorAroundY(PAffineVector(@tmp)^, Random*2*PI);
       with FFireParticles[NP] do begin
          Position := tmp;
          V := YHmgVector;
          T := ParticleLife*(Random*0.5+0.5);
          Alpha := FireAlpha;
       end;
       Inc(NP);
       if FuseInterval then Break;
     end;
     IntervalDelta:=fDelta;
  end;
end;

// AffParticle3d
//
procedure TGLFireFXManager.AffParticle3d(Color2: TColorVector; const mat : TMatrix);
var
   vx, vy : TVector;
   i : Integer;
begin
   for i:=0 to 2 do begin
     vx[i]:=mat[i][0]*FParticleSize;
     vy[i]:=mat[i][1]*FParticleSize;
   end;
   glBegin(GL_TRIANGLE_FAN);
      glVertex3fv(@NullVector);
      glColor4f(Color2[0], Color2[1], Color2[2], 0.0);
      glVertex3f(-vx[0], -vx[1], -vx[2]);
      // those things should be composited in the model view matrix
      glVertex3f(-0.5*vx[0]+FFireEvaporation*vy[0],
                 -0.5*vx[1]+FFireEvaporation*vy[1],
                 -0.5*vx[2]+FFireEvaporation*vy[2]);
      glVertex3f(+0.5*vx[0]+FFireEvaporation*vy[0],
                 +0.5*vx[1]+FFireEvaporation*vy[1],
                 +0.5*vx[2]+FFireEvaporation*vy[2]);
      glVertex3f(+vx[0], +vx[1], +vx[2]);
      glVertex3f(+0.5*vx[0]-FFireEvaporation*vy[0],
                 +0.5*vx[1]-FFireEvaporation*vy[1],
                 +0.5*vx[2]-FFireEvaporation*vy[2]);
      glVertex3f(-0.5*vx[0]-FFireEvaporation*vy[0],
                 -0.5*vx[1]-FFireEvaporation*vy[1],
                 -0.5*vx[2]-FFireEvaporation*vy[2]);
      glVertex3f(-vx[0], -vx[1], -vx[2]);
   glEnd;
end;

// ------------------
// ------------------ TGLBFireFX ------------------
// ------------------

// Create
//
constructor TGLBFireFX.Create(aOwner : TXCollection);
begin
   inherited Create(aOwner);
end;

// Destroy
//
destructor TGLBFireFX.Destroy;
begin
   Manager:=nil;
   inherited Destroy;
end;

// FriendlyName
//
class function TGLBFireFX.FriendlyName : String;
begin
   Result:='FireFX';
end;

// FriendlyDescription
//
class function TGLBFireFX.FriendlyDescription : String;
begin
   Result:='Fire FX';
end;

// WriteToFiler
//
procedure TGLBFireFX.WriteToFiler(writer : TWriter);
begin
   with writer do begin
      WriteInteger(0); // ArchiveVersion 0
      if Assigned(FManager) then
         WriteString(FManager.GetNamePath)
      else WriteString('');
   end;
end;

// ReadFromFiler
//
procedure TGLBFireFX.ReadFromFiler(reader : TReader);
begin
   with reader do begin
      Assert(ReadInteger=0);
      FManagerName:=ReadString;
      Manager:=nil;
   end;
end;

// Loaded
//
procedure TGLBFireFX.Loaded;
var
   mng : TComponent;
begin
   inherited;
   if FManagerName<>'' then begin
      mng:=FindManager(TGLFireFXManager, FManagerName);
      if Assigned(mng) then
         Manager:=TGLFireFXManager(mng);
      FManagerName:='';
   end;
end;

// Assign
//
procedure TGLBFireFX.Assign(Source: TPersistent);
begin
   if Source is TGLBFireFX then begin
      Manager:=TGLBFireFX(Source).Manager;
   end;
   inherited Assign(Source);
end;

// SetManager
//
procedure TGLBFireFX.SetManager(const val : TGLFireFXManager);
begin
   if val<>FManager then begin
      if Assigned(FManager) then
         FManager.DeRegisterClient(Self);
      if Assigned(val) then
         val.RegisterClient(Self);
   end;
end;

// Render
//
procedure TGLBFireFX.Render(sceneViewer : TGLSceneViewer;
                            var rci : TRenderContextInfo);
var
   N: Integer;
   I: Integer;
   absPos, innerColor : TVector;
   lastTr : TAffineVector;
   distList : TSingleList;
   objList : TList;
   fp : PFireParticle;
   FHandle : Integer;
   mat : TMatrix;
begin
   if Manager=nil then Exit;

   glPushAttrib(GL_ALL_ATTRIB_BITS);
   glPushMatrix;
   // we get the object position and apply translation...
   absPos:=OwnerBaseSceneObject.AbsolutePosition;
   // ...should be removed when absolute coords will be handled directly
   // in the particle system (and will also make a better flame effect)

   glDisable(GL_CULL_FACE);
   glDisable(GL_TEXTURE_2D);
   glDisable(GL_LIGHTING);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE);
   glEnable(GL_BLEND);

   n := Manager.NP;

   if n>1 then begin
      distList:=TSingleList.Create;
      objList:=TList.Create;
      for i:=0 to n-1 do begin
         fp:=@(Manager.FFireParticles[i]);
         distList.Add(VectorDotProduct(rci.cameraDirection, fp.Position));
         objList.Add(fp);
      end;
      QuickSortLists(0, N-1, distList, objList);

      glGetFloatv(GL_MODELVIEW_MATRIX, @mat);

      FHandle:=glGenLists(1);
      glNewList(FHandle, GL_COMPILE);
         Manager.AffParticle3d(Manager.FOuterColor.Color, mat);
      glEndList;
      glPushMatrix;
      lastTr:=NullVector;
      SetVector(innerColor, Manager.FInnerColor.Color);
      for i:=n-1 downto 0 do begin
         fp:=PFireParticle(objList[i]);
         glTranslatef(fp.Position[0]-lastTr[0], fp.Position[1]-lastTr[1], fp.Position[2]-lastTr[2]);
         SetVector(lastTr, fp.Position);
         innerColor[3]:=fp.Alpha;
         glColor4fv(@innerColor);
         glCallList(FHandle);
      end;
      glPopMatrix;
      glDeleteLists(FHandle, 1);

      objList.Free;
      distList.Free;
   end;

   glPopMatrix;
   glPopAttrib;
end;

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

	// class registrations
	RegisterXCollectionItemClass(TGLBFireFX);

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
finalization
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

end.

