GLScene/Examples/Demos/glslshaders/Mandelbrot/fdMandelbrot.pas

unit fdMandelbrot;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.OpenGL,
  Winapi.OpenGLext,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ExtCtrls,
  Vcl.StdCtrls,
  Vcl.Imaging.Jpeg,

  Stage.Keyboard,
  Stage.Utils,

  GLS.SceneViewer,
  GLS.Texture,
  GLS.Cadencer,
  GLS.Scene,
  GLS.Context,
  GLS.XCollection,
  GLS.FileTGA,
  GLS.HUDObjects,
  GLS.BitmapFont,
  GLS.WindowsFont,
  GLS.Material,
  GLS.Coordinates,

  GLS.RenderContextInfo,
  GLS.BaseClasses,
  GLSL.CustomShader,
  GLSL.Shader;

type
  TFormMandelbrot = class(TForm)
    Scene: TGLScene;
    Timer1: TTimer;
    Viewer: TGLSceneViewer;
    GLCadencer: TGLCadencer;
    Mandelbrot: TGLDirectOpenGL;
    GLMatLib: TGLMaterialLibrary;
    GLCamera: TGLCamera;
    OpenDialog1: TOpenDialog;
    GLHUDText: TGLHUDText;
    GLWindowsBitmapFont: TGLWindowsBitmapFont;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure GLCadencerProgress(Sender: TObject;
      const deltaTime, newTime: Double);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure MandelbrotRender(Sender: TObject; var rci: TGLRenderContextInfo);
  public
    PathToAsset: TFileName;
    MandelbrotProgram: TGLProgramHandle;
  end;

const
  HELP_TEXT = '+: Zoom in'#13#10 + '-: Zoom out'#13#10 +
    'Arrow keys: Move around'#13#10 + 'F3: Load colormap';

var
  FormMandelbrot: TFormMandelbrot;
  PositionX, PositionY, Scale: Single;

implementation //=============================================================

{$R *.dfm}

//----------------------------------------------------------------------------
procedure TFormMandelbrot.FormCreate(Sender: TObject);
begin
//  SetCurrentDir(ExtractFilePath(ParamStr(0)));
  PathToAsset := GetCurrentAssetPath();
  SetCurrentDir(PathToAsset  + '\texture');
  GLMatLib.TexturePaths := PathToAsset;
  GLMatLib.Materials[0].Material.Texture.Image.LoadFromFile('hot_metal.bmp');
  PositionX := -0.5;
  PositionY := 0.0;
  Scale := 1.0;

  GLHUDText.Text := HELP_TEXT;
end;

//----------------------------------------------------------------------------
procedure TFormMandelbrot.Timer1Timer(Sender: TObject);
begin
  Caption := Format('Mandelbrot %.1f FPS', [Viewer.FramesPerSecond]);

  Viewer.ResetPerformanceMonitor;
end;

//----------------------------------------------------------------------------
procedure TFormMandelbrot.GLCadencerProgress(Sender: TObject;
  const deltaTime, newTime: Double);
var
  deltax, deltay: Single;
  pt: TPoint;
begin
  if IsKeyDown(VK_F3) then
    if OpenDialog1.Execute then
      GLMatLib.Materials[0].Material.Texture.Image.LoadFromFile
        (OpenDialog1.FileName);

  if IsKeyDown('+') or IsKeyDown(VK_ADD) then
    Scale := Scale * 1.0 / (1.0 + deltaTime * 0.5);

  if IsKeyDown('-') or IsKeyDown(VK_SUBTRACT) then
    Scale := Scale * (1.0 + deltaTime * 0.5);

  if IsKeyDown(VK_DOWN) or IsKeyDown(VK_NUMPAD8) then
    PositionY := PositionY + deltaTime * Scale * 0.5;

  if IsKeyDown(VK_UP) or IsKeyDown(VK_NUMPAD2) then
    PositionY := PositionY - deltaTime * Scale * 0.5;

  if IsKeyDown(VK_LEFT) or IsKeyDown(VK_NUMPAD6) then
    PositionX := PositionX + deltaTime * Scale * 0.5;

  if IsKeyDown(VK_RIGHT) or IsKeyDown(VK_NUMPAD4) then
    PositionX := PositionX - deltaTime * Scale * 0.5;

  Viewer.Invalidate;
end;

//----------------------------------------------------------------------------
procedure TFormMandelbrot.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  DistDelta: Single;
begin
end;

//----------------------------------------------------------------------------
procedure TFormMandelbrot.MandelbrotRender(Sender: TObject;
  var rci: TGLRenderContextInfo);
begin
  // shader init
  if not Assigned(MandelbrotProgram) then
  begin
    SetCurrentDir(PathToAsset  + '\shader');

    MandelbrotProgram := TGLProgramHandle.CreateAndAllocate;
      MandelbrotProgram.AddShader(TGLFragmentShaderHandle,
      String(LoadAnsiStringFromFile('Mandelbrot.frag')), True);
    MandelbrotProgram.AddShader(TGLVertexShaderHandle,
      String(LoadAnsiStringFromFile('Mandelbrot.vert')), True);

    if not MandelbrotProgram.LinkProgram then
      raise Exception.Create(MandelbrotProgram.InfoLog);

    if not MandelbrotProgram.ValidateProgram then
      raise Exception.Create(MandelbrotProgram.InfoLog);
  end;

  glPushAttrib(GL_ALL_ATTRIB_BITS);
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;

  MandelbrotProgram.UseProgramObject;

  MandelbrotProgram.Uniform1f['positionX'] := PositionX;
  MandelbrotProgram.Uniform1f['positionY'] := PositionY;
  MandelbrotProgram.Uniform1f['scale'] := Scale;

  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, GLMatLib.Materials[0].Material.Texture.Handle);
  MandelbrotProgram.Uniform1i['colorMap'] := 0;

  // drawing rectangle over screen
  glDisable(GL_DEPTH_TEST);
  glDisable(GL_LIGHTING);

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 0.0);
  glVertex2f(-1.0, -1.0);
  glTexCoord2f(1.0, 0.0);
  glVertex2f(1.0, -1.0);

  glTexCoord2f(1.0, 1.0);
  glVertex2f(1.0, 1.0);
  glTexCoord2f(0.0, 1.0);
  glVertex2f(-1.0, 1.0);
  glEnd;

  MandelbrotProgram.EndUseProgramObject;

  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix;
  glPopAttrib;

  /// -CheckOpenGLError;
end;

end.