adkparticules.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit ADKParticules;
{
 projet ADK-ISO (c)2002-2003 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/

}

interface

uses
 windows,ADKObjects,ADKDepth,Math;

type
 TParticule=record
  x,y,color:integer;
 end;

 TADKParticules=class(TADKObject)
 end;

type
 TADKSphere=class(TADKParticules)
 private
  x,y,d,w:integer;
  t:cardinal;
  a:array of integer;
 public
  constructor Create(ox,oy,diam,density:integer);
  function BaseLine:integer; override;
  procedure update(ms:cardinal); override;
  procedure draw; override;
 end;

 TMove=record
  x,y:single;
  speed:single;
  acc:single;
  way:single;
 end;

 TADKFire=class(TADKObject)//(TADKParticules)
 private
  x,y,w,h:integer;
  s:cardinal;
  pixels:array of array of byte;
  delta:cardinal;
  procedure burn;
 public
  constructor Create(Left,Top,Width,Height,Speed:integer);
  function BaseLine:integer; override;
  procedure Update(ms:cardinal); override;
  procedure Draw; override;
  function Light(lx,ly:single):integer; override;
 end;

implementation

uses
 ADKRender,ADKScreens;

constructor TADKSphere.Create(ox,oy,diam,density:integer);
var
 i:integer;
 function gray(c:integer):integer;
 begin
  result:=c+c shl 8+c shl 16;
 end;
begin
 inherited Create;
 w:=density;
 Setlength(a,w);
 for i:=0 to w-1 do a[i]:=Random(360);
 x:=ox;
 y:=oy;
 d:=Diam;
end;

function TADKSphere.BaseLine:integer;
begin
 result:=y;
end;

procedure TADKSphere.update(ms:cardinal);
begin
 t:=(t + ms) mod (3600);
end;

procedure TADKSphere.draw;
var
   i:integer;
   l:integer;
 s,c:extended;
begin
 for i:=0 to w-1 do begin
  l:=round(d*cos((t*PI/1800)+a[i]*PI/180));
  SinCos(i*a[i]*PI/180,s,c);
  ADKScreen.PutPixel(
   ScrollX+x+round(l*c),
   ScrollY+y+round(l*s),
   $ffffff
  );
 end;
end;

var
 FirePal:array[0..255] of integer;

procedure InitFire;
var
 i,c:integer;
begin
 for i:=0 to 84 do begin
  c:=((i*256) div 85) and 255;
  FirePal[i      ]:=$000000+c shl 16;
  FirePal[i+85   ]:=$ff0000+c shl 8;
  FirePal[i+85+85]:=$ffff00+c;
 end;
end;

constructor TADKFire.Create(Left,Top,Width,Height,Speed:integer);
begin
 inherited Create;
 x:=Left;
 y:=Top;
 w:=Width;
 h:=Height;
 s:=Speed;
 SetLength(pixels,h,w);
end;

function TADKFire.BaseLine:integer;
begin
 Result:=y+h;
end;

procedure TADKFire.Burn;
var
 x,y,c:integer;
begin
 for x:=0 to w-1 do pixels[h-1-(x and 1),x]:=random(196)+64;

 for y:=2 to h-2 do begin
  for x:=1 to w-2 do begin;
   c:=(Pixels[y,x-1]+Pixels[y,x+1]+Pixels[y,x]+Pixels[y+1,x]) shr 2;
 //  c:=(c+Pixels[y-1,x]) shr 1;
   c:=(c+Pixels[y+1,x]) shr 1;
   if c>128 then dec(c,1) else
   if c>64  then dec(c,2) else
   if c>3   then dec(c,3) else c:=0;
   Pixels[y,x]:=c;
  end;
 end;
end;

procedure TADKFire.Update(ms:cardinal);
begin
 delta:=delta+ms;
 while delta>s do begin
  burn;
  dec(delta,s);
 end;
end;

procedure TADKFire.Draw;
var
 ox,oy,dx,dy,iy,i,j,c:integer;
 pix:pointer;
begin
 ox:=x+ScrollX; dx:=w;
 if ox<0 then begin
  inc(dx,ox);
  if dx<=0 then exit;
  ox:=0;
 end;
 if ox+dx>=ADKScreen.Width then begin
  dx:=ADKScreen.Width-ox;
  if dx<=0 then exit;
 end;
 oy:=y+ScrollY; dy:=h-2; iy:=0;
 if oy<0 then begin
  inc(dy,oy);
  iy:=-oy;
  if dy<=0 then exit;
  oy:=0;
 end;
 if oy+dy>=ADKScreen.Height then begin
  dy:=ADKScreen.Height-oy;
  if dy<=0 then exit;
 end;
 if ADKScreen.BPP=BPP32 then begin
  //oy:=oy*ADKScreen.Pitch;
  for j:=0 to dy-1 do begin
   for i:=0 to dx-1 do begin
    c:=FirePal[pixels[iy+j,i]];
    if c<>0 then begin
     pix:=ADKScreen.Pixels[ox+i,oy];//@dib[oy+ADKScreen.BPP*(ox+i)];
     TPixel32(pix^):=c;
    end;
   end;
   inc(oy{,ADKScreen.Pitch});
  end;
 end else begin

 end;
end;

function TADKFire.Light(lx,ly:single):integer;
var
 l:double;
begin
 lx:=lx-x-ScrollX;
 ly:=ly-y-ScrollY;
 l:=sqrt(lx*lx+ly*ly);
 if l=0 then result:=255 else
 if l>255 then result:=0 else
 result:=round(255-l);
end;

initialization
 InitFire;
// allocconsole;
end.