fShaderComponent.pas 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203
  1. unit fShaderComponent;
  2. interface
  3. uses
  4. System.SysUtils,
  5. System.Classes,
  6. Vcl.Controls,
  7. Vcl.Forms,
  8. Vcl.ExtCtrls,
  9. Vcl.StdCtrls,
  10. GLS.Texture,
  11. GLS.Cadencer,
  12. GLS.SceneViewer,
  13. GLS.Scene,
  14. GLS.Objects,
  15. GLS.Graph,
  16. GLS.VectorLists,
  17. GLS.VectorTypes,
  18. GLS.VectorGeometry,
  19. GLSL.Shader,
  20. GLS.GeomObjects,
  21. GLS.VectorFileObjects,
  22. GLS.SimpleNavigation,
  23. GLSL.CustomShader,
  24. GLS.Material,
  25. GLS.Coordinates,
  26. GLS.BaseClasses,
  27. GLS.Utils,
  28. GLS.FileMD2,
  29. GLS.FileMS3D,
  30. GLS.File3DS,
  31. Formats.DDSImage;
  32. type
  33. TGLSLTestForm = class(TForm)
  34. Scene: TGLScene;
  35. Viewer: TGLSceneViewer;
  36. Cadencer: TGLCadencer;
  37. Camera: TGLCamera;
  38. Light: TGLLightSource;
  39. LightCube: TGLDummyCube;
  40. GLSphere1: TGLSphere;
  41. GLXYZGrid1: TGLXYZGrid;
  42. GLArrowLine1: TGLArrowLine;
  43. Panel1: TPanel;
  44. LightMovingCheckBox: TCheckBox;
  45. GUICube: TGLDummyCube;
  46. WorldCube: TGLDummyCube;
  47. Fighter: TGLActor;
  48. Teapot: TGLActor;
  49. Sphere_big: TGLActor;
  50. Sphere_little: TGLActor;
  51. MaterialLibrary: TGLMaterialLibrary;
  52. ShadeEnabledCheckBox: TCheckBox;
  53. TurnPitchrollCheckBox: TCheckBox;
  54. GLSLShader: TGLSLShader;
  55. GLSimpleNavigation1: TGLSimpleNavigation;
  56. procedure FormCreate(Sender: TObject);
  57. procedure CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
  58. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  59. procedure LightCubeProgress(Sender: TObject; const deltaTime,
  60. newTime: Double);
  61. procedure ShadeEnabledCheckBoxClick(Sender: TObject);
  62. procedure GLSLShaderApply(Shader: TGLCustomGLSLShader);
  63. procedure GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
  64. procedure GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
  65. var ThereAreMorePasses: Boolean);
  66. procedure GLSLShaderApplyEx(Shader: TGLCustomGLSLShader;
  67. Sender: TObject);
  68. procedure GLSLShaderInitializeEx(Shader: TGLCustomGLSLShader;
  69. Sender: TObject);
  70. end;
  71. var
  72. GLSLTestForm: TGLSLTestForm;
  73. implementation
  74. {$R *.dfm}
  75. procedure TGLSLTestForm.FormCreate(Sender: TObject);
  76. begin
  77. //First load scripts from shader directory
  78. SetGLSceneMediaDir();
  79. GLSLShader.LoadShaderPrograms('Shaders\Shader.Vert','Shaders\Shader.Frag');
  80. GLSLShader.Enabled := True;
  81. //Second load models from media directory
  82. SetGLSceneMediaDir();
  83. Fighter.LoadFromFile('waste.md2'); //Fighter
  84. Fighter.SwitchToAnimation(0, True);
  85. Fighter.AnimationMode := aamLoop;
  86. Fighter.Scale.Scale(3);
  87. Teapot.LoadFromFile('Teapot.3ds'); //Teapot (no texture coordinates)
  88. Teapot.Scale.Scale(0.8);
  89. Sphere_big.LoadFromFile('Sphere_big.3DS'); //Sphere_big
  90. Sphere_big.Scale.Scale(70);
  91. Sphere_little.LoadFromFile('Sphere_little.3ds'); //Sphere_little
  92. Sphere_little.Scale.Scale(4);
  93. // Then load textures.
  94. MaterialLibrary.LibMaterialByName('Earth').Material.Texture.Image.LoadFromFile('Earth.jpg');
  95. MaterialLibrary.LibMaterialByName('WasteSkin').Material.Texture.Image.LoadFromFile('waste.jpg');
  96. end;
  97. procedure TGLSLTestForm.ShadeEnabledCheckBoxClick(Sender: TObject);
  98. begin
  99. GLSLShader.Enabled := ShadeEnabledCheckBox.Checked;
  100. end;
  101. procedure TGLSLTestForm.GLSLShaderApply(Shader: TGLCustomGLSLShader);
  102. begin
  103. {* Old variant of Apply
  104. with Shader do
  105. begin
  106. Param['DiffuseColor'].AsVector4f := VectorMake(1, 1, 1, 1);
  107. Param['AmbientColor'].AsVector4f := VectorMake(0.2, 0.2, 0.2, 1);
  108. Param['LightIntensity'].AsVector1f := 1;
  109. Param['MainTexture'].AsTexture2D[0] :=
  110. MaterialLibrary.LibMaterialByName('Earth').Material.Texture;
  111. end;
  112. *}
  113. end;
  114. procedure TGLSLTestForm.GLSLShaderApplyEx(Shader: TGLCustomGLSLShader;
  115. Sender: TObject);
  116. begin
  117. with Shader do
  118. begin
  119. Param['DiffuseColor'].AsVector4f := VectorMake(1, 1, 1, 1);
  120. Param['AmbientColor'].AsVector4f := VectorMake(0.2, 0.2, 0.2, 1);
  121. Param['LightIntensity'].AsVector1f := 1;
  122. SetTex('MainTexture', TGLLibMaterial(Sender).Material.Texture);
  123. end;
  124. end;
  125. procedure TGLSLTestForm.GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
  126. begin
  127. with Shader do
  128. begin
  129. // Nothing.
  130. end;
  131. end;
  132. procedure TGLSLTestForm.GLSLShaderInitializeEx(Shader: TGLCustomGLSLShader;
  133. Sender: TObject);
  134. begin
  135. with Shader do
  136. begin
  137. // For AMD's shaders validation
  138. SetTex('MainTexture', TGLLibMaterial(Sender).Material.Texture);
  139. end;
  140. end;
  141. procedure TGLSLTestForm.GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
  142. var ThereAreMorePasses: Boolean);
  143. begin
  144. with Shader do
  145. begin
  146. // Nothing.
  147. end;
  148. end;
  149. procedure TGLSLTestForm.CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
  150. begin
  151. Viewer.Invalidate;
  152. if TurnPitchrollCheckBox.Checked then
  153. begin
  154. Sphere_big.Pitch(40 * deltaTime);
  155. Sphere_big.Turn(40 * deltaTime);
  156. Sphere_little.Roll(40 * deltaTime);
  157. end;
  158. end;
  159. procedure TGLSLTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
  160. begin
  161. Cadencer.Enabled := False;
  162. end;
  163. procedure TGLSLTestForm.LightCubeProgress(Sender: TObject; const deltaTime,
  164. newTime: Double);
  165. begin
  166. if LightMovingCheckBox.Checked then
  167. LightCube.MoveObjectAround(Camera.TargetObject, sin(NewTime) * deltaTime * 10, deltaTime * 20);
  168. end;
  169. end.