unit zglParticleEngine;

interface

uses SysUtils, Dialogs, zglHeader;

const
  angle_set = 1;
  angle_random = 2;

type
  THeaderRec = record
    Comm, Param:string;
  end;
  TPoint = record
    X, Y: Word;
  end;
  TWideParam = record
    X, Y, Xrand, Yrand: Single;
  end;

  PEffectSet=^TEffectSet;
  TEffectSet=record
    Effects:array of record
                       Count:Integer;
                       Effect: Pointer;
                       AngleP:Integer;
                     end;
  end;

  PEffectClass = ^TEffectClass;
  TEffectClass = record
    Name:string;
    Texture: zglPTexture;
    Time, TimeAlphaStart, TimeAlphaEnd: integer;

    Angle, DrawAngle, AngleRange: integer;
    Animation: Boolean;
    AnimSpeed, StartFrame: Integer;
    Frames: TPoint;

    mSizing, mMoving, mDrawRotating, mRotating:TWideParam;
    DestroyEffect: TEffectSet;

    Next, Prew: PEffectClass;
  end;

  PEffect = ^TEffect;
  TEffect = record
    ClassId: PEffectClass;
    Position: zglTPoint2D;

    Time: Single;
    AnimFrame: Integer;
    AnimTime: single;


    AngleBit, DrawAngleBit:integer;
    Angle, Speed, decSpeed,
    DrawAngle, DrawAngleSpeed, decDrawAngleSpeed,
    AngleSpeed, decAngleSpeed,
    Size, SizeSpeed, decSizeSpeed: Single;

    Prew, Next: PEffect;
  end;

  TParticleEngine = object
    protected
      FirstEffect, LastEffect: PEffect;
      FirstEffectClass, LastEffectClass: PEffectClass;
    public
      procedure Init;
      procedure LoadFromFile(dir:string);
      procedure Clear;
      procedure Draw;
      procedure Process( dt : Double );
      procedure CreateEffect(ClassId: PEffectSet; Position: zglTPoint2D; Angle: Single);
      procedure SetEffect(i_:PEffectSet;s:string);
    protected
      procedure AddEffect(ClassId: PEffectClass; Position: zglTPoint2D; Angle: Single);
      procedure GetParam(var F:TextFile; var HR: THeaderRec);
      function GetTPoint(s:string):TPoint;
      procedure CutSpaces(var S:string);
      function GetWParam(s:string):TWideParam;
      function BNomal(s:Single):single;
      procedure AttachEffect(i_:PEffectSet;s:string);
  end;

implementation

procedure TParticleEngine.CreateEffect(ClassId: PEffectSet; Position: zglTPoint2D; Angle: Single);
var i,j:Integer;
begin
  for i:=0 to Length(ClassId.Effects)-1 do begin
    for j:=1 to ClassId.Effects[i].Count do begin
      AddEffect(PEffectClass(ClassId.Effects[i].Effect), Position, Angle+ClassId.Effects[i].AngleP);
    end;
  end;
end;

procedure TParticleEngine.SetEffect(i_:PEffectSet;s:string);
begin
  while Pos(',',s)<>0 do begin
    AttachEffect(i_,Copy(s,1,Pos(',',s)-1));
    Delete(s,1,Pos(',',s));
  end;
  AttachEffect(i_,s);
end;

procedure TParticleEngine.AttachEffect(i_:PEffectSet;s:string);
var i,n,c,id,a:Integer;
    p:PEffectClass;
begin
  c:=1; a:=0;
  if Pos('|',s)<>0 then begin
    c:=StrToIntDef(Copy(s,Pos('|',s)+1,Length(s)),1);
    s:=Copy(s,1,Pos('|',s)-1);
  end;
  if Pos('#',s)<>0 then begin
    a:=StrToIntDef(Copy(s,Pos('#',s)+1,Length(s)),1);
    s:=Copy(s,1,Pos('#',s)-1);
  end;
  p:=FirstEffectClass;
  while p<>nil do begin
    if p^.Name=s then begin

      id:=Length(i_.Effects);
      SetLength(i_.Effects,id+1);
      i_.Effects[id].Count:=c;
      i_.Effects[id].Effect:=p;
      i_.Effects[id].AngleP:=a;
      Break;
    end;
    p:=p^.Next;
  end;
end;

procedure TParticleEngine.AddEffect;
var p:PEffect;
    i:integer;
begin
  New(P);

  p^.ClassId:=ClassId;
  p^.Position:=Position;

  i:=Random(360);

  case p^.ClassId^.Angle of
    angle_set:
      p^.Angle:=Angle;
    angle_random:
      p^.Angle:=i;
  end;

  case p^.ClassId^.DrawAngle of
    angle_set:
      p^.DrawAngle:=Angle;
    angle_random:
      p^.DrawAngle:=i;
  end;

  p^.AngleBit:=Round((Random(2)-0.5)*2);
  p^.DrawAngleBit:=Round((Random(2)-0.5)*2);

  if p^.ClassId^.AngleRange>0 then begin
    i:=random(p^.ClassId^.AngleRange*2)-p^.ClassId^.AngleRange;
    p^.Angle:=p^.Angle+i;
    p^.DrawAngle:=p^.DrawAngle+i;
  end;

  with p^.ClassId^ do begin
    p^.Time:=Time;
    if StartFrame=0 then
      p^.AnimFrame:=Random(Texture.FramesX*Texture.FramesY)+1
    else
      p^.AnimFrame:=StartFrame;
    p^.AnimTime:=0;

    p^.Speed:=mMoving.X+random(round(mMoving.Xrand*1000))/1000;
    p^.decSpeed:=mMoving.Y++random(round(mMoving.Yrand*1000))/1000;
    p^.DrawAngleSpeed:=mDrawRotating.X+random(round(mDrawRotating.Xrand*1000))/1000;
    p^.decDrawAngleSpeed:=mDrawRotating.Y++random(round(mDrawRotating.Yrand*1000))/1000;
    p^.AngleSpeed:=mRotating.X+random(round(mRotating.Xrand*1000))/1000;
    p^.decAngleSpeed:=mRotating.Y++random(round(mRotating.Yrand*1000))/1000;
    p^.Size:=1;
    p^.SizeSpeed:=mSizing.X+random(round(mSizing.Xrand*1000))/1000;
    p^.decSizeSpeed:=mSizing.Y++random(round(mSizing.Yrand*1000))/1000;
  end;

  if LastEffect<>nil then begin
    LastEffect^.Next:=p;
    p^.Prew:=LastEffect;
  end else begin
    FirstEffect:=p;
    p^.Prew:=nil;
  end;
  p^.Next:=nil;
  LastEffect:=p;
end;

function TParticleEngine.GetWParam;
var i:Integer;
    s1,s2:string;
begin
  i:=Pos('|',s);
  if i>0 then begin
    s1:=Copy(S,1,i-1);s2:=Copy(S,i+1,Length(s));
    if Pos('[',s1)<>0 then begin
      s1:=Copy(s1,2,Length(s1)-2);
      i:=Pos('-',s1);
      Result.X:=StrToFloatDef(Copy(s1,1,i-1),0);
      Result.Xrand:=StrToFloatDef(Copy(s1,i+1,Length(s1)),0)-Result.X;
    end else begin
      Result.X:=StrToFloatDef(s1,0);
      Result.Xrand:=0;
    end;
    if Pos('[',s2)<>0 then begin
      s2:=Copy(s2,2,Length(s2)-2);
      i:=Pos('-',s2);
      Result.Y:=StrToFloatDef(Copy(s2,1,i-1),0);
      Result.Yrand:=StrToFloatDef(Copy(s2,i+1,Length(s2)),0)-Result.Y;
    end else begin
      Result.Y:=StrToFloatDef(s2,0);
      Result.Yrand:=0;
    end;
  end
end;

function TParticleEngine.BNomal(s:Single):single;
begin
  if s>1 then result:=1 else
    if s<0 then result:=0 else
      result:=s;

end;

procedure TParticleEngine.Draw;
var p:PEffect;
    i:integer;
    j:single;
begin
  p:=FirstEffect;
  while p<>nil do begin
    if p^.Time<=p^.ClassId.TimeAlphaEnd then
      i:=Round(255*p^.Time/p^.ClassId.TimeAlphaEnd)
    else if p^.Time>=p^.ClassId.Time-p^.ClassId.TimeAlphaStart then
      i:=Round(255*(1-BNomal((p^.Time-(p^.ClassId.Time-p^.ClassId.TimeAlphaStart))/p^.ClassId.TimeAlphaStart)))
    else i:=255;
    j:=p^.Size;
    asprite2d_Draw(p^.ClassId^.Texture,
      p^.Position.X - (p^.ClassId.Frames.X div 2)*j,
      p^.Position.Y - (p^.ClassId.Frames.Y div 2)*j,
      p^.ClassId.Frames.X*j, p^.ClassId.Frames.Y*j,
      p^.DrawAngle, p^.AnimFrame, i);
    p:=p^.Next;
  end;
end;

procedure TParticleEngine.Process;
var p, ptmp:PEffect;
begin
  p:=FirstEffect;
  while p<>nil do begin
    with p^ do begin
      Position.X:=Position.X+m_Cos(round(Angle))*Speed*dt;
      Position.Y:=Position.Y+m_Sin(round(Angle))*Speed*dt;
      Angle:=Angle+AngleSpeed*dt*AngleBit;
      AngleSpeed:=AngleSpeed-decAngleSpeed*dt;
      if AngleSpeed<0 then AngleSpeed:=0;

      DrawAngle:=DrawAngle+DrawAngleSpeed*dt*DrawAngleBit;
      DrawAngleSpeed:=DrawAngleSpeed-decDrawAngleSpeed*dt;
      if DrawAngleSpeed<0 then DrawAngleSpeed:=0;

      Speed:=Speed-decSpeed*dt;
      if Speed<0 then Speed:=0;

      Time:=Time-dt;
      if Size<0 then Size:=0;

      if ClassId^.Animation then begin
        AnimTime:=AnimTime+dt;
        if AnimTime>=ClassId^.AnimSpeed then begin
          AnimTime:=0;     
          inc(AnimFrame);
          if AnimFrame>ClassId^.Texture.FramesX*ClassId^.Texture.FramesY then
            AnimFrame:=1;
        end;
      end;
    end;
    if p^.Time<=0 then begin
      CreateEffect(@p^.ClassId^.DestroyEffect, p^.Position, p^.Angle);
      if p=FirstEffect then FirstEffect:=p.Next;
      if p=LastEffect then LastEffect:=p.Prew;
      if (p.Next<>nil) and (p.Prew<>nil) then begin
        p^.Prew.Next:=p.Next;
        p^.Next.Prew:=p.Prew;
      end else begin
        if p.Next<>nil then
          p^.Next.Prew:=nil;
        if p.Prew<>nil then
          p^.Prew.Next:=nil;
      end;
      ptmp:=p^.Next;
      Dispose(p);
      p:=ptmp;
    end else p:=p^.Next;
  end;
end;

procedure TParticleEngine.CutSpaces;
begin
  while Copy(s,1,1)=' ' do Delete(s,1,1);
  while Copy(s,Length(s),1)=' ' do Delete(s,Length(s),1);
end;

function TParticleEngine.GetTPoint;
var i:integer;
begin
  i:=pos('|', s);
  if i<>0 then begin
    Result.X:=StrToIntDef(Copy(S,1,i-1),0);
    Result.Y:=StrToIntDef(Copy(S,i+1, Length(S)),0);
  end else begin
    Result.X:=0;
    Result.Y:=0;
  end;
end;

procedure TParticleEngine.GetParam;
var s:string;
    i:integer;
begin
  Readln(F, s);
  CutSpaces(s);
  i:=Pos(' ',S);
  if i<>0 then begin
    HR.Comm:=AnsiLowerCase(Copy(s, 1, i-1));
    Delete(S, 1, i);
    if (Copy(s,1,1)='"') and (Copy(s,Length(s),1)='"') then begin
      Delete(s,1,1); Delete(s, length(s), 1);
    end;
    HR.Param:=s;
  end else begin
    HR.Comm:=AnsiLowerCase(s);
    HR.Param:='';
  end;
end;

procedure TParticleEngine.Clear;
begin
  LastEffectClass:=nil;
  FirstEffectClass:=nil;
  LastEffect:=nil;
  FirstEffect:=nil;
end;

procedure TParticleEngine.LoadFromFile;
var F:TextFile;
    home:string;
    HR:THeaderRec;
    p:PEffectClass;
begin
  if FileExists(dir)=false then exit;
  home:=ExtractFilePath(dir);
  AssignFile(F, dir);
  Reset(F);
  while not Eof(F) do begin
    GetParam(F, HR);
    if Hr.Comm='include' then begin
      LoadFromFile(Home+HR.Param);
    end else
    if Hr.Comm='addeffect' then begin
      New(P);
      p^.Name:=Hr.Param;
      if LastEffectClass<>nil then begin
        LastEffectClass^.Next:=p;
        p^.Prew:=LastEffectClass;
      end else begin
        FirstEffectClass:=p;
        p^.Prew:=nil;
      end;
      while (not Eof(F)) and (Hr.Comm<>'end') do begin
        GetParam(F, HR);     
        if Hr.Comm='texture' then begin
          p^.Texture:=tex_LoadFromFile(Home+Hr.Param, $FF000000, TEX_DEFAULT_2D);
          p^.Frames.X:=p^.Texture.Width;
          p^.Frames.Y:=p^.Texture.Height;
        end else
        if Hr.Comm='time' then begin
          p^.Time:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='timealphastart' then begin
          p^.TimeAlphaStart:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='timealphaend' then begin             
          p^.TimeAlphaEnd:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='destroyeffect' then begin
          SetEffect(@p^.DestroyEffect, Hr.Param);
        end else
        if Hr.Comm='animation' then begin
          p^.Animation:=Hr.Param='true';
        end else
        if Hr.Comm='anglerange' then begin
          p^.AngleRange:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='angle' then begin
          if Hr.Param='set' then
            p^.Angle:=angle_set
          else p^.Angle:=angle_random;
        end else
        if Hr.Comm='drawangle' then begin
          if Hr.Param='set' then
            p^.DrawAngle:=angle_set
          else p^.DrawAngle:=angle_random;
        end else
        if Hr.Comm='animspeed' then begin
          p^.AnimSpeed:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='startframe' then begin
          p^.StartFrame:=StrToIntDef(Hr.Param, 0);
        end else
        if Hr.Comm='frames' then begin
          p^.Frames:=GetTPoint(Hr.Param);
        end else
        if Hr.Comm='msizing' then begin
          p^.mSizing:=GetWParam(Hr.Param);
        end else
        if Hr.Comm='mmoving' then begin
          p^.mMoving:=GetWParam(Hr.Param);
        end else
        if Hr.Comm='mdrawrotating' then begin
          p^.mDrawRotating:=GetWParam(Hr.Param);
        end else
        if Hr.Comm='mrotating' then begin
          p^.mRotating:=GetWParam(Hr.Param);
        end;
      end;
      tex_SetFrameSize(p^.Texture, p^.Frames.X, p^.Frames.Y);
      p^.Next:=nil;
      LastEffectClass:=p;
    end;
  end;
  CloseFile(F);
end;


procedure TParticleEngine.Init;
begin
  //
end;

end.
