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

unit fMandelbrotD;

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,

  GLS.SceneViewer,
  GLS.Texture,
  GLS.Cadencer,
  GLS.Scene,
  GLS.Context,
  GLS.Keyboard,
  GLScene.Utils,
  GLS.FileTGA,
  GLS.HUDObjects,
  GLS.BitmapFont,
  GLS.WindowsFont,
  GLS.Material,
  GLS.Coordinates,

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

type
  TForm1 = 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
  Form1: TForm1;
  PositionX, PositionY, Scale: Single;

implementation

{$R *.dfm}

procedure TForm1.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 TForm1.Timer1Timer(Sender: TObject);
begin
  Caption := Format('Mandelbrot %.1f FPS', [Viewer.FramesPerSecond]);

  Viewer.ResetPerformanceMonitor;
end;

procedure TForm1.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 TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  DistDelta: Single;
begin
end;

procedure TForm1.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.