unit zglParticleEngine;

interface

uses u_parser, zglHeader, Classes;

const
  peTypeParticle = 256;
  peTypeSprite = 257;
  peTypeRangeParam = 258;

  daRandom = -1;
  daSet = -2;

type
  TBaseVector = zglTPoint2D;
  PBaseVector = ^TBaseVector;
  TFloat = Single;
  PFloat = ^TFloat;

  peTParticleEngine = class;
  peTParticleClass = class;

  pePRangeParam = ^peTRangeParam;
  peTRangeParam = record
    From, To_: PFloat;
  end;

  pePSprite = ^peTSprite;
  peTSprite = record
    Texture: zglPTexture;
    TextureName: PString;
    Size, FrameSize: u_parser.PVector;
    Animated: PBoolean;
    Frames: PInteger;
    AnimateSpeed: PSingle;
    StartFrame: integer;
  end;

  pePParticleData = ^peTParticleData;
  peTParticleData = record
    ClassOf: peTParticleClass;
    Count, Angle, fAngle, Length: Integer;
  end;

  peTPaticleSet = class
    private
      fData: TList;        
      procedure ParseElement(data: string);
    public
      constructor Create(data: String);
      procedure AddEffect(X, Y: Single; Angle: Integer; pVelocity: PBaseVector = nil);
  end;

  peTParticleClass = class
    private
      Name, DrawAngleType, AngleType: PString;
      LifeTime, BeginAlpha, EndAlpha, UpdateTime: PInteger;
      Mass: PFloat;
      Sprite: pePSprite;
      DrawAngle, Angle: Integer;
      DrawRotation, AngleOffset, Speed: pePRangeParam;
      fPE: peTParticleEngine;
      OnDestroy, OnUpdate: peTPaticleSet;

    public
      constructor Create(pPE: peTParticleEngine);
      procedure CreateEffect(X, Y: Single; Angle: Integer; pVelocity: PBaseVector = nil);
  end;

  peTParticle = class
    private
      ClassOf: peTParticleClass;
      Position, Velocity: TBaseVector;
      LifeTime, Animation, RotationSpeed, Angle, UpdateTime: TFloat;
      Frame: integer;
    public
      procedure Update(dt: single);
      procedure Draw;
      constructor Create(pX, pY: single; pAngle: integer; pClassOf: peTParticleClass);
      destructor Destroy; override;
  end;

  peTParticleEngine = class
    private
      fGravitation: TBaseVector;
      fParticlesClasses, fParticles: TList;
    public
      function GetClassByName(Name: string): peTParticleClass;
      property Gravitation: TBaseVector read fGravitation write fGravitation;
      constructor Create(Gravitation_: TBaseVector);
      procedure Draw;
      procedure Update(dt: Double);
  end;

  function getcpv(X, Y: TFloat): TBaseVector;

  var PE: peTParticleEngine;
      iOne: Integer = 1;

implementation

function cfRangeParam(Data: TDataObjectRecord): Pointer;
var prt: pePRangeParam;
begin
  New(prt);  
  Data.GetData('From', @prt.From, true);
  Data.GetData('To', @prt.To_, true);
  result := prt;
end;

function cfParticle(Data: TDataObjectRecord): Pointer;
var prt: peTParticleClass;
    s: PString;
begin
  prt := peTParticleClass.Create(PE);
  // Обязательные параметры
  Data.GetData('Name', @prt.Name, true);
  Data.GetData('Sprite', @prt.Sprite, true);
  Data.GetData('LifeTime', @prt.LifeTime, true);
  // Необязательные параметры
  Data.GetData('BeginAlpha', @prt.BeginAlpha, false);
  Data.GetData('EndAlpha', @prt.EndAlpha, false);
  Data.GetData('DrawAngle', @prt.DrawAngleType, false);
  Data.GetData('Mass', @prt.Mass, false);
  Data.GetData('Angle', @prt.AngleType, false);
  Data.GetData('DrawRotation', @prt.DrawRotation, false);
  Data.GetData('AngleOffset', @prt.AngleOffset, false);
  Data.GetData('UpdateTime', @prt.UpdateTime, false);
  Data.GetData('Speed', @prt.Speed, false);

  Data.GetData('OnDestroy', @s, false);
  if s^ <> '' then begin
    prt.OnDestroy := peTPaticleSet.Create(s^);
  end;

  Data.GetData('OnUpdate', @s, false);
  if s^ <> '' then begin
    prt.OnUpdate := peTPaticleSet.Create(s^);
  end;

  if (prt.DrawAngleType^ = 'random') then
    prt.DrawAngle := daRandom
  else if (prt.DrawAngleType^ = 'set') then
    prt.DrawAngle := daSet
  else prt.DrawAngle := u_StrToInt(prt.DrawAngleType^);
                
  if (prt.AngleType^ = 'random') then
    prt.Angle := daRandom
  else if (prt.AngleType^ = 'set') then
    prt.Angle := daSet
  else prt.Angle := u_StrToInt(prt.AngleType^);

  result := prt;
end;

function cfSprite(Data: TDataObjectRecord): Pointer;
var prt: pePSprite;
    s: PString;
begin
  New(prt);

  s := nil;
  prt.FrameSize := nil;
  prt.Frames := @iOne;

  Data.GetData('Texture', @prt.TextureName, true);
  Data.GetData('Size', @prt.Size, true);
  Data.GetData('FrameSize', @prt.FrameSize, false);
  Data.GetData('Animated', @prt.Animated, false);
  Data.GetData('Frames', @prt.Frames, false);
  Data.GetData('AnimateSpeed', @prt.AnimateSpeed, false); 
  Data.GetData('StartFrame', @s, false);

  if (s^ = 'random') then begin
    prt.StartFrame := daRandom;
  end else
    prt.StartFrame := u_StrToInt(s^);

  if prt.FrameSize = @cfVectorNull then
    prt.FrameSize := prt.Size;

  prt.Texture := tex_LoadFromFile(prt.TextureName^, $FFFFFFFF, TEX_DEFAULT_2D);
  tex_SetFrameSize(prt.Texture, prt.FrameSize^.X^, prt.FrameSize^.Y^);

  result := prt;
end;

function RegisterParticle(Data: peTParticleClass): Pointer;
begin      
  PE.fParticlesClasses.Add(Data);
  RESULT := nil;
end;

function getcpv(X, Y: TFloat): TBaseVector;
begin
  Result.X := X;
  Result.Y := Y;
end;      

procedure peTPaticleSet.ParseElement;
var p, c, a, l, f: integer;
    s: string;
    pc: peTParticleClass;
    pd: pePParticleData;
begin
  p := Pos('|', data);
  if p <> 0 then begin
    c := u_StrToInt(Copy(data, p+1, Length(data)));
    Delete(data, p, Length(data));
  end else c := 1;  
  p := Pos(':', data);
  if p <> 0 then begin
    s := Copy(data, p + 1, Length(data));
    Delete(data, p, Length(data));
    p := Pos('/', s);
    if p <> 0 then begin
      l := u_StrToInt(copy(s, 1, p - 1));
      a := u_StrToInt(copy(s, p + 1, Length(s)));
    end else begin
      a := 0;
      l := u_StrToInt(s);
    end;
  end else begin
    a := 0; l := 0;
  end;
  p := Pos('#', data);
  if p <> 0 then begin 
    f := u_StrToInt(Copy(data, p+1, Length(data)));
    Delete(data, p, Length(data));
  end else
    f := 0;
  pc := PE.GetClassByName(data);
  if pc <> nil then begin
    new(pd);
    pd^.ClassOf := pc;
    pd^.Count := c;
    pd^.Angle := a;
    pd^.fAngle := f;
    pd^.Length := l;
    fData.Add(pd);
  end;
end;

constructor peTPaticleSet.Create;
var p: Integer;
begin
  fData := TList.Create;
  p := Pos(',', data);
  while p <> 0 do begin
    ParseElement(Copy(data, 1, p-1));
    Delete(Data, 1, p);
    p := Pos(',', data);
  end;
  ParseElement(data);
end;

procedure peTPaticleSet.AddEffect;
var i, j: integer;
    pd: pePParticleData;
begin
  for i := 0 to fData.Count -1 do begin
    pd := fData.Items[i];
    for j := 1 to pd^.Count do
      pd^.ClassOf.CreateEffect(X + m_Cos(Angle + pd^.Angle) * pd^.Length,
                               Y + m_Sin(Angle + pd^.Angle) * pd^.Length,
                               Angle + pd^.fAngle,
                               pVelocity);
  end;
end;

constructor peTParticle.Create;
var mAngle, mSpeed: single;
begin
  Position.X := pX;
  Position.Y := pY;
  case pClassOf.Angle of
    daRandom: begin
      mAngle := random(360);
    end;
    daSet: begin
      mAngle := pAngle;
    end;
    else
      mAngle := pClassOf.Angle;
  end;
  case pClassOf.Sprite^.StartFrame of
    daRandom: begin
      Frame := Random(pClassOf.Sprite^.Frames^) + 1;
    end;
    else
      Frame := pClassOf.Sprite^.StartFrame;
  end;
  if pClassOf.DrawRotation <> nil then begin
    RotationSpeed :=
      Random(Round((pClassOf.DrawRotation^.To_^ -
        pClassOf.DrawRotation^.From^)  * 1000)) / 1000
      + pClassOf.DrawRotation^.From^;
  end else begin
    RotationSpeed := 0;
  end;
  if pClassOf.AngleOffset <> nil then begin
    mAngle := mAngle +
        Random(Round((pClassOf.AngleOffset^.To_^ -
        pClassOf.AngleOffset^.From^)  * 1000)) / 1000
      + pClassOf.AngleOffset^.From^;
  end;
  if pClassOf.Speed <> nil then begin
    mSpeed := Random(Round((pClassOf.Speed^.To_^ -
        pClassOf.Speed^.From^)  * 1000)) / 1000
      + pClassOf.Speed^.From^;
  end else mSpeed := 0;

  
  case pClassOf.DrawAngle of
    daRandom: begin
      Angle := random(360);
    end;
    daSet: begin
      Angle := mAngle;
    end;
    else
      Angle := pClassOf.DrawAngle;
  end;

  Velocity :=
    getcpv(
      m_Cos(Round(mAngle)) * mSpeed,
      m_Sin(Round(mAngle)) * mSpeed
    );
  UpdateTime := 0;
  ClassOf := pClassOf;
  LifeTime := ClassOf.LifeTime^;
end;

destructor peTParticle.Destroy;
begin     
  PE.fParticles.Remove(self);
  inherited;
end;

procedure peTParticle.Update(dt: single);
begin
  LifeTime := LifeTime - dt;
  if ClassOf.Sprite^.Animated^ then begin
    Animation := Animation + dt;
    if Animation > ClassOf.Sprite^.AnimateSpeed^ then begin
      inc(Frame);
      if Frame > ClassOf.Sprite^.Frames^ then
        Frame := 1;
      Animation := 0;
    end;
  end;
  
  Position.X := Position.X + Velocity.X * dt;
  Position.Y := Position.Y + Velocity.Y * dt;

  Velocity.X := Velocity.X + PE.fGravitation.X * ClassOf.Mass^ * dt;
  Velocity.Y := Velocity.Y + PE.fGravitation.Y * ClassOf.Mass^ * dt;
  

  case ClassOf.DrawAngle of
    daSet: begin
      Angle := m_Angle(0, 0, Velocity.X, Velocity.Y);
    end;
  end;

  if ClassOf.OnUpdate <> nil then begin
    UpdateTime := UpdateTime + dt;   
    if UpdateTime > ClassOf.UpdateTime^ then begin

      UpdateTime := 0;
      ClassOf.OnUpdate.AddEffect(
        Position.X, Position.Y, Round(Angle), @Velocity
      );
    end;
  end;

  Angle := Angle + RotationSpeed;
  if LifeTime < 0 then begin
    if ClassOf.OnDestroy <> nil then begin
      ClassOf.OnDestroy.AddEffect(
        Position.X, Position.Y, Round(Angle), @Velocity
      );
    end;
    Free;
  end;
end;

procedure peTParticle.Draw;
var tex: zglPTexture;
    a: byte;
begin
  tex := ClassOf.Sprite^.Texture;

  if ClassOf.LifeTime^ - LifeTime < ClassOf.BeginAlpha^ then begin
    a := round(255 * ((ClassOf.LifeTime^ - LifeTime) / ClassOf.BeginAlpha^));
  end else
  if LifeTime < ClassOf.EndAlpha^ then begin
    a := round(255 * (LifeTime / ClassOf.EndAlpha^))
  end else
    a := 255;

  asprite2d_Draw(tex,
    Position.X - ClassOf.Sprite^.Size^.X^ / 2,
    Position.Y - ClassOf.Sprite^.Size^.Y^ / 2,
    ClassOf.Sprite^.Size^.X^,
    ClassOf.Sprite^.Size^.Y^,
    Angle, Frame, a);
end;

constructor peTParticleClass.Create;
begin
  LifeTime := @cfFloatNull;
  Name := nil;
  fPE := pPE;
end;

procedure peTParticleClass.CreateEffect;
var p: peTParticle;
begin
  p := peTParticle.Create(X, Y, Angle, Self);
  if pVelocity <> nil then begin
    p.Velocity.X := p.Velocity.X + pVelocity^.X * Mass^;
    p.Velocity.Y := p.Velocity.Y + pVelocity^.Y * Mass^;
  end;
  PE.fParticles.Add(p);
end;

constructor peTParticleEngine.Create;
begin
  fGravitation := Gravitation_;
  fParticlesClasses := TList.Create;
  fParticles := TList.Create;
  with FileParser do begin

    with RegisterType('RangeParam', peTypeRangeParam, nil, ct_record, @cfRangeParam) do begin
      RegisterVariable('From', dFloat);
      RegisterVariable('To', dFloat);
    end;

    with RegisterType('Sprite', peTypeSprite, nil, ct_record, @cfSprite) do begin
      RegisterVariable('Texture', dString);
      RegisterVariable('Size', dVector);   
      RegisterVariable('FrameSize', dVector);
      RegisterVariable('Animated', dBoolean);
      RegisterVariable('Frames', dInteger);
      RegisterVariable('StartFrame', dString);
      RegisterVariable('AnimateSpeed', dFloat);
    end;

    with RegisterType('Particle', peTypeParticle, nil, ct_record, @cfParticle) do begin
      RegisterVariable('Name', dString);
      RegisterVariable('LifeTime', dInteger);
      RegisterVariable('BeginAlpha', dInteger);
      RegisterVariable('EndAlpha', dInteger);
      RegisterVariable('Sprite', peTypeSprite);
      RegisterVariable('DrawAngle', dString);
      RegisterVariable('Angle', dString);
      RegisterVariable('Mass', dFloat);
      RegisterVariable('DrawRotation', peTypeRangeParam);
      RegisterVariable('AngleOffset', peTypeRangeParam);
      RegisterVariable('Speed', peTypeRangeParam);
      RegisterVariable('OnDestroy', dString);
      RegisterVariable('OnUpdate', dString);
      RegisterVariable('UpdateTime', dInteger);
    end;
    
    RegisterFunction('AddParticle', peTypeParticle, @RegisterParticle)
  end;
end;

function peTParticleEngine.GetClassByName;
var i: Integer;
begin
  for i := 0 to fParticlesClasses.Count -1 do begin
    Result := fParticlesClasses.Items[i];
    if Result.Name^ = Name then
      exit;
  end;
  Result := nil;
end;

procedure peTParticleEngine.Draw;
var i: integer;
begin
  for i := 0 to fParticles.Count-1 do begin
    peTParticle(fParticles.Items[i]).Draw;
  end;
end;

procedure peTParticleEngine.Update;
var i: integer;
begin
  for i := fParticles.Count-1 downto 0 do begin
    peTParticle(fParticles.Items[i]).Update(dt);
  end;
end;

end.
