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:
//  * Drawing a simple 3D cube with ambient occlusion (not really visible as the cube is a very flat and
//    simple) and a bloom effect, with a depth pre-pass. Optionally, the cube can also be rendered with
//    a texture. This illustrates how the rendering pipeline generally works.

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;
    FTimer: TTimer;
    FTextRenderer: TTextRenderer;

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

    FModelCube: TMeshModel;
    FTexture: TTexture;

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

    FTicks: Integer;
    FTextured: Boolean;

    procedure RenderingControlResize(Sender: TObject);
    procedure RenderingControlPaint(Sender: TObject);
    procedure RenderingControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
    procedure RenderCube(const AScene: TScene);
    procedure CreateRenderingControl;
  public
  end;

var
  MainForm: TMainForm;

implementation
{$R *.lfm}

uses
  LCLType;

const
  VertexElements: array[0..2] of TVertexElement = (
    (Name: 'vertexPosition'; Format: TElementFormat.Float; Count: 3; Channel: 0; Offset: 0),
    (Name: 'vertexNormal'; Format: TElementFormat.Float; Count: 3; Channel: 0; Offset: 0),
    (Name: 'vertexTexCoord'; Format: TElementFormat.Float; Count: 2; Channel: 0; Offset: 0));

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

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

    FCanvas := TCanvas.Create(FDevice);
    FTextRenderer := TTextRenderer.Create(FCanvas, Point2i(256, 256), TPixelFormat.LA8);

    FTimer := TTimer.Create;
    FTimer.Speed := 60.0;

    FTextureCabinet := TTextureCabinet.Create(FDevice, FDisplaySize, TTextureFidelity.Medium, 8);
    FTextureCabinet.Attributes := [TTextureCabinetAttribute.Bloom, TTextureCabinetAttribute.BloomCubic];

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

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

    FSceneLights := TSceneLights.Create(FDevice);
    // Add some light.
    LSceneLight := FSceneLights.Add;
    LSceneLight.AmbientColor := FloatColorRGB($FFFFFF);
    LSceneLight.AlbedoColor := FloatColorRGB($FFFFFF);
    LSceneLight.SpecularColor := FloatColorRGB($FFFFFF);
    LSceneLight.Position := Vector3f(300.0, 800.0, -300.0);

    // Create cube mesh.
    LMeshBuffer := TMeshBuffer.Create;
    if LMeshBuffer.Handle <> nil then
    try
      LMeshBuffer.Cube(1, 1, 1, TVector3f.Zero, Vector3f(100.0, 0.0, 0.0), Vector3f(0.0, 100.0, 0.0),
        Vector3f(0.0, 0.0, 100.0), TPoint2f.Zero, TPoint2f.Unity, TFloatColor.White, True);

      // Replace above statement with the following to create a 3D sphere instead.
      // LMeshBuffer.SuperEllipse(32, 32, TVector3f.Zero, Vector3f(75.0, 75.0, 75.0), 0.0, 2.0 * Pi, 1.0,
      //   0.0, 2.0 * Pi, 1.0, TPoint2f.Zero, TPoint2f.Unity, TFloatColor.White, True);

      FModelCube := LMeshBuffer.Model(FDevice, VertexElements);
    finally
      LMeshBuffer.Free;
    end;

    // Load texture from disk.
    FTexture := TTexture.Create(FDevice, '../../../../Media/ForkLift.png', TPixelFormat.RGBA8,
      TTextureAttribute.MipMapping);

    // Build view matrix, which determines what we are looking at in the scene.
    FView := TMatrix4f.LookAt(Vector3f(0.0, 50.0, -300.0), TVector3f.Zero, TVector3f.AxisY);
  except
    on E: EAfterwarpException do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Application.Terminate;
      Exit;
    end;
  end;
  Application.OnIdle := ApplicationIdle;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FTexture.Free;
  FModelCube.Free;
  FSceneLights.Free;
  FSceneModeling.Free;
  FSceneDepthNormals.Free;
  FTextureCabinet.Free;
  FTimer.Free;
  FTextRenderer.Free;
  FCanvas.Free;
  FSwapChain.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
  LSceneAttributes: TSceneAttributes;
  LFontParams: TFontParameters;
  LMaterial: TObjectMaterial;
  LTechString: string;
begin
  FWorld := TMatrix4f.RotateY(FTicks * 0.022) * TMatrix4f.RotateX(FTicks * 0.0371);
  FProjection := TMatrix4f.PerspectiveFOVY(Pi * 0.25, FDisplaySize.X / FDisplaySize.Y, 10.0, 1800.0);

  // 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.
  LSceneAttributes := [TSceneAttribute.Normals];

  // Depth pre-pass.
  FTextureCabinet.Clear(TTextureCabinetPass.Depth);
  FTextureCabinet.BeginScene(TTextureCabinetPass.Depth);
  try
    FSceneDepthNormals.Attributes := LSceneAttributes;
    FSceneDepthNormals.View := FView;
    FSceneDepthNormals.Projection := FProjection;

    FSceneDepthNormals.BeginScene;
    try
      RenderCube(FSceneDepthNormals);
    finally
      FSceneDepthNormals.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Occlusion, FProjection);

  // Render main scene.
  FTextureCabinet.Clear(TTextureCabinetPass.Color, FloatColor(0.25, 0.25, 0.25, 1.0));
  FTextureCabinet.BeginScene(TTextureCabinetPass.Color);
  try
    // Set array of lights that should be used for 3D scene.
    FSceneModeling.Lights := FSceneLights;
    FSceneModeling.TextureCabinet := FTextureCabinet;

    FSceneModeling.Attributes := LSceneAttributes;
    FSceneModeling.View := FView;
    FSceneModeling.Projection := FProjection;

    if FTextured then
      FSceneModeling.Texture[TSceneTextureType.Albedo] := FTexture
    else
      FSceneModeling.Texture[TSceneTextureType.Albedo] := TTexture(NullObject);

    FSceneModeling.Prepare;
    FSceneModeling.BeginScene;
    try
      RenderCube(FSceneModeling);
    finally
      FSceneModeling.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Bloom);

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

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

    // Draw 2D text on top of 3D scene.
    FCanvas.BeginScene;
    try
      FCanvas.SamplerState := TCanvasSamplerState.Create(TTextureFilter.Nearest, TTextureFilter.Nearest);
      FCanvas.ContextState := TCanvasContextState.FlatText;
      FCanvas.Attributes := [];

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

      FTextRenderer.DrawAligned(Point2f(FDisplaySize.X - 8.0 * FDisplayScale,
        FDisplaySize.Y - 6.0 * FDisplayScale), 'Frame Rate: ' + IntToStr(Round(FTimer.FrameRate)),
        ColorPair($FF40E0FF, $FF2020FF), TTextAlignment.Ending, TTextAlignment.Ending);

      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.DrawAligned(Point2f(8.0 * FDisplayScale, 4.0 * FDisplayScale), LTechString,
        ColorPair($FF40E0FF, $FF2020FF), TTextAlignment.Start, TTextAlignment.Start);

      FTextRenderer.DrawAligned(Point2f(4.0 * FDisplayScale, FDisplaySize.Y - 4.0 * FDisplayScale),
        'Press Space to switch between colored and textured cube.', $A0FFFFFF,
        TTextAlignment.Start, TTextAlignment.Ending);
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;

  // Perform timing calculations.
  FTimer.Update;

  // Extract fixed-rate processing tokens (60 times per second), if there are any.
  Inc(FTicks, FTimer.Tokens);

  // On Linux we are using TOpenGLControl from LCL for rendering.
{$IFNDEF MSWINDOWS}
  TOpenGLControl(FRenderingControl).SwapBuffers;
{$ENDIF}
end;

procedure TMainForm.RenderingControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_SPACE then
    FTextured := not FTextured;
end;

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

procedure TMainForm.RenderCube(const AScene: TScene);
var
  LMaterial: TObjectMaterial;
begin
  if AScene.Handle = FSceneModeling.Handle then
  begin
    LMaterial := TObjectMaterial.Default;
    if FTextured then
    begin
      LMaterial.AmbientColor := FloatColorRGB($00404040);
      LMaterial.AlbedoColor := FloatColor($FFFFFFFF);
    end
    else
    begin
      LMaterial.AmbientColor := FloatColorRGB($004000);
      LMaterial.AlbedoColor := FloatColor($A000FF00);
    end;
    LMaterial.SpecularColor := FloatColorRGB($FFFFFF);
    LMaterial.SpecularExponent := 4.0;
    AScene.Material := LMaterial;
  end;
  AScene.World := FWorld;
  FModelCube.Draw(AScene.SceneProgram);
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;
    OnKeyDown := RenderingControlKeyDown;
  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;
    OnKeyDown := RenderingControlKeyDown;

    MakeCurrent;
  end;
{$ENDIF}
end;

end.
