unit MainFm;
(*
 * Copyright (c) 2015 - 2025 Dr. Yuriy Kotsarenko. All rights reserved.
 *
 * Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in
 * compliance with the License. You may obtain a copy of the License at
 *   http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software distributed under the License is
 * distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and limitations under the License.
 *)

// This example illustrates the following features:
//  * Creating vertex and index buffers manually to render a single triangle.
//  * HDR color rendering with bloom effect.
//  * Optional depth pre-pass.

interface

{$INCLUDE PXT.Config.inc}

uses
{$IFDEF MSWINDOWS}
  PXT.Controls,
{$ELSE}
  OpenGLContext,
{$ENDIF}
  Graphics, Classes, SysUtils, Forms, Controls, Dialogs, PXT.Types, PXT.Graphics;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRenderingControl: TWinControl;

    FDisplaySize: TPoint2i;
    FDisplayScale: Single;

    FDevice: TDevice;
    FSwapChain: TSwapChain;
    FCanvas: TCanvas;
    FTextRenderer: TTextRenderer;

    FTextureCabinet: TTextureCabinet;
    FSceneDepthNormals: TScene;
    FSceneModeling: TScene;
    FSceneLights: TSceneLights;

    FWorld: TMatrix4f;
    FView: TMatrix4f;
    FProjection: TMatrix4f;

    FBufferVertices: TBuffer;
    FBufferColors: TBuffer;
    FBufferIndices: TBuffer;

    procedure RenderingControlResize(Sender: TObject);
    procedure RenderingControlPaint(Sender: TObject);
    procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
    procedure RenderTriangle(const AScene: TScene);
    procedure CreateBuffers;
    procedure CreateRenderingControl;
  public
  end;

var
  MainForm: TMainForm;

implementation
{$R *.lfm}

uses
  PXT.Headers;

const
  VertexElements: array[0..1] of TVertexElement = (
    (Name: 'vertexPosition'; Format: TElementFormat.Float; Count: 3; Channel: 0; Offset: 0),
    (Name: 'vertexColor'; Format: TElementFormat.UnsignedByte; Count: 4; Channel: 1 or TVertexElement.Normalized; Offset: 0));

  DepthPrePass: Boolean = True;

procedure TMainForm.FormCreate(Sender: TObject);
var
  LSceneLight: PSceneLight;
begin
  CreateRenderingControl;
  FDisplaySize := Point2i(ClientWidth, ClientHeight);
  FDisplayScale := PixelsPerInch / 96.0;
  try
  {$IFDEF MSWINDOWS}
    FDevice := TDevice.Create;
  {$ELSE}
    // On Linux, using TOpenGLContext control from LCL.
    FDevice := TDevice.CreateWrapped;
  {$ENDIF}

    FSwapChain := TSwapChain.Create(FDevice,
      {$IFDEF MSWINDOWS}TRenderingControl(FRenderingControl).WindowHandle{$ELSE}0{$ENDIF},
      FDisplaySize, TPixelFormat.RGBA8, TPixelFormat.D16, 8, False);

    FCanvas := TCanvas.Create(FDevice);
    FTextRenderer := TTextRenderer.Create(FCanvas, Point2i(256, 256), TPixelFormat.LA8);
    FTextureCabinet := TTextureCabinet.Create(FDevice, FDisplaySize, TTextureFidelity.Medium, 8);

    FSceneDepthNormals := TScene.CreateDepthNormals(FDevice);
    FSceneDepthNormals.SetVertexElements(0, VertexElements);

    FSceneModeling := TScene.CreateModeling(FDevice);
    FSceneModeling.SetVertexElements(0, VertexElements);

    FSceneLights := TSceneLights.Create(FDevice);

    CreateBuffers;

    // Create a light source for illuminating the triangle.
    LSceneLight := FSceneLights.Add;
    LSceneLight.AmbientColor := FloatColorRGB($FFFFFF);
    LSceneLight.AlbedoColor := FloatColorRGB($FFFFFF);
    LSceneLight.SpecularColor := FloatColorRGB($FFFFFF);
    LSceneLight.Position := Vector3f(0.0, 20.0, -300.0);
  except
    on E: EAfterwarpException do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Application.Terminate;
      Exit;
    end;
  end;

  FView := TMatrix4f.LookAt(Vector3f(0.0, 0.0, -80.0), TVector3f.Zero, TVector3f.AxisY);
  Application.OnIdle := ApplicationIdle;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FBufferIndices.Free;
  FBufferColors.Free;
  FBufferVertices.Free;
  FSceneLights.Free;
  FSceneModeling.Free;
  FSceneDepthNormals.Free;
  FTextureCabinet.Free;
  FTextRenderer.Free;
  FCanvas.Free;
  FDevice.Free;
end;

procedure TMainForm.RenderingControlResize(Sender: TObject);
begin
  FDisplaySize := Point2i(FRenderingControl.Width, FRenderingControl.Height);
  FSwapChain.Resize(FDisplaySize);
  FTextureCabinet.Size := FDisplaySize;
end;

procedure TMainForm.RenderingControlPaint(Sender: TObject);
var
  LDepthClipNegative: Boolean;
  LParameters: TFontParameters;
  LAttributes: TSceneAttributes;
  LTechString: string;
  LTicks: Double;
begin
  LDepthClipNegative := FDevice.Behavior and TDeviceBehavior.DepthClipNegative <> 0;
  LTicks := GetSystemTicks / 1000.0;

  // Configure world and projection matrix.
  FWorld := TMatrix4f.RotateY(Pi * (SineCycle(LTicks * 0.0001) - 0.5) * 0.25);
  FProjection := TMatrix4f.PerspectiveFOVY(Pi * 0.25, FDisplaySize.X / FDisplaySize.Y, 10.0, 2000.0,
    LDepthClipNegative);

  // Update texture cabinet's attributes.
  FTextureCabinet.Attributes := [TTextureCabinetAttribute.Bloom, TTextureCabinetAttribute.BloomCubic];

  // Perform light assignment for 3D scene.
  FSceneLights.ViewSize := FDisplaySize;

  // Only one light is used for the entire scene, so only minimal light culling is required.
  FSceneLights.ClustersCullingMode := TClustersCullingMode.Performance;
  FSceneLights.ClusterSize := 512;
  FSceneLights.DepthSlices := 1;

  FSceneLights.Execute(FSceneModeling.View, FSceneModeling.Projection);

  // Prepare scene's attributes.
  LAttributes := [TSceneAttribute.Coloring];

  // Make a depth pre-pass.
  if DepthPrePass then
  begin
    FTextureCabinet.Clear(TTextureCabinetPass.Depth);
    FTextureCabinet.BeginScene(TTextureCabinetPass.Depth);
    try
      FSceneDepthNormals.Attributes := LAttributes;

      RenderTriangle(FSceneDepthNormals);
    finally
      FTextureCabinet.EndScene;
    end;
  end;

  // Render main scene.
  FTextureCabinet.Clear(TTextureCabinetPass.Color, FloatColor(0.25, 0.25, 0.25));
  FTextureCabinet.BeginScene(TTextureCabinetPass.Color);
  try
    FSceneModeling.Lights := FSceneLights;
    FSceneModeling.Attributes := LAttributes;

    RenderTriangle(FSceneModeling);
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Bloom);

  // Note: for semi-transparent objects, it is possible to do a "glassy" (order-independent transparency)
  // rendering pass here. To see how it is done, please check other examples.

  // Render on the form.
  FSwapChain.BeginScene;
  try
    // Clear the screen (basically to discard its contents, for performance reasons).
    FDevice.Clear([TClearLayer.Color], FloatColor(0.5, 0.0, 0.0));

    // Present 3D scene on the screen.
    FTextureCabinet.Present;

    // Draw 2D text on top of 3D scene.
    FCanvas.BeginScene;
    try
      FCanvas.ContextState := TCanvasContextState.FlatText;
      FCanvas.SamplerState := TCanvasSamplerState.Default;

      LParameters := TFontParameters.Create('Segoe UI', 14.0 * FDisplayScale, TFontWeight.SemiBold);
      LParameters.Effect.BorderType := TFontBorder.SemiHeavy;
      LParameters.Effect.BorderBrightness := 1.0;
      LParameters.Effect.FillBrightness := 0.0;
      LParameters.Effect.ShadowBrightness := 0.75;
      LParameters.Effect.ShadowOpacity := 1.0;
      FTextRenderer.FontParameters := LParameters;

      if FDevice.Technology = TDeviceTechnology.Direct3D then
        LTechString := 'Direct3D (' + IntToStr(FDevice.TechVersion shr 8) + '.' +
          IntToStr((FDevice.TechVersion shr 4) and $0F) + '), features: '
      else
        LTechString := 'OpenGL (' + IntToStr(FDevice.TechVersion shr 8) + '.' +
          IntToStr((FDevice.TechVersion shr 4) and $0F) + '+), features: ';

      LTechString := LTechString + IntToStr(FDevice.TechFeatureVersion shr 8) + '.' +
        IntToStr((FDevice.TechFeatureVersion shr 4) and $0F);

      FTextRenderer.Draw(Point2f(8.0 * FDisplayScale, 4.0 * FDisplayScale), LTechString,
        ColorPair($FFC0FFC0, $FFFF8020));
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;
  // On Linux we are using TOpenGLControl from LCL for rendering.
{$IFNDEF MSWINDOWS}
  TOpenGLControl(FRenderingControl).SwapBuffers;
{$ENDIF}
end;

procedure TMainForm.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
  FRenderingControl.Invalidate;
  Done := False;
end;

procedure TMainForm.RenderTriangle(const AScene: TScene);
var
  LModeling: Boolean;
  LMaterial: TObjectMaterial;
  LProgram: TProgram;
begin
  // Set view and projection matrices.
  AScene.View := FView;
  AScene.Projection := FProjection;

  // Note: the following call is not required for depth/normals scene, so it will fail during depth
  // pre-pass, which is how we detect whether we are rendering to "depth/normals" or "modeling" scene.
  LModeling := AScene.TryPrepare;

  AScene.BeginScene;
  try
    // Set world matrix to position the object accordingly in 3D scene.
    AScene.World := FWorld;

    // Prepare material to make sure triangle has some specular highlight and produce bloom.
    // Note: albedo's alpha-channel is actually a bloom coefficient when rendering main scene.
    if LModeling then
    begin
      LMaterial := TObjectMaterial.Default;
      LMaterial.AmbientColor := FloatColorRGB($00404040);
      LMaterial.AlbedoColor := FloatColor($B0FFFFFF);
      LMaterial.SpecularColor := FloatColorRGB($00FFFFFF);
      LMaterial.SpecularExponent := 8.0;
      AScene.Material := LMaterial;
    end;

    // Retrieve current scene's program, bind buffers to it and then draw a single triangle.
    LProgram := AScene.SceneProgram;

    LProgram.Bind(FBufferVertices, 0);
    LProgram.Bind(FBufferColors, 1);
    LProgram.Bind(FBufferIndices, 0);

    LProgram.DrawIndexed(TPrimitiveTopology.Triangles, 3);
  finally
    AScene.EndScene;
  end;
end;

procedure TMainForm.CreateBuffers;
const
  TriangleVertices: array[0..2] of TVector3f = (
    (X: 0.0; Y: 32.0; Z: 0.0), (X: -30.0; Y: -28.0; Z: 0.0), (X: 30.0; Y: -28.0; Z: 0.0));
  TriangleColors: array[0..2] of TIntColor = ($FF00FF00, $FFFF0000, $FF0000FF);
  TriangleIndices: array[0..2] of Word = (0, 1, 2);
begin
  FBufferVertices := TBuffer.Create(FDevice, TBufferDataType.Vertex, TBufferAccessType.Static,
    SizeOf(TriangleVertices), SizeOf(TVector3f), TPixelFormat.Unknown, @TriangleVertices[0]);

  FBufferColors := TBuffer.Create(FDevice, TBufferDataType.Vertex, TBufferAccessType.Static,
    SizeOf(TriangleColors), SizeOf(TIntColor), TPixelFormat.Unknown, @TriangleColors[0]);

  FBufferIndices := TBuffer.Create(FDevice, TBufferDataType.Index, TBufferAccessType.Static,
    SizeOf(TriangleIndices), SizeOf(Word), TPixelFormat.Unknown, @TriangleIndices[0]);
end;

procedure TMainForm.CreateRenderingControl;
begin
{$IFDEF MSWINDOWS}
  FRenderingControl := TRenderingControl.Create(nil);
  FRenderingControl.Parent := Self;
  FRenderingControl.Align := alClient;
  FRenderingControl.Width := 256;
  FRenderingControl.Height := 256;

  with FRenderingControl as TRenderingControl do
  begin
    OnPaint := RenderingControlPaint;
    OnResize := RenderingControlResize;
  end;
{$ELSE}
  FRenderingControl := TOpenGLControl.Create(nil);
  FRenderingControl.Parent := Self;
  FRenderingControl.Align := alClient;
  FRenderingControl.Width := 256;
  FRenderingControl.Height := 256;

  with FRenderingControl as TOpenGLControl do
  begin
    OpenGLMajorVersion := 3;
    OpenGLMinorVersion := 3;
    DepthBits := 0;
    OnPaint := RenderingControlPaint;
    OnResize := RenderingControlResize;

    MakeCurrent;
  end;
{$ENDIF}
end;

end.
