123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203 |
- unit fShaderComponent;
- 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,
- GLS.VectorTypes,
- GLS.VectorGeometry,
- GLSL.Shader,
- GLS.GeomObjects,
- GLS.VectorFileObjects,
- GLS.SimpleNavigation,
- GLSL.CustomShader,
-
- GLS.Material,
- GLS.Coordinates,
- GLS.BaseClasses,
- GLS.Utils,
- GLS.FileMD2,
- GLS.FileMS3D,
- GLS.File3DS,
- Formats.DDSImage;
- 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
- //First load scripts from shader directory
- SetGLSceneMediaDir();
- GLSLShader.LoadShaderPrograms('Shaders\Shader.Vert','Shaders\Shader.Frag');
- GLSLShader.Enabled := True;
- //Second load models from media directory
- SetGLSceneMediaDir();
- Fighter.LoadFromFile('waste.md2'); //Fighter
- Fighter.SwitchToAnimation(0, True);
- Fighter.AnimationMode := aamLoop;
- Fighter.Scale.Scale(3);
- 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_little.3ds'); //Sphere_little
- Sphere_little.Scale.Scale(4);
- // Then load textures.
- MaterialLibrary.LibMaterialByName('Earth').Material.Texture.Image.LoadFromFile('Earth.jpg');
- MaterialLibrary.LibMaterialByName('WasteSkin').Material.Texture.Image.LoadFromFile('waste.jpg');
- 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.
|