{******************************************************************************}
{* Иллюстрация к книге "DirectX. Графика в проектах Delphi".                  *}
{* Издательство BHV. www.bhv.ru                                               *}
{* Краснов М.В. softgl@chat.ru                                                *}
{******************************************************************************}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AppEvnts,
  DirectXGraphics, DXGUtils;

type
  TfrmD3D = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FD3D            : IDIRECT3D8;
    FD3DDevice      : IDIRECT3DDEVICE8;
    FD3DVBLand      : IDIRECT3DVERTEXBUFFER8;
    FD3DVBEagle     : IDIRECT3DVERTEXBUFFER8;
    FActive         : BOOL;
    function Render : HRESULT;
    function InitD3D : HRESULT;
    function InitVBLand : HRESULT;
    function InitVBEagle : HRESULT;
    procedure DrawArea(const x, y :Integer);
    procedure Cleanup;
    procedure SetupLights;
    procedure ErrorOut (const Caption : PChar; const hError : HRESULT);
  public
    { Public declarations }
  end;

type
  TCUSTOMVERTEXLand = packed record
    X, Y, Z : Single;
    normVector : TD3DVector;
    Color : DWORD;
  end;

  TCUSTOMVERTEXEagle = packed record
    X, Y, Z : Single;
    normVector : TD3DVector;
  end;

const
  D3DFVF_CUSTOMVERTEXLand = D3DFVF_XYZ or D3DFVF_NORMAL or D3DFVF_DIFFUSE;
  D3DFVF_CUSTOMVERTEXEagle = D3DFVF_XYZ or D3DFVF_NORMAL;  

var
  frmD3D: TfrmD3D;

type
  LandParam = packed record
      Color : DWORD;
      h : Single;
      VecNormal : TD3DVector;
  end;

{$I eagle.pas}

const
  RandPoint = 400;
  FlatLand = 3;
  Numx = 77;
  NumZ = 60;
  Step = 0.2;

var
  matEagle : TD3DMatrix;
  Land : array [1..NumX,1..NumZ] of LandParam;

  matWrkRot : TD3DMatrix;

  AngleEagle : Integer;
  StepEagle : Single = 0.05;
  MaterialEagle : TD3DMaterial8;

implementation

{$R *.DFM}

procedure MoveLand;
var
  i, j : Integer;
  TempLand : array [1..NumX] of LandParam;  
begin
  for i := 1 to NumX do TempLand[i] := Land[i,NumZ];

  for j := NumZ downto 2 do
  for i := 1 to NumX do Land[i,j] := Land[i,j-1];

  for i := 1 to NumX do Land[i,1] := TempLand[i];
end;

procedure TfrmD3D.Cleanup;
begin
  if Assigned (FD3DVBLand) then begin
     FD3DVBLand._Release;
     FD3DVBLand := nil;
  end;

  if Assigned (FD3DVBEagle) then begin
     FD3DVBEagle._Release;
     FD3DVBEagle := nil;
  end;

  if Assigned (FD3DDevice) then begin
     FD3DDevice._Release;
     FD3DDevice := nil;
  end;

  if Assigned (FD3D) then begin
     FD3D._Release;
     FD3D := nil;
  end;
end;

procedure TfrmD3D.ErrorOut (const Caption : PChar; const hError : HRESULT);
begin
  FActive := False;
  Cleanup;
  MessageBox (Handle, PChar(DXGErrorString (hError)), Caption, 0);
end;

const
  fmtFullscreenArray : Array [0..4] of DWORD =
       (D3DFMT_R5G6B5,
        D3DFMT_X1R5G5B5,
        D3DFMT_A1R5G5B5,
        D3DFMT_X8R8G8B8,
        D3DFMT_A8R8G8B8);

var
  FD3DfmtFullscreen : DWORD;
  ScreenWidth, ScreenHeight : Integer;
  d3dpp : TD3DPRESENT_PARAMETERS;

function TfrmD3D.InitD3D : HRESULT;
var
  iFmt : Integer;
begin
  if FD3D = nil then FD3D := Direct3DCreate8(D3D_SDK_VERSION);
  if FD3D = nil then begin
     Result := E_FAIL;
     Exit;
  end;

  for iFmt := 0 to High(fmtFullscreenArray) do begin
      if( SUCCEEDED( FD3D.CheckDeviceType( D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL,
            fmtFullscreenArray[iFmt], fmtFullscreenArray[iFmt], FALSE ) ) )
        then begin
            FD3DfmtFullscreen := fmtFullscreenArray[iFmt];
            Break;
        end
  end;

  ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  ScreenHeight := GetSystemMetrics(SM_CYSCREEN);

  ZeroMemory(@d3dpp, SizeOf(d3dpp));
  with d3dpp do begin
       Windowed := False;
       SwapEffect := D3DSWAPEFFECT_DISCARD;
       BackBufferWidth  := ScreenWidth;
       BackBufferHeight := ScreenHeight;
       BackBufferFormat := FD3DfmtFullscreen;
       EnableAutoDepthStencil := True;
       AutoDepthStencilFormat := D3DFMT_D16;
  end;

  Result := FD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle,
                              D3DCREATE_SOFTWARE_VERTEXPROCESSING,
                              d3dpp, FD3DDevice);
end;

function TfrmD3D.Render : HRESULT;
var
  i, j :Integer;
begin
  FD3DDevice.Clear(0, nil, D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER,
                           $00000FFF, 1.0, 0);

  FD3DDevice.BeginScene;

  with FD3DDevice do begin
       SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
       SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW);
       SetRenderState(D3DRS_DIFFUSEMATERIALSOURCE, D3DMCS_COLOR1);
       SetTransform(D3DTS_WORLD, IdentityMatrix);
       LightEnable(2, False);
       SetStreamSource(0, FD3DVBLand, SizeOf(TCustomVertexLand));
       SetVertexShader(D3DFVF_CUSTOMVERTEXLand);
  end;

  for j := 2 to NumZ - 1 do
      for i := 1 to NumX - 5 do DrawArea(i, j);

  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matEagle);
       LightEnable(2, True);
       SetStreamSource(0, FD3DVBEagle, SizeOf(TCustomVertexEagle));
       SetVertexShader(D3DFVF_CUSTOMVERTEXEagle);
       SetRenderState(D3DRS_DIFFUSEMATERIALSOURCE, D3DMCS_MATERIAL);
       DrawPrimitive(D3DPT_TRIANGLELIST, 0, 10500 div 3);
  end;

  FD3DDevice.EndScene;

  Result := FD3DDevice.Present(nil, nil, 0, nil);
end;

procedure GenLand;
procedure CalcNormals (const wrkVector1, wrkVector2, wrkVector3 : TD3DVector;
                       var wrkVector : TD3DVector);
var
  wrki, vx1, vy1, vz1, vx2, vy2, vz2 : Single;
  nx, ny, nz : Single;
begin
  vx1 := wrkVector1.X - wrkVector2.X;
  vy1 := wrkVector1.Y - wrkVector2.Y;
  vz1 := wrkVector1.Z - wrkVector2.Z;

  vx2 := wrkVector2.X - wrkVector3.X;
  vy2 := wrkVector2.Y - wrkVector3.Y;
  vz2 := wrkVector2.Z - wrkVector3.Z;

  nx := vy1 * vz2 - vz1 * vy2;
  ny := vz1 * vx2 - vx1 * vz2;
  nz := vx1 * vy2 - vy1 * vx2;

  wrki := sqrt (nx * nx + ny * ny + nz * nz);
  if wrki = 0 then wrki := 1;

  wrkVector.X := nx / wrki;
  wrkVector.Y := ny / wrki;
  wrkVector.Z := nz / wrki;
end;
var
  i, j, k : Integer;
  x, z : Integer;
begin
  for i := 1 to RandPoint do begin
      x := random(NumX - 3) + 1;
      z := random(NumZ - 3) + 1;
      Land[x,z].h := random(500);
  end;
  for k := 1 to FlatLand do
     for i:= 2 to NumX do
         for j := 2 to NumZ do
         Land[i,j].h := (Land[i,j].h +
                         Land[(i + 1) mod NumX,j].h +
                         Land[i - 1, j].h +
                         Land[i,(j + 1) mod NumZ].h +
                         Land[i, j - 1].h) / 5;
  for i := 1 to NumX do
    for j := 1 to NumZ do
      with Land[i,j] do begin
           h := h / 100;
           if h>0.85 then h:=0.85;
           if h > 0.4
              then Land[i,j].Color := $00FFFFFF else
           if h > 0.2
              then Land[i,j].Color := $00804000 else
           if h > 0.1
              then Land[i,j].Color := $00FFFF00
           else Land[i,j].Color := $0000FF00;
  end;

  for i := 1 to NumX - 1 do
     for j := 1 to NumZ do
     CalcNormals (D3DVector (i * Step, Land[i, j - 1].h, (j - 1) * Step),
                  D3DVector (i * Step, Land[i, j].h, j * Step),
                  D3DVector ((i + 1) * Step, Land[i + 1, j - 1].h, (j - 1) * Step),
                  Land[i, j].VecNormal);
end;

procedure TfrmD3D.FormCreate(Sender: TObject);
var
  hRet : HRESULT;
  matView, matProj : TD3DMatrix;
  matWrk1, matWrk2, matWrk3 : TD3DMatrix;
begin
  Randomize;
  ShowCursor (False);

  hRet := InitD3D;
  if Failed (hRet) then ErrorOut ('InitD3D', hRet);
  hRet := InitVBLand;
  if Failed (hRet) then ErrorOut ('InitVertex', hRet);
  hRet := InitVBEagle;
  if Failed (hRet) then ErrorOut ('InitVertex', hRet);

  SetupLights;

  SetRotateYMatrix(matWrk1, Pi + Pi / 2);
  SetRotateXMatrix(matWrk2, Pi / 3);
  SetRotateZMatrix(matWrk3, Pi);

  SetTranslateMatrix (matEagle, 7.0, 2.0, 5.0);
  matEagle := MatrixMul (matEagle, MatrixMul (matWrk3,
                                       MatrixMul (matWrk1, matWrk2)));

  GenLand;

  MaterialEagle := InitMaterial(0.5, 0.25, 0.0, 0);
  FD3DDevice.SetMaterial(MaterialEagle);

  SetRotateXMatrix(matWrkRot, StepEagle);

  SetViewMatrix(matView, D3DVector(16, 2.5, 5), D3DVector(0, 0, 5), D3DVector(0, 1, 0));
  FD3DDevice.SetTransform(D3DTS_VIEW, matView);

  SetProjectionMatrix(matProj, 1, 1, 1, 15);
  FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
end;

procedure TfrmD3D.ApplicationEvents1Minimize(Sender: TObject);
begin
  FActive := False;
end;

procedure TfrmD3D.FormActivate(Sender: TObject);
begin
  FActive := True;
end;

procedure TfrmD3D.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
begin
  if FActive then begin
     Render;
     MoveLand;

     Inc (AngleEagle);
     if AngleEagle > 20 then begin
        StepEagle := -StepEagle;
        SetRotateXMatrix(matWrkRot, StepEagle);
        AngleEagle := 0;
     end;

     matEagle := MatrixMul (matEagle, matWrkRot);
  end;

  Done := False;
end;

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Close;
end;

procedure TfrmD3D.ApplicationEvents1Restore(Sender: TObject);
var
  matView, matProj : TD3DMatrix;
begin
  if Assigned (FD3DVBLand) then begin
     FD3DVBLand._Release;
     FD3DVBLand := nil;
  end;

  if Assigned (FD3DVBEagle) then begin
     FD3DVBEagle._Release;
     FD3DVBEagle := nil;
  end;

  WindowState := wsMaximized;

  InitD3D;

  InitVBLand;
  InitVBEagle;

  SetupLights;
  FD3DDevice.SetMaterial(MaterialEagle);  

  SetViewMatrix(matView, D3DVector(16, 2.5, 5), D3DVector(0, 0, 5), D3DVector(0, 1, 0));
  FD3DDevice.SetTransform(D3DTS_VIEW, matView);

  SetProjectionMatrix(matProj, 1, 1, 1, 15);
  FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);

  FActive := True;
end;

procedure TfrmD3D.FormDestroy(Sender: TObject);
begin
  Cleanup
end;

function TfrmD3D.InitVBLand : HRESULT;
begin
  Result := FD3DDevice.CreateVertexBuffer(4 * SizeOf(TCustomVertexLand), 0,
                                        D3DFVF_CUSTOMVERTEXLand,
                                        D3DPOOL_DEFAULT, FD3DVBLand);
end;

function TfrmD3D.InitVBEagle : HRESULT;
var
  Vertices : ^TCustomVertexEagle;
  hRet : HRESULT;
  i, j : Integer;
  vi : Integer;
  ni : Integer;
begin
  hRet := FD3DDevice.CreateVertexBuffer(10500 * SizeOf(TCustomVertexEagle), 0,
                                        D3DFVF_CUSTOMVERTEXEagle,
                                        D3DPOOL_DEFAULT, FD3DVBEagle);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  hRet := FD3DVBEagle.Lock(0, 10500 * SizeOf(TCustomVertexEagle), PByte(Vertices), 0);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  for i := 0 to sizeof(face_indicies) div sizeof(face_indicies[0]) - 1 do
      for j := 0 to 2 do begin
      vi := face_indicies[i][j];
      ni := face_indicies[i][j+3];

      Vertices.X := Avertices[vi][0] * 5;
      Vertices.Y := Avertices[vi][1] * 5;
      Vertices.Z := Avertices[vi][2] * 5;

      Vertices.normVector.X := normals[ni][0];
      Vertices.normVector.Y := normals[ni][1];
      Vertices.normVector.Z := normals[ni][2];

      Inc(Vertices);
  end;

  Result := FD3DVBEagle.Unlock;
end;

procedure TfrmD3D.SetupLights;
var
  Light0 : TD3DLight8;
  Light1 : TD3DLight8;
  Light2 : TD3DLight8;
begin
  Light0 := InitDirectionalLight(D3DVector(0, 0, -1), 0.3, 0.3, 0.3, 0);
  Light1 := InitDirectionalLight(VectorNormalize(D3DVector(-1, -1, -1)), 0.5, 0.5, 0.5, 0);
  Light2 := InitDirectionalLight(VectorNormalize(D3DVector(-1, 1, -1)), 1.0, 1.0, 1.0, 0);

  with FD3DDevice do begin
       SetLight(0, Light0);
       SetLight(1, Light1);
       SetLight(2, Light2);

       LightEnable(0, True);
       LightEnable(1, True);
  end;
end;

procedure TfrmD3D.ApplicationEvents1Deactivate(Sender: TObject);
begin
  FActive := False;
  Application.Minimize;
end;

procedure TfrmD3D.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide;
end;

procedure TfrmD3D.DrawArea(const x, y : Integer);
var
  Vertices : ^TCustomVertexLand;
begin
  FD3DVBLand.Lock(0, 4 * SizeOf(TCustomVertexLand), PByte(Vertices), 0);

  Vertices.X := x * Step;
  Vertices.Y := Land[x, y - 1].h;
  Vertices.Z := (y - 1) * Step;
  Vertices.normVector := Land[x, y - 1].VecNormal;
  Vertices.Color := Land[x, y - 1].Color;
  Inc (Vertices);

  Vertices.X := x * Step;
  Vertices.Y := Land[x, y].h;
  Vertices.Z := y * Step;
  Vertices.normVector := Land[x, y].VecNormal;
  Vertices.Color := Land[x, y].Color;
  Inc (Vertices);

  Vertices.X := (x + 1) * Step;
  Vertices.Y := Land[x + 1, y - 1].h;
  Vertices.Z := (y - 1) * Step;
  Vertices.normVector := Land[x + 1, y - 1].VecNormal;
  Vertices.Color := Land[x + 1, y - 1].Color;
  Inc (Vertices);

  Vertices.X := (x + 1) * Step;
  Vertices.Y := Land[x + 1, y].h;
  Vertices.Z := y * Step;
  Vertices.normVector := Land[x + 1, y].VecNormal;
  Vertices.Color := Land[x + 1, y].Color;

  FD3DVBLand.Unlock;
  FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2);
end;

end.
