fActorms3dD.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397
  1. unit fActorms3dD;
  2. interface
  3. uses
  4. System.SysUtils,
  5. System.Variants,
  6. System.Classes,
  7. Vcl.Controls,
  8. Vcl.Forms,
  9. Vcl.Dialogs,
  10. Vcl.StdCtrls,
  11. Vcl.ExtCtrls,
  12. Vcl.ComCtrls,
  13. Vcl.Imaging.jpeg,
  14. Vcl.Imaging.pngimage,
  15. GLScene.VectorGeometry,
  16. GLScene.VectorTypes,
  17. GLScene.Utils,
  18. GLS.PipelineTransformation,
  19. GLS.VectorLists,
  20. GLS.Cadencer,
  21. GLS.SceneViewer,
  22. GLS.BaseClasses,
  23. GLS.Scene,
  24. GLS.VectorFileObjects,
  25. GLS.Objects,
  26. GLS.Coordinates,
  27. GLS.GeomObjects,
  28. GLS.FileMS3D,
  29. GLS.Material,
  30. GLS.CameraController,
  31. GLS.Graphics,
  32. GLS.RenderContextInfo,
  33. GLS.ShadowPlane,
  34. GLS.SimpleNavigation,
  35. GLS.Mesh,
  36. GLS.Gui,
  37. GLS.Windows,
  38. GLS.State,
  39. GLS.ArchiveManager,
  40. GLS.Context,
  41. GLS.CompositeImage,
  42. GLS.FileZLIB,
  43. GLS.FileJPEG,
  44. GLS.FilePNG,
  45. GLS.FBORenderer,
  46. GLSL.Shader,
  47. GLSL.CustomShader;
  48. type
  49. TFormActorms3d = class(TForm)
  50. GLScene1: TGLScene;
  51. GLSceneViewer1: TGLSceneViewer;
  52. GLCadencer1: TGLCadencer;
  53. Root: TGLDummyCube;
  54. GLCamera1: TGLCamera;
  55. Actor1: TGLActor;
  56. Panel1: TPanel;
  57. Button2: TButton;
  58. btnStartStop: TButton;
  59. Button4: TButton;
  60. Light2: TGLLightSource;
  61. GLFrameBuffer: TGLFBORenderer;
  62. GLDirectOpenGL1: TGLDirectOpenGL;
  63. GLCamera2: TGLCamera;
  64. GLPlane1: TGLPlane;
  65. GLNavigation: TGLSimpleNavigation;
  66. Chair1: TGLFreeForm;
  67. Globus: TGLSphere;
  68. LightSpot: TGLLightSource;
  69. aniBox: TComboBox;
  70. aniPos: TTrackBar;
  71. Timer1: TTimer;
  72. GLSArchiveManager1: TGLSArchiveManager;
  73. GLSLShader1: TGLSLShader;
  74. MatLib: TGLMaterialLibrary;
  75. procedure FormCreate(Sender: TObject);
  76. procedure Button2Click(Sender: TObject);
  77. procedure btnStartStopClick(Sender: TObject);
  78. procedure Button4Click(Sender: TObject);
  79. procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double);
  80. procedure GLFrameBufferBeforeRender(Sender: TObject; var rci: TGLRenderContextInfo);
  81. procedure GLFrameBufferAfterRender(Sender: TObject; var rci: TGLRenderContextInfo);
  82. procedure GLDirectOpenGL1Render(Sender: TObject; var rci: TGLRenderContextInfo);
  83. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  84. procedure FormShow(Sender: TObject);
  85. procedure aniPosChange(Sender: TObject);
  86. procedure Timer1Timer(Sender: TObject);
  87. procedure aniBoxSelect(Sender: TObject);
  88. procedure Actor1EndFrameReached(Sender: TObject);
  89. procedure GLSLShader1Initialize(Shader: TGLCustomGLSLShader);
  90. procedure GLSLShader1Apply(Shader: TGLCustomGLSLShader);
  91. private
  92. FAppPath: string;
  93. procedure SetAppPath(const Value: string);
  94. public
  95. property AppPath: string read FAppPath write SetAppPath;
  96. procedure LoadArchiveTexture(const AName: string; const ext: string);
  97. end;
  98. var
  99. FormActorms3d: TFormActorms3d;
  100. mdx: Integer;
  101. mdy: Integer;
  102. FBiasMatrix: TGLMatrix;
  103. FLightModelViewMatrix: TGLMatrix;
  104. FLightProjMatrix: TGLMatrix;
  105. FInvCameraMatrix: TGLMatrix;
  106. FEyeToLightMatrix: TGLMatrix;
  107. FLightModelViewMatrix2: TGLMatrix;
  108. FLightProjMatrix2: TGLMatrix;
  109. FInvCameraMatrix2: TGLMatrix;
  110. FEyeToLightMatrix2: TGLMatrix;
  111. implementation
  112. {$R *.dfm}
  113. procedure TFormActorms3d.LoadArchiveTexture(const AName: string; const ext: string);
  114. var
  115. img: TGLCompositeImage;
  116. strm: TStream;
  117. begin
  118. img := MatLib.TextureByName(AName).Image as TGLCompositeImage;
  119. strm := GLSArchiveManager1.Archives[0].GetContent('Main/' + AName + '.' + ext);
  120. img.LoadFromStream(strm);
  121. end;
  122. procedure TFormActorms3d.FormCreate(Sender: TObject);
  123. begin
  124. // Loading an archive, to edit it you can use ..\utilities\ArchiveEdit
  125. var Path: TFileName := GetCurrentAssetPath();
  126. SetCurrentDir(Path + '\modelext\');
  127. GLSArchiveManager1.Archives[0].LoadFromFile('ActorMS3D.zlib');
  128. // Loading models from stream of the archive
  129. Actor1.LoadFromStream('Woman4.ms3d', GLSArchiveManager1.Archives[0].GetContent('Main/Woman4.ms3d'));
  130. Chair1.LoadFromStream('Chair.ms3d', GLSArchiveManager1.Archives[0].GetContent('Main/Chair.ms3d'));
  131. // Loading textures from the archive as composite images and assigned to MatLib
  132. LoadArchiveTexture('Hair','png');
  133. // LoadArchiveTexture('Chair','png');
  134. // Loading skins
  135. SetCurrentDir(Path + '\skin');
  136. // Add skin to MatLib
  137. // MatLib.AddTextureMaterial('Woman4_skin','Woman_skin.jpg');
  138. // Actor1.Material.LibMaterialName := 'Woman4_skin';
  139. Actor1.Material.Texture.Image.LoadFromFile('Woman_skin.jpg');
  140. // Loading map for the earth
  141. SetCurrentDir(Path + '\map');
  142. Globus.Material.Texture.Image.LoadFromFile('earth.jpg');
  143. // Loading other textures as assets directly to objects
  144. SetCurrentDir(Path + '\texture');
  145. GLPlane1.Material.Texture.Image.LoadFromFile('floor_parquet.jpg');
  146. // Loading a lightspot image
  147. MatLib.AddTextureMaterial('Lightspot','Flare1.bmp');
  148. // MatLib.TextureByName('LightSpot').Image.LoadFromFile('Flare1.bmp');
  149. Actor1.AnimationMode := aamNone;
  150. Actor1.Scale.SetVector(0.1, 0.1, 0.1, 0);
  151. Chair1.Scale.SetVector(0.35, 0.35, 0.35, 0);
  152. // The MS3D Model has multiple animations all in sequence.
  153. with Actor1.Animations.Add do
  154. begin
  155. Reference := aarSkeleton;
  156. StartFrame := 2; // because first frame is going to be the RootPos
  157. EndFrame := 855;
  158. Name := 'Dance';
  159. end;
  160. with Actor1.Animations.Add do
  161. begin
  162. Reference := aarSkeleton;
  163. StartFrame := 856;
  164. EndFrame := 1166;
  165. Name := 'Sexy Walk';
  166. end;
  167. with Actor1.Animations.Add do
  168. begin
  169. Reference := aarSkeleton;
  170. StartFrame := 1168;
  171. EndFrame := 1203;
  172. Name := 'Cartwheel';
  173. end;
  174. with Actor1.Animations.Add do
  175. begin
  176. Reference := aarSkeleton;
  177. StartFrame := 1205;
  178. EndFrame := 1306;
  179. Name := 'Hand Flip';
  180. end;
  181. with Actor1.Animations.Add do
  182. begin
  183. Reference := aarSkeleton;
  184. StartFrame := 1308;
  185. EndFrame := 1395;
  186. Name := 'Wave';
  187. end;
  188. with Actor1.Animations.Add do
  189. begin
  190. Reference := aarSkeleton;
  191. StartFrame := 1397;
  192. EndFrame := 2014;
  193. Name := 'Sun Salutation';
  194. end;
  195. with Actor1.Animations.Add do
  196. begin
  197. Reference := aarSkeleton;
  198. StartFrame := 2016;
  199. EndFrame := 2133;
  200. Name := 'Sit';
  201. end;
  202. FBiasMatrix := CreateScaleAndTranslationMatrix(VectorMake(0.5, 0.5, 0.5),
  203. VectorMake(0.5, 0.5, 0.5));
  204. // Loading shaders for shadows
  205. SetCurrentDir(Path + '\shader');
  206. GLSLShader1.VertexProgram.LoadFromFile('shadowmap_vp.glsl');
  207. GLSLShader1.FragmentProgram.LoadFromFile('shadowmap_fp.glsl');
  208. GLSLShader1.Enabled := true;
  209. // Enable texturing
  210. GLPlane1.Material.Texture.Disabled := False;
  211. Chair1.Material.Texture.Disabled := False;
  212. end;
  213. procedure TFormActorms3d.FormShow(Sender: TObject);
  214. begin
  215. aniBox.ItemIndex := 0;
  216. aniBoxSelect(Sender);
  217. end;
  218. procedure TFormActorms3d.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double);
  219. var
  220. af, af2, pv, pv2: TAffineVector;
  221. begin
  222. // This is used to always keep the spotlight pointed at the model during
  223. // animation translations.
  224. GLCamera2.Position.Rotate(VectorMake(0, 1, 0), deltaTime * 0.1);
  225. af := Actor1.Skeleton.CurrentFrame.Position[0];
  226. scalevector(af, Actor1.Scale.AsAffineVector);
  227. af2 := GLCamera2.Position.AsAffineVector;
  228. pv := VectorSubtract(af, af2);
  229. NormalIzeVector(pv);
  230. GLCamera2.Direction.AsAffineVector := pv;
  231. end;
  232. procedure TFormActorms3d.Actor1EndFrameReached(Sender: TObject);
  233. begin
  234. if (Actor1.AnimationMode = aamNone) then
  235. begin
  236. btnStartStop.Caption := 'Start';
  237. Timer1.Enabled := False;
  238. aniPos.Enabled := True;
  239. end;
  240. end;
  241. procedure TFormActorms3d.aniBoxSelect(Sender: TObject);
  242. begin
  243. Actor1.AnimationMode := aamNone;
  244. if (aniBox.ItemIndex <> -1) then
  245. begin
  246. Chair1.Visible := aniBox.ItemIndex = 6;
  247. Timer1.Enabled := False;
  248. aniPos.Enabled := False;
  249. Actor1.SwitchToAnimation(aniBox.ItemIndex + 1, False);
  250. aniPos.Min := 0;
  251. aniPos.Max := Actor1.EndFrame - Actor1.StartFrame;
  252. aniPos.Position := 0;
  253. aniPos.Enabled := True;
  254. btnStartStop.Caption := 'Start';
  255. end;
  256. end;
  257. procedure TFormActorms3d.aniPosChange(Sender: TObject);
  258. begin
  259. if (aniPos.Enabled) then
  260. Actor1.CurrentFrame := Actor1.StartFrame + aniPos.Position;
  261. end;
  262. procedure TFormActorms3d.Button2Click(Sender: TObject);
  263. begin
  264. Actor1.NextFrame;
  265. end;
  266. procedure TFormActorms3d.btnStartStopClick(Sender: TObject);
  267. begin
  268. if (Actor1.AnimationMode = aamNone) then
  269. begin
  270. if (Actor1.CurrentFrame = Actor1.EndFrame) then
  271. Actor1.CurrentFrame := Actor1.StartFrame;
  272. Actor1.AnimationMode := aamPlayOnce;
  273. TButton(Sender).Caption := 'Stop';
  274. Timer1.Enabled := True;
  275. aniPos.Enabled := False;
  276. end
  277. else
  278. begin
  279. Actor1.AnimationMode := aamNone;
  280. TButton(Sender).Caption := 'Start';
  281. Timer1.Enabled := False;
  282. aniPos.Enabled := True;
  283. end;
  284. end;
  285. procedure TFormActorms3d.Button4Click(Sender: TObject);
  286. begin
  287. Actor1.PrevFrame;
  288. end;
  289. procedure TFormActorms3d.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  290. begin
  291. Actor1.AnimationMode := aamNone;
  292. GLCadencer1.Enabled := False;
  293. end;
  294. procedure TFormActorms3d.GLDirectOpenGL1Render(Sender: TObject; var rci: TGLRenderContextInfo);
  295. begin
  296. // prepare shadow mapping matrix
  297. FInvCameraMatrix := rci.PipelineTransformation.InvModelViewMatrix^;
  298. // go from eye space to light's "eye" space
  299. FEyeToLightMatrix := MatrixMultiply(FInvCameraMatrix, FLightModelViewMatrix);
  300. // then to clip space
  301. FEyeToLightMatrix := MatrixMultiply(FEyeToLightMatrix, FLightProjMatrix);
  302. // and finally make the [-1..1] coordinates into [0..1]
  303. FEyeToLightMatrix := MatrixMultiply(FEyeToLightMatrix, FBiasMatrix);
  304. end;
  305. procedure TFormActorms3d.GLFrameBufferAfterRender(Sender: TObject; var rci: TGLRenderContextInfo);
  306. begin
  307. CurrentGLContext.GLStates.Disable(stPolygonOffsetFill);
  308. end;
  309. procedure TFormActorms3d.GLFrameBufferBeforeRender(Sender: TObject; var rci: TGLRenderContextInfo);
  310. begin
  311. with CurrentGLContext.PipelineTransformation do
  312. begin
  313. FLightModelViewMatrix := ModelViewMatrix^;
  314. FLightProjMatrix := ProjectionMatrix^;
  315. end;
  316. // push geometry back a bit, prevents false self-shadowing
  317. with CurrentGLContext.GLStates do
  318. begin
  319. Enable(stPolygonOffsetFill);
  320. PolygonOffsetFactor := 2;
  321. PolygonOffsetUnits := 2;
  322. end;
  323. end;
  324. procedure TFormActorms3d.GLSLShader1Apply(Shader: TGLCustomGLSLShader);
  325. begin
  326. with Shader, MatLib do
  327. begin
  328. Param['ShadowMap'].AsTexture2D[1] :=
  329. TextureByName(GLFrameBuffer.DepthTextureName);
  330. Param['LightspotMap'].AsTexture2D[2] := TextureByName('Lightspot');
  331. Param['Scale'].AsFloat := 16.0;
  332. Param['Softly'].AsInteger := 1;
  333. Param['EyeToLightMatrix'].AsMatrix4f := FEyeToLightMatrix;
  334. end;
  335. end;
  336. procedure TFormActorms3d.GLSLShader1Initialize(Shader: TGLCustomGLSLShader);
  337. begin
  338. with Shader, MatLib do
  339. begin
  340. Param['TextureMap'].AsTexture2D[0] := TextureByName('floor_parquet');
  341. Param['ShadowMap'].AsTexture2D[1] := TextureByName(GLFrameBuffer.DepthTextureName);
  342. Param['LightspotMap'].AsTexture2D[2] := TextureByName('Lightspot');
  343. end;
  344. end;
  345. procedure TFormActorms3d.SetAppPath(const Value: string);
  346. begin
  347. FAppPath := Value;
  348. end;
  349. procedure TFormActorms3d.Timer1Timer(Sender: TObject);
  350. begin
  351. aniPos.Position := Actor1.CurrentFrame - Actor1.Animations[aniBox.ItemIndex + 1].StartFrame;
  352. end;
  353. end.