BasicSDLFm.pas 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111
  1. unit BasicSDLFm;
  2. interface
  3. uses
  4. System.SysUtils,
  5. System.Classes,
  6. Vcl.Forms,
  7. Vcl.Dialogs,
  8. GLS.Scene,
  9. GLS.Objects,
  10. GLS.GeomObjects,
  11. GLS.Coordinates,
  12. GLS.BaseClasses,
  13. GLS.Color,
  14. GLS.Context,
  15. GLS.Texture,
  16. GLS.Utils,
  17. GLS.SDLContext,
  18. Imports.SDL2;
  19. type
  20. TDataModule1 = class(TDataModule)
  21. GLScene1: TGLScene;
  22. GLSDLViewer1: TSDLViewer;
  23. GLCamera1: TGLCamera;
  24. GLLightSource1: TGLLightSource;
  25. Teapot1: TGLTeapot;
  26. procedure DataModuleCreate(Sender: TObject);
  27. procedure GLSDLViewer1EventPollDone(Sender: TObject);
  28. procedure GLSDLViewer1Resize(Sender: TObject);
  29. public
  30. firstPassDone: Boolean;
  31. end;
  32. var
  33. DataModule1: TDataModule1;
  34. implementation
  35. {$R *.dfm}
  36. procedure TDataModule1.DataModuleCreate(Sender: TObject);
  37. begin
  38. // When using SDL2, the standard VCL message queue is no longer operational,
  39. // so you must have/make your own loop to prevent the application from
  40. // terminating immediately
  41. GLSDLViewer1.Render;
  42. while GLSDLViewer1.Active do
  43. begin
  44. // Message queue is not operational, but there may still be some messages
  45. Application.ProcessMessages;
  46. // Relinquish some of that CPU time
  47. SDL_Delay(1);
  48. // Slowly rotate the teapot
  49. Teapot1.RollAngle := 4 * Frac(Now * 24) * 3600;
  50. end;
  51. end;
  52. procedure TDataModule1.GLSDLViewer1EventPollDone(Sender: TObject);
  53. begin
  54. SetGLSceneMediaDir();
  55. if not firstPassDone then
  56. begin
  57. // Loads a texture map for the teapot
  58. // (see materials/cubemap for details on that)
  59. // The odd bit is that it must be done upon first render, otherwise
  60. // SDL OpenGL support has not been initialized and things like checking
  61. // an extension support (cube maps here) would fail...
  62. // Something less clunky will be introduced, someday...
  63. firstPassDone := True;
  64. GLSDLViewer1.Buffer.RenderingContext.Activate;
  65. try
  66. if not GL.ARB_texture_cube_map then
  67. ShowMessage('Your graphics board does not support cube maps...'#13#10 +
  68. 'So, no cube maps for ya...')
  69. else
  70. begin
  71. with Teapot1.Material.Texture do
  72. begin
  73. ImageClassName := TGLCubeMapImage.ClassName;
  74. with Image as TGLCubeMapImage do
  75. begin
  76. Picture[cmtPX].LoadFromFile('cm_left.jpg');
  77. Picture[cmtNX].LoadFromFile('cm_right.jpg');
  78. Picture[cmtPY].LoadFromFile('cm_top.jpg');
  79. Picture[cmtNY].LoadFromFile('cm_bottom.jpg');
  80. Picture[cmtPZ].LoadFromFile('cm_back.jpg');
  81. Picture[cmtNZ].LoadFromFile('cm_front.jpg');
  82. end;
  83. MappingMode := tmmCubeMapReflection;
  84. Disabled := False;
  85. end;
  86. end;
  87. finally
  88. GLSDLViewer1.Buffer.RenderingContext.Deactivate;
  89. end;
  90. end;
  91. GLSDLViewer1.Render;
  92. end;
  93. procedure TDataModule1.GLSDLViewer1Resize(Sender: TObject);
  94. begin
  95. // Zoom if SDL window gets smaller/bigger
  96. GLCamera1.SceneScale := GLSDLViewer1.Width / 160;
  97. end;
  98. end.