GLScene/Examples/Demos/glslshaders/ShaderComponent/fShaderCompD.pas

unit fShaderCompD;

interface

uses
  System.SysUtils,
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.ExtCtrls,
  Vcl.StdCtrls,

  GLS.Texture,
  GLS.Cadencer,
  GLS.SceneViewer,
  GLS.Scene,
  GLS.Objects,
  GLS.Graph,
  GLS.VectorLists,
  GLScene.VectorTypes,
  GLScene.VectorGeometry,
  GLSL.Shader,
  GLS.GeomObjects,
  GLS.VectorFileObjects,
  GLS.SimpleNavigation,
  GLSL.CustomShader,
 
  GLS.Material,
  GLS.Coordinates,
  GLS.BaseClasses,
  GLScene.Utils,

  GLS.FileMD2,
  GLS.FileMS3D,
  GLS.File3DS;

type
  TGLSLTestForm = class(TForm)
    Scene: TGLScene;
    Viewer: TGLSceneViewer;
    Cadencer: TGLCadencer;
    Camera: TGLCamera;
    Light:  TGLLightSource;
    LightCube: TGLDummyCube;
    GLSphere1: TGLSphere;
    GLXYZGrid1: TGLXYZGrid;
    GLArrowLine1: TGLArrowLine;
    Panel1: TPanel;
    LightMovingCheckBox: TCheckBox;
    GUICube: TGLDummyCube;
    WorldCube: TGLDummyCube;
    Fighter: TGLActor;
    Teapot: TGLActor;
    Sphere_big: TGLActor;
    Sphere_little: TGLActor;
    MaterialLibrary: TGLMaterialLibrary;
    ShadeEnabledCheckBox: TCheckBox;
    TurnPitchrollCheckBox: TCheckBox;
    GLSLShader: TGLSLShader;
    GLSimpleNavigation1: TGLSimpleNavigation;
    procedure FormCreate(Sender: TObject);
    procedure CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure LightCubeProgress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure ShadeEnabledCheckBoxClick(Sender: TObject);
    procedure GLSLShaderApply(Shader: TGLCustomGLSLShader);
    procedure GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
    procedure GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
      var ThereAreMorePasses: Boolean);
    procedure GLSLShaderApplyEx(Shader: TGLCustomGLSLShader;
      Sender: TObject);
    procedure GLSLShaderInitializeEx(Shader: TGLCustomGLSLShader;
      Sender: TObject);
  end;

var
  GLSLTestForm:  TGLSLTestForm;

implementation

{$R *.dfm}

procedure TGLSLTestForm.FormCreate(Sender: TObject);
begin
  var Path: TFileName := GetCurrentAssetPath();

  // Loading static models
  SetCurrentDir(Path  + '\model');
  Teapot.LoadFromFile('Teapot.3ds'); //Teapot (no texture coordinates)
  Teapot.Scale.Scale(0.8);
  Sphere_big.LoadFromFile('Sphere_big.3DS'); //Sphere_big
  Sphere_big.Scale.Scale(70);
  Sphere_little.LoadFromFile('Sphere.3ds'); //Sphere_little
  Sphere_little.Scale.Scale(4);


  // Loading models with animations and skins
  SetCurrentDir(Path  + '\modelext');
  Fighter.LoadFromFile('waste.md2');
  Fighter.SwitchToAnimation(0, True);
  Fighter.AnimationMode := aamLoop;
  Fighter.Scale.Scale(3);
  // Skin texture
  MaterialLibrary.LibMaterialByName('WasteSkin').Material.Texture.Image.LoadFromFile('waste.jpg');

  // Then load textures.
  SetCurrentDir(Path  + '\map');
  MaterialLibrary.LibMaterialByName('Earth').Material.Texture.Image.LoadFromFile('earth.jpg');

  // Loading scripts from shader directory
  SetCurrentDir(Path  + '\shader');
  GLSLShader.LoadShaderPrograms('Shader.Vert','Shader.Frag');
  GLSLShader.Enabled := True;

end;

procedure TGLSLTestForm.ShadeEnabledCheckBoxClick(Sender: TObject);
begin
  GLSLShader.Enabled := ShadeEnabledCheckBox.Checked;
end;

procedure TGLSLTestForm.GLSLShaderApply(Shader: TGLCustomGLSLShader);
begin
{*  Old variant of Apply
  with Shader do
  begin
    Param['DiffuseColor'].AsVector4f := VectorMake(1, 1, 1, 1);
    Param['AmbientColor'].AsVector4f := VectorMake(0.2, 0.2, 0.2, 1);
    Param['LightIntensity'].AsVector1f := 1;
    Param['MainTexture'].AsTexture2D[0] :=
      MaterialLibrary.LibMaterialByName('Earth').Material.Texture;
  end;
*}
end;

procedure TGLSLTestForm.GLSLShaderApplyEx(Shader: TGLCustomGLSLShader;
  Sender: TObject);
begin
  with Shader do
  begin
    Param['DiffuseColor'].AsVector4f := VectorMake(1, 1, 1, 1);
    Param['AmbientColor'].AsVector4f := VectorMake(0.2, 0.2, 0.2, 1);
    Param['LightIntensity'].AsVector1f := 1;
    SetTex('MainTexture', TGLLibMaterial(Sender).Material.Texture);
  end;
end;

procedure TGLSLTestForm.GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
begin
  with Shader do
  begin
    // Nothing.
  end;
end;

procedure TGLSLTestForm.GLSLShaderInitializeEx(Shader: TGLCustomGLSLShader;
  Sender: TObject);
begin
  with Shader do
  begin
    // For AMD's shaders validation
    SetTex('MainTexture', TGLLibMaterial(Sender).Material.Texture);
  end;
end;

procedure TGLSLTestForm.GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
  var ThereAreMorePasses: Boolean);
begin
  with Shader do
  begin
    // Nothing.
  end;
end;

procedure TGLSLTestForm.CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
begin
  Viewer.Invalidate;

  if TurnPitchrollCheckBox.Checked then
  begin
    Sphere_big.Pitch(40 * deltaTime);
    Sphere_big.Turn(40 * deltaTime);
    Sphere_little.Roll(40 * deltaTime);
  end;
end;


procedure TGLSLTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Cadencer.Enabled := False;
end;


procedure TGLSLTestForm.LightCubeProgress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
  if LightMovingCheckBox.Checked then
    LightCube.MoveObjectAround(Camera.TargetObject, sin(NewTime) * deltaTime * 10, deltaTime * 20);
end;


end.