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 simple vector-based shapes with 2D canvas to a "drawable" texture.
//  * Real-time Gaussian blur effect.
//  * Color dithering to reduce quantization errors when converting from 64-bits per pixel to 32-bit and
//    remove visible banding effects.
 
interface

uses
  System.Classes, Vcl.Forms, Vcl.Controls, Vcl.Graphics, Vcl.Dialogs, PXT.Types, PXT.Graphics, PXT.Controls;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRenderingControl: TRenderingControl;
    FDisplaySize: TPoint2i;
    FDisplayScale: Single;
    FDevice: TDevice;
    FSwapChain: TSwapChain;
    FCanvas: TCanvas;
    FTextRenderer: TTextRenderer;
    FTimer: TTimer;

    FGaussianBlur: TGaussianBlur;
    FColorDithering: TColorDithering;

    FTextureCanvasMSAA: TTexture;
    FTextureCanvas: TTexture;
    FTextureBlurred: TTexture;
    FTextureBlurredCopy: TTexture;
    FTextureBlurredDithered: TTexture;

    procedure RenderingControlResize(Sender: TObject);
    procedure RenderingControlPaint(Sender: TObject);
    procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
    procedure CreateTextures;
    procedure DestroyTextures;
    procedure CreateRenderingControl;
  public
  end;

var
  MainForm: TMainForm;

implementation
{$R *.dfm}

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

procedure TMainForm.FormCreate(Sender: TObject);
begin
  CreateRenderingControl;
  FDisplaySize := Point2i(ClientWidth, ClientHeight);
  FDisplayScale := PixelsPerInch / 96.0;
  try
    FDevice := TDevice.Create;
    FSwapChain := TSwapChain.Create(FDevice, FRenderingControl.WindowHandle, FDisplaySize);
    FCanvas := TCanvas.Create(FDevice);
    FTextRenderer := TTextRenderer.Create(FCanvas, Point2i(256, 256), TPixelFormat.LA8);
    FGaussianBlur := TGaussianBlur.Create(FDevice, 3.0, 64, True);
    FColorDithering := TColorDithering.Create(FDevice);
    FTimer := TTimer.Create;

    CreateTextures;
  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
  DestroyTextures;
  FTimer.Free;
  FColorDithering.Free;
  FGaussianBlur.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);
  end;
end;

procedure TMainForm.RenderingControlPaint(Sender: TObject);
const
  HexSize: Single = 32.0;
  HexDelta: Single = 1.1547;
  Interleave: Single = 0.0; // 1.0
var
  LSequence: TRandomSequence;
  LFontParams: TFontParameters;
  LTechString: string;
  LTexCoords: TQuad;
  LFlipped: Boolean;
  LOffset, LKappa: Single;
  LTicks: Double;
  LColor: TIntColor;
  I, J: Integer;
begin
  LTicks := GetSystemTicks * 60.0 / 1000000.0;
  LFlipped :=
    (FDevice.Technology = TDeviceTechnology.OpenGL) or
    (FDevice.Technology = TDeviceTechnology.OpenGL_ES);

  LTexCoords := TQuad.Unity;
  if LFlipped then
    LTexCoords := LTexCoords.Flip;

  // Draw to a multisampled texture.
  FTextureCanvasMSAA.Clear(TFloatColor.White);
  FTextureCanvasMSAA.BeginScene;
  try
    LSequence := TRandomSequence.Create(1200);
    FCanvas.BeginScene;
    try
      FCanvas.SamplerState := TCanvasSamplerState.Default;
      FCanvas.ContextState := TCanvasContextState.FlatScene;
      FCanvas.Attributes := [TCanvasAttribute.Transform];

      for J := 0 to Trunc(FDisplaySize.Y / HexSize) - 1 do
        for I := 0 to Trunc(FDisplaySize.X / HexSize) - 1 do
        begin
          LOffset := (J mod 2) * (HexSize + Interleave * 0.5);
          LColor := MakeColorRGB(LSequence.Ranged(256), LSequence.Ranged(256), LSequence.Ranged(256), 255);

          FCanvas.Transform := TMatrix3x2f.Scale(HexSize) * TMatrix3x2f.Translate(
            I * (Interleave + HexSize * 2.0) + LOffset, J * (Interleave + (HexSize * 2.0) / HexDelta));

          FCanvas.Hexagon(
            AverageColors(LColor, $80FFFFFF),
            MultiplyColors(LColor, $80E0E0E0),
            MultiplyColors(LColor, $80D0D0D0),
            MultiplyColors(LColor, $80C0C0C0),
            MultiplyColors(LColor, $80909090),
            MultiplyColors(LColor, $80808080));
        end;

      FCanvas.Attributes := [];
      LKappa := LTicks * 0.0274;

      FCanvas.Arc(Point2f(256.0, 128.0), Point2f(64.0, 64.0), LKappa, LKappa + 1.25 * Pi +
        Sin(LTicks * 0.01854) * 0.5 * Pi, 32, ColorRect($FF00FF00, $FFFF0000, $FF0000FF, $FFFFFFFF));

      LKappa := LTicks * 0.02231;

      FCanvas.Tape(Point2f(256.0, 384.0), Point2f(25.0, 20.0), Point2f(70.0, 80.0), LKappa,
        LKappa + 1.25 * Pi + Sin(LTicks * 0.024751) * 0.5 * Pi, 32, ColorRect($FFFF0000, $FF00FF00,
        $FF0000FF, $FFFFFFFF));

      FCanvas.ContextState := TCanvasContextState.FlatText;

      FTextRenderer.FontParameters := TFontParameters.Create('Segoe UI', 16.0, TFontWeight.SemiBold);

      FTextRenderer.DrawAligned(Point2f(256.0, 510.0), 'Some text on Drawable Texture', ColorPair($FF000000),
        TTextAlignment.Middle, TTextAlignment.Ending);

      FTextRenderer.FontParameters := TFontParameters.Create('Verdana', 24.0, TFontWeight.Bold);

      FTextRenderer.DrawCentered(Point2f(256.0, 256.0), 'Bold text for blurring purposes.',
        ColorPair($FF000000));
    finally
      FCanvas.EndScene;
    end;
  finally
    FTextureCanvasMSAA.EndScene;
  end;
  // Resolve MSAA to non-MSAA texture.
  FTextureCanvas.Copy(FTextureCanvasMSAA, 0, TPoint2i.Zero, 0, TIntRect.Zero);

  // Perform the blur.
  FGaussianBlur.Sigma := Lerp(0.001, 20.0, SineCycle(LTicks * 0.007));
  FGaussianBlur.Samples := 64;
  FGaussianBlur.Update(FTextureBlurred, FTextureBlurredCopy, FTextureCanvas);

  // Perform color dithering to eliminate color banding that results from conversion to 8-bit channels.
  FColorDithering.Format := TColorDitheringFormat.RGB8;
  FColorDithering.Execute(FTextureBlurredDithered, FTextureBlurred);

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

    FCanvas.BeginScene;
    try
      FCanvas.SamplerState := TCanvasSamplerState.Default;
      FCanvas.ContextState := TCanvasContextState.FlatScene;

      // Draw resolved canvas texture.
      FCanvas.Quad(FTextureCanvas, Quad(FDisplaySize.X * 0.5 - 512.0, FDisplaySize.Y * 0.5 - 256.0,
        512.0, 512.0), LTexCoords, TColorRect.White, TBlendingEffect.Copy);

      // Draw blurred canvas texture.
      FCanvas.Quad(FTextureBlurred, Quad(FDisplaySize.X * 0.5, FDisplaySize.Y * 0.5 - 256.0,
        512.0, 512.0), LTexCoords, TColorRect.White, TBlendingEffect.Copy);

      // Draw technology string.
      FCanvas.ContextState := TCanvasContextState.FlatText;

      LFontParams := TFontParameters.Create('Segoe UI', 16.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.Draw(Point2f(8.0 * FDisplayScale, 4.0 * FDisplayScale),
        Utf8String('FPS: ' + IntToStr(Round(FTimer.FrameRate))), ColorPair($A0FFFFFF));

      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(FDisplaySize.X - 8.0 * FDisplayScale, FDisplaySize.Y -
        4.0 * FDisplayScale), Utf8String(LTechString), ColorPair($A0FFFFFF),
        TTextAlignment.Ending, TTextAlignment.Ending);
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;
  FTimer.Update;
end;

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

procedure TMainForm.CreateTextures;
var
  LParameters: TTextureParameters;
begin
  FillChar(LParameters, SizeOf(TTextureParameters), 0);
  LParameters.Width := 512;
  LParameters.Height := 512;
  LParameters.Attributes := TTextureAttribute.Drawable or TTextureAttribute.PremultipliedAlpha;
  LParameters.Format := TPixelFormat.RGBA16;
  LParameters.Multisamples := 8;

  FTextureCanvasMSAA := TTexture.Create(FDevice, LParameters);

  LParameters.Multisamples := 0;

  FTextureCanvas := TTexture.Create(FDevice, LParameters);
  FTextureBlurred := TTexture.Create(FDevice, LParameters);
  FTextureBlurredCopy := TTexture.Create(FDevice, LParameters);

  LParameters.Format := TPixelFormat.RGBA8;

  FTextureBlurredDithered := TTexture.Create(FDevice, LParameters);
end;

procedure TMainForm.DestroyTextures;
begin
  FTextureBlurredDithered.Free;
  FTextureBlurredCopy.Free;
  FTextureBlurred.Free;
  FTextureCanvas.Free;
  FTextureCanvasMSAA.Free;
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;
end;

end.
