unit _DX3D_Rain;

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, SysUtils, Forms, Dialogs, Classes, Controls, StdCtrls, Buttons, ComCtrls,
  dddd, ddraw, d3d, d3dcaps, d3dtypes, s_mathpack, ExtCtrls,Math,Graphics;

// TWaterとTPlateで同じ変数名を含めちゃダメ。混乱するから。

type
  TWater=record
    nx,ny,nz:single;
    lx,ly,lz:single;
    sx,sy,sz:single;
    leave:integer;
  end;

type
  TPlate=record
    x1,y1,z1,x2,y2,z2:single;
    r:single;
    l:single;
  end;

type
  TRain = class
  private
    { Private 宣言 }
    Reflect:single;
    procedure InitWaterOne(var Water:TWater);
    procedure CalcWaterOne(var Water:TWater);
    procedure BlockWaterOne(var Water:TWater);
    procedure DrawWaterOne(DstBM:TBitmap;var Water:TWater);
    procedure DrawPlateOne(DstBM:TBitmap;var Plate:TPlate);
  public
    { Public 宣言 }
    WaterColor:array[0..512] of dword;
    WaterCount:integer;
    Water:array of TWater;
    PlateCount:integer;
    Plate:array of TPlate;
    constructor Create;
    destructor Destroy; override;
    procedure InitWater(_WaterCount:integer);
    procedure CalcWater;
    procedure BlockWater;
    procedure DrawWater(DstBM:TBitmap);
    procedure InitPlate(_PlateCount:integer);
    procedure SetPlate(cnt:integer;_x1,_y1,_z1,_r,_l,_zl:single);
    procedure SetRotPlate(cnt:integer;_r:single);
    procedure DrawPlate(DstBM:TBitmap);
    procedure SetWaterColor(col:dword;HSVBM:TBitmap);
    procedure SetReflect(_Reflect:single);
  end;

implementation

uses _PicTools;

const MaxX=$100;
const MaxY=$100;
const MaxZ=$100;

constructor TRain.Create;
begin
  inherited Create;

  WaterCount:=0;
  PlateCount:=0;
  Reflect:=0;
end;

destructor TRain.Destroy;
begin

  inherited Destroy;
end;

procedure TRain.InitWaterOne(var Water:TWater);
begin
  with Water do begin
    nx:=random(MaxX);
    ny:=0;
    nz:=random(MaxZ);
    lx:=nx;
    ly:=ny;
    lz:=nz;
    sx:=0;
    sy:=random(1000)/1000;
    sz:=(random(1000)/1000-0.5)/10;
    leave:=$ff;
  end;
end;

procedure TRain.CalcWaterOne(var Water:TWater);
begin
  with Water do begin
    sy:=sy+0.05;

    sx:=sx*0.99;
    sy:=sy*0.99;
    sz:=sz;

    lx:=nx;
    ly:=ny;
    lz:=nz;
    nx:=nx+sx;
    ny:=ny+sy;
    nz:=nz+sz;
    dec(leave);

    if (nx<0) or (MaxX<=nx) or (ny<0) or (MaxY<=ny) or (nz<0) or (MaxZ<=nz) then InitWaterOne(Water);
    if leave<0 then InitWaterOne(Water);
  end;
end;

procedure TRain.BlockWaterOne(var Water:TWater);
var
  cnt:integer;
  PlateBlock:boolean;
  PlateIndex:integer;
  bx1,by1,br:single;
  lrot,nrot:single;
  spdpow,spdrot:single;
  function GetLength(x,y:single):single;
  begin
    Result:=sqrt((x*x)+(y*y));
  end;
  function GetRot(x,y:single):single;
  var
    l:single;
  begin
    l:=sqrt((x*x)+(y*y));
    Result:=ArcSin(x/l);
  end;
begin
  with Water do begin
    PlateIndex:=-1;
    for cnt:=0 to PlateCount-1 do begin
      PlateBlock:=True;
      if (ny<=(Plate[cnt].y1-2)) or ((Plate[cnt].y2+2)<=ny) then PlateBlock:=False;
      if (nz<=(Plate[cnt].z1-2)) or ((Plate[cnt].z2+2)<=nz) then PlateBlock:=False;
      if PlateBlock=True then begin
        // Plate.x1<Plate.x2 = 0<Plate.r
        if 0<Plate[cnt].r then begin
          if (nx<=(Plate[cnt].x1-2)) or ((Plate[cnt].x2+2)<=nx) then PlateBlock:=False;
          end else begin
          if (nx<=(Plate[cnt].x2-2)) or ((Plate[cnt].x1+2)<=nx) then PlateBlock:=False;
        end;
      end;
      if PlateBlock=True then begin
        PlateIndex:=cnt;
        break;
      end;
    end;
    if PlateIndex=-1 then exit;

    bx1:=Plate[PlateIndex].x1;
    by1:=Plate[PlateIndex].y1;
    br:=Plate[PlateIndex].r;

    nrot:=GetRot(nx-bx1,ny-by1);
    lrot:=GetRot(lx-bx1,ly-by1);
    if 0<br then begin
      if (nrot>br) or (lrot<br) then exit;
      end else begin
      if (nrot<br) or (lrot>br) then exit;
    end;

    spdpow:=GetLength(nx-lx,ny-ly);
    spdrot:=ArcSin((nx-lx)/spdpow);

    nx:=lx;
    ny:=ly;
    nz:=lz;
    sx:=sin(br+(br-spdrot))*spdpow*Reflect;
    sy:=cos(br+(br-spdrot))*spdpow*Reflect;
    sz:=sz;
  end;
end;

procedure TRain.DrawWaterOne(DstBM:TBitmap;var Water:TWater);
var
  x1,y1,x2,y2:integer;
begin
  // Z軸は無視
  with Water do begin
    with DstBM.Canvas do begin
      x1:=trunc(lx);
      y1:=trunc(ly);
      x2:=trunc(nx);
      y2:=trunc(ny);
      if (x1=x2) and (y1=y2) then begin
        DstBM.Canvas.Pixels[trunc(nx),trunc(ny)]:=WaterColor[leave];
        end else begin
        Pen.Color:=WaterColor[leave];
        MoveTo(x1,y1);
        LineTo(x2,y2);
      end;
    end;
  end;
end;

procedure TRain.DrawPlateOne(DstBM:TBitmap;var Plate:TPlate);
begin
  // Z軸は無視
  with DstBM.Canvas do begin
    Pen.Color:=$ffff00;
    with Plate do begin
      MoveTo(trunc(x1),trunc(y1));
      LineTo(trunc(x2),trunc(y2));
    end;
  end;
end;

// -------------------------------------------------
// public
// -------------------------------------------------

procedure TRain.InitWater(_WaterCount:integer);
var
  cnt:integer;
begin
  WaterCount:=_WaterCount;
  SetLength(Water,WaterCount);
  for cnt:=0 to WaterCount-1 do begin
    InitWaterOne(Water[cnt]);
  end;
end;

procedure TRain.CalcWater;
var
  cnt:integer;
begin
  for cnt:=0 to WaterCount-1 do begin
    CalcWaterOne(Water[cnt]);
  end;
end;

procedure TRain.BlockWater;
var
  cnt:integer;
begin
  for cnt:=0 to WaterCount-1 do begin
    BlockWaterOne(Water[cnt]);
  end;
end;

procedure TRain.DrawWater(DstBM:TBitmap);
var
  cnt:integer;
begin
  for cnt:=0 to WaterCount-1 do begin
    DrawWaterOne(DstBM,Water[cnt]);
  end;
end;

procedure TRain.InitPlate(_PlateCount:integer);
var
  cnt:integer;
begin
  PlateCount:=_PlateCount;
  SetLength(Plate,PlateCount);
  for cnt:=0 to PlateCount-1 do begin
    SetPlate(cnt,0,0,0,0,0,0);
  end;
end;

procedure TRain.SetPlate(cnt:integer;_x1,_y1,_z1,_r,_l,_zl:single);
begin
  with Plate[cnt] do begin
    x1:=_x1;
    y1:=_y1;
    z1:=_z1;
    r:=_r;
    l:=_l;
    x2:=x1+(sin(r)*l);
    y2:=y1+(cos(r)*l);
    z2:=z1+_zl;
  end;
end;

procedure TRain.SetRotPlate(cnt:integer;_r:single);
begin
  with Plate[cnt] do begin
    r:=_r;
    x2:=x1+(sin(r)*l);
    y2:=y1+(cos(r)*l);
  end;
end;

procedure TRain.DrawPlate(DstBM:TBitmap);
var
  cnt:integer;
begin
  for cnt:=0 to PlateCount-1 do begin
    DrawPlateOne(DstBM,Plate[cnt]);
  end;
end;

procedure TRain.SetWaterColor(col:dword;HSVBM:TBitmap);
var
  cnt:integer;
begin
  if col=$000000 then begin
    for cnt:=0 to 512-1 do begin
      if $ff<=cnt then begin
        WaterColor[cnt]:=HSVBM.Canvas.Pixels[0,$ff];
        end else begin
        WaterColor[cnt]:=HSVBM.Canvas.Pixels[0,cnt];
      end;
    end;
    end else begin
    for cnt:=0 to 512-1 do begin
      if $ff<=cnt then begin
        WaterColor[cnt]:=col;
        end else begin
        WaterColor[cnt]:=ColorAlpha(col,cnt);
      end;
    end;
  end;
end;

procedure TRain.SetReflect(_Reflect:single);
begin
  Reflect:=_Reflect;
end;

end.


