unit SketchpadViewports;
(*
 * 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.
 *)
interface

uses
  PXT.Types, PXT.Graphics, PXT.Widgets;

type
  TSketchpadViewport = class
  private
    FViewportIndex: Integer;
    FObjectModelView: TObjectModelView;
    FSceneDepthNormals: TScene;
    FSceneModeling: TScene;
    FSceneLights: TSceneLights;
    FMaterials: TObjectMaterials;
    FShadowCastingAtlas: TShadowCastingAtlas;
    FWidget: TWidget;
    FTextureCabinet: TTextureCabinet;
    FCamera: TActorCamera;
    FViewportSize: TPoint2i;
    FUpdateNeeded: Boolean;

    procedure CreateTextureCabinet;
    procedure UpdateProjection;
  public
    constructor Create(const AViewportIndex: Integer; const AObjectModelView: TObjectModelView;
      const ASceneDepthNormals, ASceneModeling: TScene; const ASceneLights: TSceneLights;
      const AMaterials: TObjectMaterials; const AShadowCastingAtlas: TShadowCastingAtlas);
    destructor Destroy; override;

    function HandleEvent(const AWidget: TWidget; const AEvent: Utf8String): Boolean;
    procedure Update;
    procedure Invalidate;

    property ObjectModelView: TObjectModelView read FObjectModelView;
    property SceneDepthNormals: TScene read FSceneDepthNormals;
    property SceneModeling: TScene read FSceneModeling;
    property Widget: TWidget read FWidget write FWidget;
    property TextureCabinet: TTextureCabinet read FTextureCabinet;
    property Camera: TActorCamera read FCamera;
    property ViewportSize: TPoint2i read FViewportSize;
  end;

implementation

uses
  SysUtils, Math;

constructor TSketchpadViewport.Create(const AViewportIndex: Integer;
  const AObjectModelView: TObjectModelView; const ASceneDepthNormals, ASceneModeling: TScene;
  const ASceneLights: TSceneLights; const AMaterials: TObjectMaterials;
  const AShadowCastingAtlas: TShadowCastingAtlas);
begin
  inherited Create;

  FViewportIndex := AViewportIndex;
  FObjectModelView := AObjectModelView;
  FSceneDepthNormals := ASceneDepthNormals;
  FSceneModeling := ASceneModeling;
  FSceneLights := ASceneLights;
  FMaterials := AMaterials;
  FShadowCastingAtlas := AShadowCastingAtlas;
  FCamera := TActorCamera.Create(400.0);
  FUpdateNeeded := True;

  if FViewportIndex = 0 then
    FCamera.Rotation := Vector4f(Pi * 0.495, 0.0, 0.0, 0.0)
  else if FViewportIndex = 1 then
  begin
    FCamera.Rotation := Vector4f(Pi * 0.15, Pi * 0.5, 0.0, 0.0);
    FCamera.Distance := 500.0;
  end
  else if FViewportIndex = 2 then
  begin
    FCamera.Rotation := Vector4f(Pi * 0.4, -Pi * 0.5, 0.0, 0.0);
    FCamera.Distance := 600.0;
  end;
end;

destructor TSketchpadViewport.Destroy;
begin
  FCamera.Free;
  FTextureCabinet.Free;
  inherited Destroy;
end;

procedure TSketchpadViewport.CreateTextureCabinet;
var
  LFidelity: TTextureFidelity;
  LDevice: TDevice;
  LSamples: Integer;
begin
  LDevice := FWidget.Manager.TextRenderer.Canvas.Device;

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

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

  FTextureCabinet := TTextureCabinet.Create(LDevice, FViewportSize, LFidelity, LSamples);
end;

procedure TSketchpadViewport.UpdateProjection;
const
  FieldOfView = Pi * 0.25;
  NearPlane = 10.0;
  FarPlane = 1500.0;
var
  LDepthClipNegative: Boolean;
  LDevice: TDevice;
begin
  LDevice := FWidget.Manager.TextRenderer.Canvas.Device;
  LDepthClipNegative := LDevice.Behavior and TDeviceBehavior.DepthClipNegative <> 0;
  FObjectModelView.SetProjection(TMatrix4f.PerspectiveFOVY(FieldOfView, FViewportSize.X / FViewportSize.Y,
    NearPlane, FarPlane, LDepthClipNegative), LDepthClipNegative);
end;

function TSketchpadViewport.HandleEvent(const AWidget: TWidget; const AEvent: Utf8String): Boolean;
var
  LManager: TWidget;
  LTextRenderer: TTextRenderer;
  LCanvas: TCanvas;
  LDevice: TDevice;
  LWidgetRect: TFloatRect;
  LTexCoords: TQuad;
  LOffset, LMousePosition, LWidgetSize: TPoint2f;
  LScale: Single;
  LMouseEvent: TMouseEvent;
  LMouseButton: PXT.Types.TMouseButton;
begin
  LWidgetRect := FWidget.Rect;
  LManager := FWidget.Manager;
  LTextRenderer := LManager.TextRenderer;
  LCanvas := LTextRenderer.Canvas;
  LDevice := LCanvas.Device;
  LScale := LManager.Scale;

  if AEvent = 'Draw' then
  begin
    LOffset := FWidget.GetProperty('Transitory.Offset').AsType<TPoint2f>;

    LTexCoords := TQuad.Unity;
    if LDevice.Technology = TDeviceTechnology.OpenGL then
      LTexCoords := LTexCoords.Flip;

    LCanvas.Quad(FTextureCabinet.FinalTexture, Quad(FloatRect(LOffset, LWidgetRect.Size)).Scale(LScale,
      False), LTexCoords, TColorRect.White)
  end
  else if AEvent = 'Rect.Changed' then
  begin
    FViewportSize := (FWidget.Rect.Size * LScale).ToInt;
    if not FViewportSize.Empty then
    begin
      if FTextureCabinet.Handle <> nil then
        FTextureCabinet.Size := FViewportSize
      else
        CreateTextureCabinet;

      UpdateProjection;
    end;
    Invalidate;
  end
  else if AEvent = 'Mouse' then
  begin
    // TODO: in Delphi, "AsType" raises an exception instead of converting from Integer to enumeration.
    // Need to adjust the code to accomodate for this limitation.
    LMouseEvent := PXT.Types.TMouseEvent(FWidget.GetProperty('Transitory.Event').AsType<Integer>);
    LMouseButton := PXT.Types.TMouseButton(FWidget.GetProperty('Transitory.Button').AsType<Integer>);
    LMousePosition := FWidget.GetProperty('Transitory.Position').AsType<TPoint2f>;

    LMousePosition := (FWidget.ScreenToLocal(LMousePosition) - FWidget.Rect.TopLeft) * LScale;
    LWidgetSize := LWidgetRect.Size * LScale;

    case LMouseEvent of
      TMouseEvent.MouseDown:
        begin
          if LMouseButton = PXT.Types.TMouseButton.Left then
            FCamera.Command(TCameraCommand.Rotation, Vector3f(LMousePosition, 0.0), LWidgetSize)
          else
            FCamera.Command(TCameraCommand.Dragging, Vector3f(LMousePosition, 0.0), LWidgetSize);
        end;

      TMouseEvent.MouseMove:
        if FCamera.Command(TCameraCommand.Update, Vector3f(LMousePosition, 0.0), LWidgetSize) then
          Invalidate;

      TMouseEvent.MouseUp:
        FCamera.Command(TCameraCommand.Stop, Vector3f(LMousePosition, 0.0), LWidgetSize);

      TMouseEvent.WheelUp:
        begin
          FCamera.Zoom(LMousePosition, LWidgetSize, FObjectModelView.Projection, -16.0);
          Invalidate;
        end;

      TMouseEvent.WheelDown:
        begin
          FCamera.Zoom(LMousePosition, LWidgetSize, FObjectModelView.Projection, 16.0);
          Invalidate;
        end;
    end;
  end;
  Result := True;
end;

procedure TSketchpadViewport.Update;
var
  LCabinetAttributes: TTextureCabinetAttributes;
  LSceneAttributes: TSceneAttributes;
  LScale: Single;
begin
  if not FUpdateNeeded then
    Exit;

  FUpdateNeeded := False;
  LScale := FWidget.Manager.Scale;

  // Perform light assignment for 3D scene.
  FSceneLights.ClustersCullingMode := TClustersCullingMode.Performance;
  FSceneLights.ViewSize := FViewportSize;
  FSceneLights.ClusterSize := 512;
  FSceneLights.DepthSlices := 1;
  FSceneLights.Execute(FCamera.View, FObjectModelView.Projection);

  // Update texture cabinet attributes.
  LCabinetAttributes := [TTextureCabinetAttribute.Bloom, TTextureCabinetAttribute.BloomCubic,
    TTextureCabinetAttribute.AmbientOcclusion];

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

  FTextureCabinet.Attributes := LCabinetAttributes;

  // Update visibility in object model's view.
  FObjectModelView.View := FCamera.View;
  FObjectModelView.Update;

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

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

    FSceneDepthNormals.BeginScene;
    try
      FObjectModelView.AutoDraw(FSceneDepthNormals, 0);
    finally
      FSceneDepthNormals.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Occlusion, FObjectModelView.Projection);

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

    FSceneModeling.Lights := FSceneLights;
    FSceneModeling.ShadowCastingAtlas := FShadowCastingAtlas;
    FSceneModeling.TextureCabinet := FTextureCabinet;

    FSceneModeling.Prepare;
    FSceneModeling.BeginScene;
    try
      FObjectModelView.AutoDraw(FSceneModeling, FMaterials, 0);
    finally
      FSceneModeling.EndScene;
    end;
  finally
    FTextureCabinet.EndScene;
  end;
  FTextureCabinet.Filter(TTextureCabinetFilterType.Bloom);
end;

procedure TSketchpadViewport.Invalidate;
begin
  FUpdateNeeded := True;
  FWidget.Invalidate;
end;

end.