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:
//  * Loading different external 3D mesh formats and rendering them as objects.
//    This includes native Wavefront OBJ loader, native binary mesh formats and many other formats supported
//    by an external library Assimp, which is loaded dynamically by the framework as needed.
//  * Rendering voxel representations using instancing technique for optimal performance.
//  * Order-Independent Transparency (OIT) using fast approximated technique.

interface

uses
  System.Types, System.Classes, Vcl.Graphics, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls,
  Vcl.StdCtrls, Vcl.Buttons, Vcl.Controls, PXT.Types, PXT.Graphics, PXT.Controls;

type
  TMainForm = class(TForm)
    StatusBar: TStatusBar;
    OpenDialog: TOpenDialog;
    RightPanel: TPanel;
    OpenFileButton: TBitBtn;
    ShadowsCheckBox: TCheckBox;
    TransparencyCheckBox: TCheckBox;
    AmbientOcclusionCheckBox: TCheckBox;
    AutoNormalsCheckBox: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OpenFileButtonClick(Sender: TObject);
    procedure UpdateTransparencyClick(Sender: TObject);
    procedure AmbientOcclusionClick(Sender: TObject);
    procedure RepaintButtonClick(Sender: TObject);
  private
    FRenderingControl: TRenderingControl;
    FDisplaySize: TPoint2i;
    FDisplayScale: Single;
    FMousePos: TPoint2i;

    FDevice: TDevice;
    FSwapChain: TSwapChain;
    FCanvas: TCanvas;
    FTextRenderer: TTextRenderer;
    FCamera: TActorCamera;
    FProjection: TMatrix4f;

    FMeshes: TSceneMeshes;
    FObjects: TObjectModels;
    FSceneLights: TSceneLights;
    FMaterials: TObjectMaterials;

    FTextureCabinet: TTextureCabinet;
    FShadowCastingAtlas: TShadowCastingAtlas;
    FShadowCasterView: TObjectModelView;

    FSceneDepthNormals: TScene;
    FSceneModeling: TScene;

    FViewport: TObjectModelView;
    FVoxelMesh: TMeshVoxel;
    FMeshOptions: Cardinal;

    FVoxelWorld: TMatrix4f;
    FVoxelMatrices: array[0..127] of TMatrix4f;
    FVoxelColors: array[0..127] of TFloatColor;
    FVoxelCount: Integer;

    procedure RenderingControlResize(Sender: TObject);
    procedure RenderingControlMouseDown(Sender: TObject; Button: Vcl.Controls.TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RenderingControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure RenderingControlMouseUp(Sender: TObject; Button: Vcl.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 RenderingControlPaint(Sender: TObject);
    procedure RenderObjects(const AScene: TScene; const AView: TObjectModelView; const AGlassy: Boolean);
    procedure RenderObjectsInstancing(const AScene: TScene);
    procedure FlushVoxels(const AScene: PScene);
    procedure CreateStaticObjects;
    procedure CreateStaticModels;
    procedure CreateLightsAndMaterials;
    procedure CreateRenderingControl;
  public
  end;

var
  MainForm: TMainForm;

implementation
{$R *.dfm}

uses
  System.SysUtils, System.UITypes, System.Math, PXT.Headers, PXT.Graphics.Consts;

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

  LightPosition: TVector3f = (X: 300.0; Y: 800.0; Z: -300.0);

function MeshLoadFeedback(AMessage: PAnsiChar; AProgress: Integer; AUser: Pointer): Integer; cdecl; forward;
procedure RenderVoxelCube(Position, Size: PVector3f; Color: PFloatColor; User: Pointer); cdecl; forward;

procedure TMainForm.FormCreate(Sender: TObject);
var
  LDepthClipNegative: Boolean;
  LAttributes: TTextureCabinetAttributes;
  LFidelity: TTextureFidelity;
  LSamples: Integer;
  LTechniqueShadows: TTechniqueShadows;
begin
  CreateRenderingControl;
  FDisplayScale := Screen.PixelsPerInch / 96.0;
  FDisplaySize := Point2i(FRenderingControl.Width, FRenderingControl.Height);
  try
    FDevice := TDevice.Create;
    FSwapChain := TSwapChain.Create(FDevice, FRenderingControl.WindowHandle, FDisplaySize);
    FCanvas := TCanvas.Create(FDevice);
    FTextRenderer := TTextRenderer.Create(FCanvas, Point2i(256, 256), TPixelFormat.LA8);
    FMeshes := TSceneMeshes.Create(FDevice);
    FObjects := TObjectModels.Create(FMeshes);
    FSceneLights := TSceneLights.Create(FDevice);
    FMaterials := TObjectMaterials.Create;

    LDepthClipNegative := FDevice.Behavior and TDeviceBehavior.DepthClipNegative <> 0;

    LAttributes := [TTextureCabinetAttribute.Bloom
      , TTextureCabinetAttribute.BloomCubic
      , TTextureCabinetAttribute.AmbientOcclusion
      , TTextureCabinetAttribute.GlassyFast
    ];

    LSamples := 8;

    if FDevice.Attributes and TDeviceAttribute.Software <> 0 then
      LSamples := 0;

    if FDisplayScale >= 2.0 then
    begin
      LAttributes := LAttributes + [
        TTextureCabinetAttribute.BloomDownscale,
        TTextureCabinetAttribute.AmbientOcclusionDownscale];
    end;

    LFidelity := TTextureFidelity.High;

    if FDevice.Attributes and TDeviceAttribute.Software <> 0 then
      LFidelity := TTextureFidelity.Medium;

    FTextureCabinet := TTextureCabinet.Create(FDevice, FDisplaySize, LFidelity, LSamples);
    FTextureCabinet.Attributes := LAttributes;

    LTechniqueShadows := TTechniqueShadows.EVSM;

    FShadowCastingAtlas := TShadowCastingAtlas.Create(FDevice, Point2i(256, 256), LTechniqueShadows, 8);

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

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

    FViewport := FObjects.CreateView;
    FShadowCasterView := FObjects.CreateView;
    FShadowCasterView.View := TMatrix4f.LookAt(LightPosition, TVector3f.Zero, TVector3f.AxisY);
    FShadowCasterView.SetProjection(TMatrix4f.PerspectiveFOVY(Pi * 0.25, 1.0, 100.0, 1400.0,
      LDepthClipNegative), LDepthClipNegative);

    FShadowCastingAtlas.Add(Point2i(256, 256));
    FCamera := TActorCamera.Create(400.0);

    CreateStaticModels;
    CreateStaticObjects;
    CreateLightsAndMaterials;
  except
    on E: EAfterwarpException do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Application.Terminate;
      Exit;
    end;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FVoxelMesh.Free;
  FSceneModeling.Free;
  FSceneDepthNormals.Free;
  FShadowCastingAtlas.Free;
  FTextureCabinet.Free;
  FMaterials.Free;
  FSceneLights.Free;
  FObjects.Free;
  FMeshes.Free;
  FTextRenderer.Free;
  FCanvas.Free;
  FSwapChain.Free;
  FDevice.Free;
end;

procedure TMainForm.RenderingControlResize(Sender: TObject);
begin
  if FSwapChain.Handle <> nil then
  begin
    FDisplaySize := Point2i(FRenderingControl.Width, FRenderingControl.Height);
    FSwapChain.Resize(FDisplaySize);
    FTextureCabinet.Size := FDisplaySize;
  end;
end;

procedure TMainForm.RenderingControlMouseDown(Sender: TObject; Button: Vcl.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, TVector3f.Zero, FProjection)
  else
    FCamera.Command(TCameraCommand.Dragging, LPosition, FDisplaySize, TVector3f.Zero, FProjection);
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);

  if FCamera.Command(TCameraCommand.Update, LPosition, FDisplaySize, TVector3f.Zero, FProjection) then
    FRenderingControl.Invalidate;
end;

procedure TMainForm.RenderingControlMouseUp(Sender: TObject; Button: Vcl.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, TVector3f.Zero, FProjection);
end;

procedure TMainForm.RenderingControlMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  var Handled: Boolean);
begin
  FCamera.Distance := Max(FCamera.Distance - 10.0, 50.0);
  FRenderingControl.Invalidate;
end;

procedure TMainForm.RenderingControlMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  var Handled: Boolean);
begin
  FCamera.Distance := Min(FCamera.Distance + 10.0, 1400.0);
  FRenderingControl.Invalidate;
end;

procedure TMainForm.RenderingControlPaint(Sender: TObject);
var
  LDepthClipNegative: Boolean;
  LAttributes: TSceneAttributes;
  LShadowCaster: TShadowCaster;
  LFontParams: TFontParameters;
  LTechString: string;
begin
  LDepthClipNegative := FDevice.Behavior and TDeviceBehavior.DepthClipNegative <> 0;
  FDisplayScale := PixelsPerInch / 96.0;
  FProjection := TMatrix4f.PerspectiveFOVY(Pi * 0.25, FDisplaySize.X / FDisplaySize.Y,
    10.0, 1800.0, LDepthClipNegative);

  FViewport.View := FCamera.View;
  FViewport.SetProjection(FProjection, LDepthClipNegative);

  if FViewport.Update then
  begin
    // Object selection can be performed here.
  end;

  // Configure scene's attributes.
  LAttributes := [TSceneAttribute.Coloring, TSceneAttribute.ShadowsCubic];

  if not AutoNormalsCheckBox.Checked then
    Include(LAttributes, TSceneAttribute.Normals);

  if TTextureCabinetAttribute.AmbientOcclusion in FTextureCabinet.Attributes then
    Include(LAttributes, TSceneAttribute.DepthPrePass);

  // Perform light assignment for 3D scene.
  FSceneLights.ClustersCullingMode := TClustersCullingMode.Performance;
  FSceneLights.ViewSize := FDisplaySize;
  FSceneLights.Execute(FCamera.View, FProjection);

  // Render shadow map.
  FShadowCastingAtlas.BorderFill;

  LShadowCaster := FShadowCastingAtlas.Casters[0];
  LShadowCaster.ViewProjection := FShadowCasterView.ViewProjection;

  FShadowCasterView.Update;
  LShadowCaster.Clear;
  LShadowCaster.BeginScene;
  try
    FSceneDepthNormals.Attributes := [];
    FSceneDepthNormals.View := FShadowCasterView.View;
    FSceneDepthNormals.Projection := FShadowCasterView.Projection;

    FSceneDepthNormals.BeginScene;
    try
      RenderObjects(FSceneDepthNormals, FShadowCasterView, False);

      FSceneDepthNormals.Attributes := FSceneDepthNormals.Attributes + [TSceneAttribute.Instancing];
      RenderObjectsInstancing(FSceneDepthNormals);
    finally;
      FSceneDepthNormals.EndScene;
    end;
  finally
    LShadowCaster.EndScene;
  end;
  LShadowCaster.Filter;

  // Depth pre-pass with ambient occlusion.
  FTextureCabinet.Clear(TTextureCabinetPass.Depth);
  FTextureCabinet.BeginScene(TTextureCabinetPass.Depth);
  try
    FSceneDepthNormals.Attributes := LAttributes;
    FSceneDepthNormals.View := FCamera.View;
    FSceneDepthNormals.Projection := FProjection;

    FSceneDepthNormals.BeginScene;
    try
      RenderObjects(FSceneDepthNormals, FViewport, False);

      if not TransparencyCheckBox.Checked then
      begin
        FSceneDepthNormals.Attributes := FSceneDepthNormals.Attributes + [TSceneAttribute.Instancing];
        RenderObjectsInstancing(FSceneDepthNormals);
      end;
    finally
      FSceneDepthNormals.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Occlusion, FProjection);

  // Render main scene.
  FTextureCabinet.Clear(TTextureCabinetPass.Color, FloatColor($FF808080));
  FTextureCabinet.BeginScene(TTextureCabinetPass.Color);
  try
    FSceneModeling.Attributes := LAttributes;
    FSceneModeling.View := FCamera.View;
    FSceneModeling.Projection := FProjection;

    FSceneModeling.Lights := FSceneLights;

    if ShadowsCheckBox.Checked then
      FSceneModeling.ShadowCastingAtlas := FShadowCastingAtlas
    else
      FSceneModeling.ShadowCastingAtlas := TShadowCastingAtlas(NullObject);

    FSceneModeling.TextureCabinet := FTextureCabinet;

    FSceneModeling.Texture[TSceneTextureType.Albedo] := TTexture(NullObject);
    FSceneModeling.Texture[TSceneTextureType.NormalMap] := TTexture(NullObject);
    FSceneModeling.Texture[TSceneTextureType.ParallaxMap] := TTexture(NullObject);

    FSceneModeling.Prepare;
    FSceneModeling.BeginScene;
    try
      RenderObjects(FSceneModeling, FViewport, False);

      if not TransparencyCheckBox.Checked then
      begin
        FSceneModeling.Attributes := FSceneModeling.Attributes + [TSceneAttribute.Instancing];
        RenderObjectsInstancing(FSceneModeling);
      end;
    finally
      FSceneModeling.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Bloom, FProjection);

  // Render semi-transparent objects.
  FTextureCabinet.Clear(TTextureCabinetPass.Glassy);
  FTextureCabinet.BeginScene(TTextureCabinetPass.Glassy);
  try
    FSceneModeling.Attributes := LAttributes + [TSceneAttribute.Glassy];

    FSceneModeling.BeginScene;
    try
      RenderObjects(FSceneModeling, FViewport, True);

      if TransparencyCheckBox.Checked then
      begin
        FSceneModeling.Attributes := FSceneModeling.Attributes + [TSceneAttribute.Instancing];
        RenderObjectsInstancing(FSceneModeling);
      end;
    finally
      FSceneModeling.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Glassy);

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

    FCanvas.BeginScene;
    try
      FCanvas.SamplerState := TCanvasSamplerState.Create(TTextureFilter.Nearest, TTextureFilter.Nearest);
      FCanvas.ContextState := TCanvasContextState.FlatText;

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

      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), Utf8String(LTechString),
        ColorPair($FFFFFFFF));
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;
end;

procedure TMainForm.UpdateTransparencyClick(Sender: TObject);
var
  LObject: TObjectModel;
begin
  LObject := FObjects.TryObject('Model');
  if LObject.Handle <> nil then
  begin
    if TransparencyCheckBox.Checked then
      LObject.Attributes := LObject.Attributes + [TModelAttribute.Transparent]
    else
      LObject.Attributes := LObject.Attributes - [TModelAttribute.Transparent];
  end;
  FRenderingControl.Invalidate;
end;

procedure TMainForm.AmbientOcclusionClick(Sender: TObject);
var
  LAttributes: TTextureCabinetAttributes;
begin
  LAttributes := FTextureCabinet.Attributes;

  if AmbientOcclusionCheckBox.Checked then
    Include(LAttributes, TTextureCabinetAttribute.AmbientOcclusion)
  else
    Exclude(LAttributes, TTextureCabinetAttribute.AmbientOcclusion);

  FTextureCabinet.Attributes := LAttributes;
  FRenderingControl.Invalidate;
end;

procedure TMainForm.RepaintButtonClick(Sender: TObject);
begin
  FRenderingControl.Invalidate;
end;

procedure TMainForm.OpenFileButtonClick(Sender: TObject);
var
  LLength, LModelScale: Single;
  LDebugString: Utf8String;
  LMesh: TSceneMesh;
  LObject: TObjectModel;
  LObjectAttributes: TModelAttributes;
  LPosition, LSize, LMinBounds, LMaxBounds: TVector3f;
  LMeshBuffer: TMeshBuffer;
  LMaterials: TSceneMeshMaterials;
  LTags: TMeshMetaTags;
begin
  if OpenDialog.Execute then
  begin
    FMeshOptions := 0;

    // Remove previous voxel representation.
    FVoxelMesh.Free;

    // Remove previous object.
    LObjectAttributes := [];

    LObject := FObjects.TryObject('Model');
    if LObject.Handle <> nil then
    begin
      LObjectAttributes := LObject.Attributes;
      FObjects.Erase(LObject);
      LObject := TObjectModel(NullObject);
    end;

    // Remove previous mesh.
    LMesh := FMeshes.TryMesh('Model');
    if LMesh.Handle <> nil then
    begin
      FMeshes.Erase(LMesh);
      LMesh := TSceneMesh(NullObject);
    end;

    if SameText(ExtractFileExt(OpenDialog.FileName), '.voxel') then
    begin
      try
        FVoxelMesh := TMeshVoxel.Create;
        FVoxelMesh.LoadFromFile(Utf8String(OpenDialog.FileName));
      except
        on E: EAfterwarpException do
        begin
          MessageDlg(E.Message, mtError, [mbOK], 0);
          Exit;
        end;
      end;
      FVoxelMesh.Extents(LPosition, LSize);

      LLength := Max(Max(LSize.X, LSize.Y), LSize.Z);

      if LLength > VectorEpsilon then
        FVoxelWorld := TMatrix4f.Scale(200.0 / LLength)
      else
        FVoxelWorld := TMatrix4f.Identity;

      FVoxelWorld := TMatrix4f.Translate(Vector3f(0.0, LSize.Y * 0.5, 0.0) - LPosition) * FVoxelWorld;
    end
    else
    begin
      if SameText(ExtractFileExt(OpenDialog.FileName), '.obj') or
        SameText(ExtractFileExt(OpenDialog.FileName), '.mesh') then
      begin // Load from an OBJ file format using native loading mechanism.
        LMesh := FMeshes.TryAddFromFile('Model', Utf8String(OpenDialog.FileName), nil, VertexElements,
          0, 0, FMeshOptions, 1.0, LDebugString, MeshLoadFeedback, Self);
        if LMesh.Handle = nil then
        begin
          MessageDlg(Format('Could not load mesh file: %s', [string(LDebugString)]), mtError, [mbOK], 0);
          Exit;
        end;
      end
      else
      begin // Load from some other file format using Assimp library.
        LMeshBuffer := TMeshBuffer.Create;
        LMaterials := TSceneMeshMaterials.Create;
        LTags := TMeshMetaTags.Create;
        try
          if not LMeshBuffer.TryLoadFromFileEx(LTags, Utf8String(OpenDialog.FileName), LMinBounds,
            LMaxBounds, LDebugString, False) then
          begin
            MessageDlg(Format('Could not load mesh file: %s', [string(LDebugString)]), mtError, [mbOK], 0);
            Exit;
          end;
          LMesh := FMeshes.AddFromBuffer('Model', LMeshBuffer, nil, VertexElements);
        finally
          LTags.Free;
          LMaterials.Free;
          LMeshBuffer.Free;
        end;
      end;
      LLength := Max(Max(Abs(LMesh.MaxBounds.X - LMesh.MinBounds.X),
        Abs(LMesh.MaxBounds.Y - LMesh.MinBounds.Y)),
        Abs(LMesh.MaxBounds.Z - LMesh.MinBounds.Z));

      if LLength > VectorEpsilon then
        LModelScale := 200.0 / LLength
      else
        LModelScale := 1.0;

      LObject := FObjects.Add('Model');
      LObject.Mesh := LMesh;
      LObject.Transform[TModelTransform.Local] := TMatrix4f.Scale(LModelScale);
      if LObjectAttributes <> [] then
        LObject.Attributes := LObjectAttributes;
      LObject.Material := 1;
    end;
    StatusBar.SimpleText := OpenDialog.FileName;
    Caption := ExtractFileName(OpenDialog.FileName) + ' - ModelViewer';
    FRenderingControl.Invalidate;
  end;
end;

procedure TMainForm.RenderObjects(const AScene: TScene; const AView: TObjectModelView;
  const AGlassy: Boolean);
const
  DefaultDiffuse: TFloatColorRGB = (Red: 0.65; Green: 0.65; Blue: 0.65);
var
  I: Integer;
  LObject: TObjectModel;
  LMesh: TSceneMesh;
  LMaterial: TObjectMaterial;
  LMeshMaterials: TSceneMeshMaterials;
  LMeshMaterial: TSceneMeshMaterial;
  LShading: TSceneMeshMaterialShading;
  LRange: TSceneMeshMaterialRange;
begin
  for I := 0 to AView.ObjectCount - 1 do
  begin
    LObject := AView.Objects[I];
    if ((not AGlassy) and (TModelAttribute.Transparent in LObject.Attributes)) or
      (AGlassy and (not (TModelAttribute.Transparent in LObject.Attributes))) then
      Continue;

    LMesh := LObject.Mesh;
    if LMesh.Handle = nil then
      Continue;

    AScene.World := LObject.Transform[TModelTransform.GlobalModel];

    if AScene.Handle = FSceneModeling.Handle then
    begin
      LMeshMaterials := LMesh.Materials;

      if (LMeshMaterials.Handle <> nil) and (LMeshMaterials.Count > 0) and
        (FMeshOptions and TMeshLoadingOption.MaterialVertexColor = 0) then
      begin
        for LMeshMaterial in LMeshMaterials do
        begin
          LMaterial := FMaterials[LObject.Material]^;
          LShading := LMeshMaterial.Shading;

          if LShading.Lighting = 0 then
          begin // Compatibility mode
            if Length(LMeshMaterial.Name) > 0 then
            begin
              LMaterial.AmbientColor := LMaterial.AmbientColor * LShading.Diffuse.RGB;
              LMaterial.AlbedoColor := FloatColor(LMaterial.AlbedoColor.RGB * LShading.Diffuse.RGB,
                LMaterial.AlbedoColor.Alpha);
              LMaterial.EmissiveColor := LShading.Emissive;
            end
            else
            begin // Default material
              LMaterial.AmbientColor := LMaterial.AmbientColor * DefaultDiffuse;
              LMaterial.AlbedoColor := FloatColor(LMaterial.AlbedoColor.RGB * DefaultDiffuse,
                LMaterial.AlbedoColor.Alpha);
            end;
          end
          else
          begin
            if LShading.Lighting = 1 then
            begin // Default mode
              if LShading.Ambient.Defined then
                LMaterial.AmbientColor := LMaterial.AmbientColor * LShading.Diffuse.RGB;

              LMaterial.AlbedoColor := FloatColor(LMaterial.AlbedoColor.RGB * LShading.Diffuse.RGB,
                LMaterial.AlbedoColor.Alpha);

              LMaterial.SpecularColor := LMaterial.SpecularColor * LShading.Specular;
              LMaterial.SpecularExponent := LMaterial.SpecularExponent * LShading.SpecularExponent;
            end
            else
            begin // Override mode
              LMaterial.Technique := TTechniqueLighting(LShading.Lighting - 2);

              if LShading.Ambient.Defined then
                LMaterial.AmbientColor := LShading.Ambient;

              LMaterial.AlbedoColor := FloatColor(LShading.Diffuse.RGB, LMaterial.AlbedoColor.Alpha);
              LMaterial.SpecularColor := LShading.Specular;
              LMaterial.SpecularExponent := LShading.SpecularExponent;
            end;
            if (not IsNan(LShading.Bloom)) and (not IsInfinite(LShading.Bloom)) then
              LMaterial.AlbedoColor.Alpha := LMaterial.AlbedoColor.Alpha * LShading.Bloom;

            LMaterial.EmissiveColor := LShading.Emissive;

            if (not IsNan(LShading.Roughness.X)) and (not IsInfinite(LShading.Roughness.X)) then
              LMaterial.Roughness.X := LShading.Roughness.X;

            if (not IsNan(LShading.Roughness.Y)) and (not IsInfinite(LShading.Roughness.Y)) then
              LMaterial.Roughness.Y := LShading.Roughness.Y;

            if (not IsNan(LShading.Roughness.Z)) and (not IsInfinite(LShading.Roughness.Z)) then
              LMaterial.Roughness.Z := LShading.Roughness.Z;
          end;
          LMaterial.AmbientColor := LMaterial.AmbientColor * LObject.Color.RGB;
          LMaterial.AlbedoColor := LMaterial.AlbedoColor * LObject.Color;

          if AGlassy then
            LMaterial.AlbedoColor.Alpha := 0.5; // Transparency

          AScene.Material := LMaterial;

          FSceneModeling.Texture[TSceneTextureType.Albedo] := LMeshMaterial.Texture[TSceneMeshTexture.Diffuse];
          FSceneModeling.Texture[TSceneTextureType.NormalMap] :=
            LMeshMaterial.Texture[TSceneMeshTexture.Normals];
          FSceneModeling.Texture[TSceneTextureType.ParallaxMap] :=
            LMeshMaterial.Texture[TSceneMeshTexture.Parallax];

          for LRange in LMeshMaterial do
            LMesh.Model.Draw(AScene.SceneProgram, TPrimitiveTopology.Triangles, LRange.IndexCount,
              LRange.IndexStart, 0, False);
        end;
      end
      else
      begin
        LMaterial := FMaterials[LObject.Material]^;
        LMaterial.AmbientColor := LMaterial.AmbientColor * LObject.Color.RGB;
        LMaterial.AlbedoColor := LMaterial.AlbedoColor * LObject.Color;

        if AGlassy then
          LMaterial.AlbedoColor.Alpha := 0.5; // Transparency

        AScene.Material := LMaterial;

        FSceneModeling.Texture[TSceneTextureType.Albedo] := TTexture(NullObject);
        FSceneModeling.Texture[TSceneTextureType.NormalMap] := TTexture(NullObject);
        FSceneModeling.Texture[TSceneTextureType.ParallaxMap] := TTexture(NullObject);

        LMesh.Model.Draw(AScene.SceneProgram);
      end;
    end
    else
      LMesh.Model.Draw(AScene.SceneProgram);
  end;
end;

procedure TMainForm.RenderObjectsInstancing(const AScene: TScene);
var
  LMaterial: TObjectMaterial;
begin
  if FVoxelMesh.Handle <> nil then
  begin
    if AScene.Handle = FSceneModeling.Handle then
    begin
      FillChar(LMaterial, SizeOf(TObjectMaterial), 0);
      LMaterial.AmbientColor := FloatColorRGB(0.25, 0.25, 0.25);
      LMaterial.AlbedoColor := FloatColor(1.0, 1.0, 1.0, 0.0);
      LMaterial.AlbedoColor.Alpha := 0.5; // Bloom
      LMaterial.SpecularColor := FloatColorRGB(0.25, 0.25, 0.25);
      LMaterial.SpecularExponent := 4.0;
      LMaterial.Shadows := 0.5;
      LMaterial.Occlusion := 0.5;
      LMaterial.Roughness := Vector3f(0.8, 1.2, 0.4);
      LMaterial.Technique := TTechniqueLighting.Phong;
      AScene.Material := LMaterial;
    end;

    FVoxelMesh.Visualize(255, RenderVoxelCube, @AScene);
    FlushVoxels(@AScene);
  end;
end;

procedure TMainForm.FlushVoxels(const AScene: PScene);
var
  LSceneMesh: TSceneMesh;
begin
  if FVoxelCount > 0 then
  begin
    LSceneMesh := FMeshes.Mesh['Cube'];
    AScene.Instances(@FVoxelMatrices[0], @FVoxelColors[0], FVoxelCount);
    LSceneMesh.Model.DrawInstances(AScene.SceneProgram, FVoxelCount);
    FVoxelCount := 0;
  end;
end;

procedure TMainForm.CreateStaticObjects;
var
  LObject: TObjectModel;
begin
  LObject := FObjects.Add('Floor');
  LObject.MeshName := 'Plane';
  LObject.Transform[TModelTransform.Local] := TMatrix4f.Translate(0.0, -0.1, 0.0);
  LObject.Color := FloatColor($FFE0E0E0);
  LObject.Material := 0;
end;

procedure TMainForm.CreateStaticModels;
var
  LMeshBuffer: TMeshBuffer;
begin
  LMeshBuffer := TMeshBuffer.Create;
  try
    LMeshBuffer.Plane(1, 1, TVector3f.Zero, Vector3f(800.0, 0.0, 0.0), Vector3f(0.0, 0.0, 800.0),
      Vector3f(0.0, 1.0, 0.0), TPoint2f.Zero, TPoint2f.Unity, TFloatColor.White);

    FMeshes.AddFromBuffer('Plane', LMeshBuffer, nil, VertexElements);
    LMeshBuffer.Clear;

    LMeshBuffer.Cube(1, 1, 1, TVector3f.Zero, Vector3f(1.0, 0.0, 0.0), Vector3f(0.0, 1.0, 0.0),
      Vector3f(0.0, 0.0, 1.0), TPoint2f.Zero, TPoint2f.Unity, TFloatColor.White, True);

    FMeshes.AddFromBuffer('Cube', LMeshBuffer, nil, VertexElements);
  finally
    LMeshBuffer.Free;
  end;
end;

procedure TMainForm.CreateLightsAndMaterials;
var
  LLight: PSceneLight;
  LMaterial: PObjectMaterial;
begin
  LLight := FSceneLights.Add;
  LLight.AmbientColor := FloatColorRGB($FFFFFF);
  LLight.AlbedoColor := FloatColorRGB($FFFFFF);
  LLight.SpecularColor := FloatColorRGB($FFFFFF);
  LLight.SpecularExponent := 1.0;
  LLight.Position := LightPosition;
  LLight.ShadowCaster := 0;

  LMaterial := FMaterials.Add;
  LMaterial.AmbientColor := FloatColorRGB(1.0, 1.0, 1.0);
  LMaterial.AlbedoColor := FloatColor(0.0, 0.0, 0.0, 0.0);
  LMaterial.SpecularColor := FloatColorRGB(0.0, 0.0, 0.0);
  LMaterial.Shadows := 0.5;
  LMaterial.Occlusion := 0.5;
  LMaterial.Technique := TTechniqueLighting.Phong;

  LMaterial := FMaterials.Add;
  LMaterial.AmbientColor := FloatColorRGB(0.25, 0.25, 0.25);
  LMaterial.AlbedoColor := FloatColor(1.0, 1.0, 1.0, 0.5);
  LMaterial.SpecularColor := FloatColorRGB(1.0, 1.0, 1.0);
  LMaterial.SpecularExponent := 4.0;
  LMaterial.Shadows := 0.5;
  LMaterial.Occlusion := 0.5;
  LMaterial.Roughness := Vector3f(0.8, 1.2, 0.4);
  LMaterial.Technique := TTechniqueLighting.Phong;
end;

procedure TMainForm.CreateRenderingControl;
begin
  FRenderingControl := TRenderingControl.Create(nil);
  FRenderingControl.Parent := Self;
  FRenderingControl.Align := alClient;
  FRenderingControl.Width := 256;
  FRenderingControl.Height := 256;
  FRenderingControl.OnPaint := RenderingControlPaint;
  FRenderingControl.OnResize := RenderingControlResize;
  FRenderingControl.OnMouseDown := RenderingControlMouseDown;
  FRenderingControl.OnMouseMove := RenderingControlMouseMove;
  FRenderingControl.OnMouseUp := RenderingControlMouseUp;
  MainForm.OnMouseWheelUp := RenderingControlMouseWheelUp;
  MainForm.OnMouseWheelDown := RenderingControlMouseWheelDown;
end;

function MeshLoadFeedback(AMessage: PAnsiChar; AProgress: Integer; AUser: Pointer): Integer; cdecl;
begin
  TMainForm(AUser).StatusBar.SimpleText := '(Working) ' + string(AMessage) + ' ' +
    IntToStr(AProgress) + '%...';
  Application.ProcessMessages;
  Result := 0;
end;

procedure RenderVoxelCube(Position, Size: PVector3f; Color: PFloatColor; User: Pointer); cdecl;
begin
  MainForm.FVoxelColors[MainForm.FVoxelCount] := FloatColor(Color.Red, Color.Green, Color.Blue, 0.2);
  MainForm.FVoxelMatrices[MainForm.FVoxelCount] :=
    TMatrix4f.Scale(Size^ * 0.999) * TMatrix4f.Translate(Position^) * MainForm.FVoxelWorld;

  Inc(MainForm.FVoxelCount);
  if MainForm.FVoxelCount >= 128 then
    MainForm.FlushVoxels(User);
end;

end.