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:
//  * Parallax Mapping with optional super-sampling to produce realistic looking surfaces using a
//    combination of normal map, displacement map and ambient occlusion map textures. The example shows
//    the difference between different techniques.
//  * Third-person view camera with location-based zoom (zooms in or out where the mouse is pointing at).
 
interface

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

type
  TRenderingTechnique = (
    // Textured plane.
    Normal,

    // Textured plane with bump-mapping.
    // This uses texture and normal map.
    BumpMapping,

    // Textured plane with bump-mapping and parallax mapping.
    // This uses texture, normal, displacement and ambient occlusion maps.
    ParallaxMapping,

    // Textured plane with bump-mapping, parallax mapping and super-sampling.
    // This uses texture, normal, displacement and ambient occlusion maps.
    ParallaxMappingSuperSample);

  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRenderingControl: TWinControl;
    FDisplaySize: TPoint2i;
    FDisplayScale: Single;
    FMousePos: TPoint2i;

    FDevice: TDevice;
    FSwapChain: TSwapChain;
    FCanvas: TCanvas;
    FTextRenderer: TTextRenderer;
    FTimer: TTimer;
    FCamera: TActorCamera;

    FSceneLights: TSceneLights;
    FMaterials: TObjectMaterials;

    FTextureCabinet: TTextureCabinet;

    FSceneDepthNormals: TScene;
    FSceneModeling: TScene;

    FModelPlane: TMeshModel;
    FTextureAlbedo: TTexture;
    FTextureNormalMap: TTexture;
    FTextureNormalAmbientMap: TTexture;
    FTextureParallaxMap: TTexture;

    FWorld: TMatrix4f;
    FView: TMatrix4f;
    FProjection: TMatrix4f;
    FRenderingTechnique: TRenderingTechnique;

    procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
    procedure RenderingControlResize(Sender: TObject);
    procedure RenderingControlMouseDown(Sender: TObject; Button: Controls.TMouseButton; Shift: TShiftState;
      X, Y: Integer);
    procedure RenderingControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure RenderingControlMouseUp(Sender: TObject; Button: Controls.TMouseButton; Shift: TShiftState;
      X, Y: Integer);
    procedure RenderingControlMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
      var Handled: Boolean);
    procedure RenderingControlMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
      var Handled: Boolean);
    procedure RenderingControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure RenderingControlPaint(Sender: TObject);
    procedure RenderPlane(const AScene: TScene);
    procedure CreateRenderingControl;
  public
  end;

var
  MainForm: TMainForm;

implementation
{$R *.lfm}

uses
  LCLType, SysUtils, Math;

const
  VertexElements: array[0..3] 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: 'vertexTangent'; 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
  LParallaxParams: TParallaxMappingParameters;
  LMeshBuffer: TMeshBuffer;
  LLight: PSceneLight;
begin
  CreateRenderingControl;
  FDisplaySize := Point2i(FRenderingControl.Width, FRenderingControl.Height);
  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.Unknown, TPixelFormat.Unknown, 0, True);

    FCanvas := TCanvas.Create(FDevice);
    FTextRenderer := TTextRenderer.Create(FCanvas, Point2i(256, 256), TPixelFormat.LA8);
    FTimer := TTimer.Create;
    FSceneLights := TSceneLights.Create(FDevice);
    FMaterials := TObjectMaterials.Create;

    FTextureCabinet := TTextureCabinet.Create(FDevice, FDisplaySize, TTextureFidelity.Medium, 4,
      TPixelFormat.D32F);
    // Update texture cabinet's attributes.
    FTextureCabinet.Attributes := [TTextureCabinetAttribute.Bloom, TTextureCabinetAttribute.BloomCubic];

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

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

    // Update parallax mapping parameters.
    FillChar(LParallaxParams, SizeOf(TParallaxMappingParameters), 0);
    LParallaxParams.Scale := 0.1;
    LParallaxParams.SamplesMin := 8;
    LParallaxParams.SamplesMax := 32;
    LParallaxParams.Occlusion := 1.0;
    FSceneModeling.ParallaxMappingParameters := LParallaxParams;

    FCamera := TActorCamera.Create(Vector3f(0.0, 0.0, 0.0), Vector3f(Pi * 0.25, Pi * -0.25, 0.0), 400.0);
    FCamera.Constraints := TCameraConstraints.Create(
      Vector4f(-300.0, -150.0, -300.0,  100.0),
      Vector4f( 300.0,  150.0,  300.0, 1500.0),
      Vector4f(Pi * 0.1, 0.0, 0.0, 0.0),
      Vector4f(Pi * 0.4, 0.0, 0.0, 0.0));

    LMeshBuffer := TMeshBuffer.Create;
    try
      LMeshBuffer.Plane(1, 1, TVector3f.Zero, Vector3f(1600.0, 0.0, 0.0), Vector3f(0.0, 0.0, 1600),
        TVector3f.AxisY, TPoint2f.Zero, Point2f(10.0, 10.0), TFloatColor.White);

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

    // Load textures.
    FTextureAlbedo := TTexture.Create(FDevice, '../../../../Media/Textures/StoneWall-Albedo.jpg',
      TPixelFormat.RGBA8, TTextureAttribute.MipMapping);

    FTextureNormalMap := TTexture.Create(FDevice, '../../../../Media/Textures/StoneWall-NormalMap.jpg',
      TPixelFormat.RGBA8, TTextureAttribute.MipMapping);

    FTextureNormalAmbientMap := TTexture.CreateFromFilesNormalsAndOcclusion(FDevice,
      '../../../../Media/Textures/StoneWall-NormalMap.jpg',
      '../../../../Media/Textures/StoneWall-Ambient.jpg',
      TTextureAttribute.MipMapping);

    FTextureParallaxMap := TTexture.CreateFromFileParallax(FDevice,
      '../../../../Media/Textures/StoneWall-ParallaxMap.png', TPixelFormat.L8,
      TTextureAttribute.MipMapping);

    // Create a light source for illuminating the surface.
    LLight := FSceneLights.Add;
    LLight.AmbientColor := FloatColorRGB($FFFFFF);
    LLight.AlbedoColor := FloatColorRGB($FFFFFF);
    LLight.SpecularColor := FloatColorRGB($FFFFFF);
    LLight.Position := Vector3f(100.0, 400.0, -100.0);
  except
    on E: EAfterwarpException do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Application.Terminate;
      Exit;
    end;
  end;
  FRenderingTechnique := TRenderingTechnique.ParallaxMappingSuperSample;
  Application.OnIdle := ApplicationIdle;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FTextureParallaxMap.Free;
  FTextureNormalAmbientMap.Free;
  FTextureNormalMap.Free;
  FTextureAlbedo.Free;
  FSceneModeling.Free;
  FSceneDepthNormals.Free;
  FTextureCabinet.Free;
  FMaterials.Free;
  FSceneLights.Free;
  FCamera.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
  LDepthClipNegative: Boolean;
  LRenderingState: TRenderingState;
  LAttributes: TSceneAttributes;
  LFontParams: TFontParameters;
  LTechString, LText: string;
begin
  LDepthClipNegative := FDevice.Behavior and TDeviceBehavior.DepthClipNegative <> 0;

  // Configure matrices.
  FWorld := TMatrix4f.Translate(0.0, -0.01, 0.0);
  FView := FCamera.View;
  FProjection := TMatrix4f.PerspectiveFOVY(Pi * 0.25, FDisplaySize.X / FDisplaySize.Y,
    10.0, 2000.0, LDepthClipNegative);

  // 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(FView, FProjection);

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

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

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

  // Render main scene.
  FTextureCabinet.Clear(TTextureCabinetPass.Color, TFloatColor.Black);
  FTextureCabinet.BeginScene(TTextureCabinetPass.Color);
  try
    FSceneModeling.Lights := FSceneLights;
    FSceneModeling.Texture[TSceneTextureType.Albedo] := FTextureAlbedo;

    if FRenderingTechnique >= TRenderingTechnique.ParallaxMapping then
      FSceneModeling.Texture[TSceneTextureType.NormalMap] := FTextureNormalAmbientMap
    else if FRenderingTechnique >= TRenderingTechnique.BumpMapping then
      FSceneModeling.Texture[TSceneTextureType.NormalMap] := FTextureNormalMap
    else
      FSceneModeling.Texture[TSceneTextureType.NormalMap] := TTexture(NullObject);

    if FRenderingTechnique >= TRenderingTechnique.ParallaxMapping then
      FSceneModeling.Texture[TSceneTextureType.ParallaxMap] := FTextureParallaxMap
    else
      FSceneModeling.Texture[TSceneTextureType.ParallaxMap] := TTexture(NullObject);

    if FRenderingTechnique >= TRenderingTechnique.ParallaxMappingSuperSample then
    begin
      LRenderingState := FDevice.RenderingState;
      LRenderingState.States := LRenderingState.States or TRenderingState.State.PerSampleShading;
      FDevice.RenderingState := LRenderingState;
    end;

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

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

  // Render on the main form.
  FSwapChain.BeginScene;
  try
    FDevice.Clear([TClearLayer.Color], FloatColor($FF404040));
    FTextureCabinet.Present;

    FCanvas.BeginScene;
    try
      FCanvas.Attributes := [];
      FCanvas.SamplerState := TCanvasSamplerState.Default;
      FCanvas.ContextState := TCanvasContextState.FlatText;

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

      FTextRenderer.DrawAligned(Point2f(FDisplaySize.X * 0.5, 4.0 * FDisplayScale),
        'Press Space to change between techniques', ColorPair($FFA5E7B8, $FF77FFCE),
        TTextAlignment.Middle, TTextAlignment.Start);

      case FRenderingTechnique of
        TRenderingTechnique.Normal:
          LText := 'Current technique: Normal (textured plane)';

        TRenderingTechnique.BumpMapping:
          LText := 'Current technique: Bump-Mapping';

        TRenderingTechnique.ParallaxMapping:
          LText := 'Current technique: Parallax Mapping';

        else
          LText := 'Current technique: Parallax Mapping with Super-Sampling';
      end;

      FTextRenderer.DrawAligned(Point2f(FDisplaySize.X * 0.5, FDisplaySize.Y - 4.0 * FDisplayScale),
        LText, ColorPair($FFA5E7B8, $FF77FFCE), TTextAlignment.Middle, 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.Draw(Point2f(8.0 * FDisplayScale, 8.0 * FDisplayScale), Utf8String(LTechString),
        ColorPair($FF40E0FF, $FF2020FF));

      FTextRenderer.DrawAligned(Point2f(FDisplaySize.X - 8.0 * FDisplayScale, FDisplaySize.Y -
        8.0 * FDisplayScale), Utf8String('Frame Rate: ' + IntToStr(Round(FTimer.FrameRate))),
        ColorPair($FF40E0FF, $FF2020FF), TTextAlignment.Ending, TTextAlignment.Ending);
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;
  FTimer.Update;
{$IFNDEF MSWINDOWS}
  TOpenGLControl(FRenderingControl).SwapBuffers;
{$ENDIF}
end;

procedure TMainForm.RenderingControlMouseDown(Sender: TObject; Button: Controls.TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LPosition: TVector3f;
begin
  FMousePos := Point2i(X, Y);
  LPosition := Vector3f(FMousePos.X, FMousePos.Y, 0.0);

  if Button = mbLeft then
    FCamera.Command(TCameraCommand.Rotation, LPosition, FDisplaySize)
  else
    FCamera.Command(TCameraCommand.Dragging, LPosition, FDisplaySize);
end;

procedure TMainForm.RenderingControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  LPosition: TVector3f;
begin
  FMousePos := Point2i(X, Y);
  LPosition := Vector3f(FMousePos.X, FMousePos.Y, 0.0);
  FCamera.Command(TCameraCommand.Update, LPosition, FDisplaySize);
end;

procedure TMainForm.RenderingControlMouseUp(Sender: TObject; Button: Controls.TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LPosition: TVector3f;
begin
  LPosition := Vector3f(FMousePos.X, FMousePos.Y, 0.0);
  FCamera.Command(TCameraCommand.Stop, LPosition, FDisplaySize);
end;

procedure TMainForm.RenderingControlMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  var Handled: Boolean);
begin
  FCamera.Distance := FCamera.Distance - 16.0;
end;

procedure TMainForm.RenderingControlMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  var Handled: Boolean);
begin
  FCamera.Distance := FCamera.Distance + 16.0;
end;

procedure TMainForm.RenderingControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_SPACE then
    FRenderingTechnique := TRenderingTechnique((Integer(FRenderingTechnique) + 1) mod 4)
  else if Key = VK_ESCAPE then
    Close;
end;

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

procedure TMainForm.RenderPlane(const AScene: TScene);
var
  LMaterial: TObjectMaterial;
begin
  if AScene.Handle = FSceneModeling.Handle then
  begin
    LMaterial := TObjectMaterial.Default;
    LMaterial.AmbientColor := FloatColorRGB($00303030);
    LMaterial.AlbedoColor := FloatColor($FFFFFFFF);
    LMaterial.SpecularColor := FloatColorRGB($00404040);
    LMaterial.SpecularExponent := 16.0;
    LMaterial.Technique := TTechniqueLighting.Minnaert;
    LMaterial.Roughness := Vector3f(0.8, 1.0, 0.8);
    AScene.Material := LMaterial;
  end;

  AScene.World := FWorld;
  FModelPlane.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;
    OnMouseDown := RenderingControlMouseDown;
    OnMouseMove := RenderingControlMouseMove;
    OnMouseUp := RenderingControlMouseUp;
    OnMouseWheelUp := RenderingControlMouseWheelUp;
    OnMouseWheelDown := RenderingControlMouseWheelDown;
    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;
    OnMouseDown := RenderingControlMouseDown;
    OnMouseMove := RenderingControlMouseMove;
    OnMouseUp := RenderingControlMouseUp;
    OnMouseWheelUp := RenderingControlMouseWheelUp;
    OnMouseWheelDown := RenderingControlMouseWheelDown;
    OnKeyDown := RenderingControlKeyDown;

    MakeCurrent;
  end;
{$ENDIF}
end;

end.
