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:
//  * Creating and filling texture from system memory in real-time to produce a plasma-looking effect.
//  * Accurate time-based movement independent of rendering frame rate.

interface

uses
{$IFDEF MSWINDOWS}
  PXT.Controls,
{$ELSE}
  OpenGLContext,
{$ENDIF}
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, 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;
    FTextRenderer: TTextRenderer;
    FTimer: TTimer;

    FSurfacePlasma: TSurface;
    FTexturePlasma: TTexture;
    FTextureScanline: TTexture;

    FLookupSin: array[0..2047] of Word;
    FLookupCos: array[0..2047] of Word;

    FShift: TPoint2i;
    FPaletteIndex: Integer;

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

var
  MainForm: TMainForm;

implementation
{$R *.lfm}

uses
  Math, PXT.Headers;

{$I Palette.inc}

procedure TMainForm.FormCreate(Sender: TObject);
var
  LPixels: array[0..63, 0..63] of Byte;
  I, J: Integer;
begin
  CreateRenderingControl;
  FDisplaySize := Point2i(ClientWidth, ClientHeight);
  FDisplayScale := PixelsPerInch / 96.0;
  try
  {$IFDEF MSWINDOWS}
    FDevice := TDevice.Create;
  {$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);

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

    FSurfacePlasma := TSurface.Create(512, 512, TPixelFormat.RGBA8);

    FTexturePlasma := TTexture.Create(FDevice, TTextureParameters.Create(512, 512, 0, TPixelFormat.RGBA8,
      TTextureType.Surface, TTextureAttribute.&Dynamic));

    FTextureScanline := TTexture.Create(FDevice, TTextureParameters.Create(64, 64, 0, TPixelFormat.L8));

    // Generate scanline texture content.
    for J := 0 to 63 do
      for I := 0 to 63 do
        if J mod 2 = 1 then
          LPixels[J, I] := 174
        else
          LPixels[J, I] := 255;

    FTextureScanline.Update(@LPixels[0, 0], 0, 0, TIntRect.Zero);

    // Create lookup tables.
    for I := 0 to 2047 do
    begin
      FLookupSin[I] := (Trunc(Sin(2.0 * Pi * I / 2048) * 1024) + 1024) and $7FF;
      FLookupCos[I] := (Trunc(Cos(2.0 * Pi * I / 2048) * 1024) + 1024) and $7FF;
    end;
  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
  FTextureScanline.Free;
  FTexturePlasma.Free;
  FSurfacePlasma.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);
end;

procedure TMainForm.RenderingControlPaint(Sender: TObject);
var
  LFontParams: TFontParameters;
  LTechString: string;
  LTexCoords: TQuad;
  LFlipped: Boolean;
  LDest: PIntColor;
  I, J, LAddX, LAddC, LIndex, LTokens: Integer;
begin
  FDisplayScale := PixelsPerInch / 96.0;

  LFlipped :=
    (FDevice.Technology = TDeviceTechnology.OpenGL) or
    (FDevice.Technology = TDeviceTechnology.OpenGL_ES);

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

  // Update plasma array and texture.
  for J := 0 to FSurfacePlasma.Height - 1 do
  begin
    LDest := FSurfacePlasma.Scanline[J];

    LAddX := FLookupSin[((J shl 2) + FShift.X) and $7FF];
    LAddC := FLookupCos[((J shl 2) + FShift.Y) and $7FF];

    for I := 0 to FSurfacePlasma.Width - 1 do
    begin
      LIndex := (FLookupSin[((I shl 2) + LAddX) and $7FF] + LAddC) and $7FF;
      if LIndex > 1023 then
        LIndex := 2047 - LIndex;

//      LDest^ := MakeColorGray(127 + ((LIndex * 255) div $7FF), 255);
      LDest^ := PlasmaPalette[((LIndex shr 2) + FPaletteIndex) and $3FF];
      Inc(LDest);
    end;
  end;
  FTexturePlasma.Copy(FSurfacePlasma, 0, TPoint2i.Zero, TIntRect.Zero);

  FSwapChain.BeginScene;
  try
    FDevice.Clear([TClearLayer.Color], FloatColor($FFE1E2E6));

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

      // Draw plasma texture tiled.
      for J := 0 to FDisplaySize.Y div 512 do
        for I := 0 to FDisplaySize.X div 512 do
          FCanvas.Quad(FTexturePlasma, Quad(I * 512.0, J * 512.0, 512.0, 512.0), LTexCoords,
            TColorRect.White, TBlendingEffect.Copy);

      // Apply scanline effect.
      for J := 0 to FDisplaySize.Y div 64 do
        for I := 0 to FDisplaySize.X div 64 do
          FCanvas.Quad(FTextureScanline, Quad(I * 64.0, J * 64.0, 64.0, 64.0), LTexCoords,
            TColorRect.White, TBlendingEffect.Multiply);

      // Prepare canvas for text output.
      FCanvas.ContextState := TCanvasContextState.FlatText;

      // Draw technology string.
      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.DrawAligned(Point2f(8.0 * FDisplayScale, 4.0 * FDisplayScale),
        Utf8String('Frame Rate: ' + IntToStr(Round(FTimer.FrameRate))), ColorPair($B0FFFFFF),
        TTextAlignment.Start, TTextAlignment.Start);

      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($B0FFFFFF),
        TTextAlignment.Ending, TTextAlignment.Ending);
    finally
      FCanvas.EndScene;
    end;
  finally
    FSwapChain.EndScene;
  end;
{$IFNDEF MSWINDOWS}
  TOpenGLControl(FRenderingControl).SwapBuffers;
{$ENDIF}

  FTimer.Update;

  // Extract fixed-rate processing tokens, if there are any.
  LTokens := FTimer.Tokens;

  // Advance animation by a number of fixed-rate processing tokens.
  Inc(FShift.X, LTokens);
  Dec(FShift.Y, LTokens);
  Inc(FPaletteIndex, LTokens);
end;

procedure TMainForm.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
  FRenderingControl.Invalidate;
  Done := False;
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;
  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;

    MakeCurrent;
  end;
{$ENDIF}
end;

end.
