GLFBORenderer.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917
  1. //
  2. // This unit is part of the GLScene Engine, http://glscene.org
  3. //
  4. unit GLFBORenderer;
  5. (* Implements FBO support *)
  6. interface
  7. {$I GLScene.inc}
  8. uses
  9. Winapi.OpenGL,
  10. Winapi.OpenGLext,
  11. System.Classes,
  12. System.SysUtils,
  13. OpenGLTokens,
  14. GLVectorGeometry,
  15. GLPersistentClasses,
  16. GLPipelineTransformation,
  17. GLScene,
  18. GLTexture,
  19. GLContext,
  20. GLColor,
  21. GLMaterial,
  22. GLRenderContextInfo,
  23. GLState,
  24. GLTextureFormat,
  25. GLVectorTypes,
  26. GLMultisampleImage,
  27. GLFBO,
  28. GLS.Logger;
  29. type
  30. TGLEnabledRenderBuffer = (erbDepth, erbStencil);
  31. TGLEnabledRenderBuffers = set of TGLEnabledRenderBuffer;
  32. TGLFBOTargetVisibility = (tvDefault, tvFBOOnly);
  33. TGLFBOClearOption = (coColorBufferClear, coDepthBufferClear,
  34. coStencilBufferClear, coUseBufferBackground);
  35. TGLFBOClearOptions = set of TGLFBOClearOption;
  36. TGLTextureArray = array of TGLTexture;
  37. TSetTextureTargetsEvent = procedure(Sender : TObject;
  38. var colorTexs : TGLTextureArray) of object;
  39. TGLFBORenderer = class(TGLBaseSceneObject, IGLMaterialLibrarySupported)
  40. private
  41. FFbo: TGLFrameBuffer;
  42. FDepthRBO: TGLDepthRBO;
  43. FStencilRBO: TGLStencilRBO;
  44. FColorAttachment: Integer;
  45. FRendering: Boolean;
  46. FHasColor: Boolean;
  47. FHasDepth: Boolean;
  48. FHasStencil: Boolean;
  49. FMaterialLibrary: TGLMaterialLibrary;
  50. FColorTextureName: TGLLibMaterialName;
  51. FDepthTextureName: TGLLibMaterialName;
  52. FWidth: Integer;
  53. FHeight: Integer;
  54. FForceTextureDimensions: Boolean;
  55. FStencilPrecision: TGLStencilPrecision;
  56. FRootObject: TGLBaseSceneObject;
  57. FRootVisible: Boolean;
  58. FCamera: TGLCamera;
  59. FEnabledRenderBuffers: TGLEnabledRenderBuffers;
  60. FTargetVisibility: TGLFBOTargetVisibility;
  61. FBeforeRender: TGLDirectRenderEvent;
  62. FPostInitialize: TNotifyEvent;
  63. FAfterRender: TGLDirectRenderEvent;
  64. FPreInitialize: TNotifyEvent;
  65. FBackgroundColor: TGLColor;
  66. FClearOptions: TGLFBOClearOptions;
  67. FAspect: Single;
  68. FSceneScaleFactor: Single;
  69. FUseLibraryAsMultiTarget: Boolean;
  70. FPostGenerateMipmap: Boolean;
  71. FMaxSize: Integer;
  72. FMaxAttachment: Integer;
  73. FStoreCamera: array[0..2] of TVector;
  74. FOnSetTextureTargets: TSetTextureTargetsEvent;
  75. // implementing IGLMaterialLibrarySupported
  76. function GetMaterialLibrary: TGLAbstractMaterialLibrary;
  77. procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
  78. procedure SetDepthTextureName(const Value: TGLLibMaterialName);
  79. procedure SetColorTextureName(const Value: TGLLibMaterialName);
  80. procedure SetForceTextureDimentions(const Value: Boolean);
  81. procedure SetHeight(Value: Integer);
  82. procedure SetWidth(Value: Integer);
  83. procedure SetLayer(const Value: Integer);
  84. function GetLayer: Integer;
  85. procedure SetLevel(const Value: Integer);
  86. function GetLevel: Integer;
  87. procedure SetStencilPrecision(const Value: TGLStencilPrecision);
  88. procedure SetRootObject(const Value: TGLBaseSceneObject);
  89. function GetViewport: TRectangle;
  90. procedure SetCamera(const Value: TGLCamera);
  91. procedure SetEnabledRenderBuffers(const Value: TGLEnabledRenderBuffers);
  92. procedure SetTargetVisibility(const Value: TGLFBOTargetVisibility);
  93. procedure SetBackgroundColor(const Value: TGLColor);
  94. function StoreSceneScaleFactor: Boolean;
  95. function StoreAspect: Boolean;
  96. procedure SetUseLibraryAsMultiTarget(Value: Boolean);
  97. procedure SetPostGenerateMipmap(const Value: Boolean);
  98. protected
  99. procedure Notification(AComponent: TComponent;
  100. Operation: TOperation); override;
  101. procedure Initialize;
  102. procedure ForceDimensions(Texture: TGLTexture);
  103. procedure RenderToFBO(var ARci: TGLRenderContextInfo);
  104. procedure ApplyCamera(var ARci: TGLRenderContextInfo);
  105. procedure UnApplyCamera(var ARci: TGLRenderContextInfo);
  106. procedure DoBeforeRender(var ARci: TGLRenderContextInfo);
  107. procedure DoAfterRender(var ARci: TGLRenderContextInfo);
  108. procedure DoPreInitialize;
  109. procedure DoPostInitialize;
  110. property HasColor: Boolean read FHasColor;
  111. property HasDepth: Boolean read FHasDepth;
  112. property HasStencil: Boolean read FHasStencil;
  113. property Viewport: TRectangle read GetViewport;
  114. public
  115. constructor Create(AOwner: TComponent); override;
  116. destructor Destroy; override;
  117. procedure DoRender(var ARci: TGLRenderContextInfo; ARenderSelf: Boolean;
  118. ARenderChildren: Boolean); override;
  119. (* Layer (also cube map face) is activated only on
  120. the volume textures, texture array and cube map.
  121. You can select the layer during the drawing to. *)
  122. property Layer: Integer read GetLayer write SetLayer;
  123. // Mipmap Level where will be rendering
  124. property Level: Integer read GetLevel write SetLevel;
  125. published
  126. property Active: Boolean read GetVisible write SetVisible default True;
  127. property PickableTarget: Boolean read GetPickable write SetPickable default False;
  128. (* Force texture dimensions when initializing
  129. only works with TGLBlankImage and TGLFloatDataImage, otherwise does nothing *)
  130. property ForceTextureDimensions: Boolean read FForceTextureDimensions
  131. write SetForceTextureDimentions default True;
  132. property Width: Integer read FWidth write SetWidth default 256;
  133. property Height: Integer read FHeight write SetHeight default 256;
  134. property Aspect: Single read FAspect write FAspect stored StoreAspect;
  135. property ColorTextureName: TGLLibMaterialName read FColorTextureName
  136. write SetColorTextureName;
  137. property DepthTextureName: TGLLibMaterialName read FDepthTextureName
  138. write SetDepthTextureName;
  139. property MaterialLibrary: TGLAbstractMaterialLibrary read GetMaterialLibrary
  140. write SetMaterialLibrary;
  141. property BackgroundColor: TGLColor read FBackgroundColor write SetBackgroundColor;
  142. property ClearOptions: TGLFBOClearOptions read FClearOptions
  143. write FClearOptions;
  144. (* Camera used for rendering to the FBO
  145. if not assigned, use the active view's camera *)
  146. property Camera: TGLCamera read FCamera write SetCamera;
  147. (* Adjust the scene scale of the camera so that the rendering
  148. becomes independent of the width of the fbo renderer
  149. 0 = disabled *)
  150. property SceneScaleFactor: Single read FSceneScaleFactor
  151. write FSceneScaleFactor stored StoreSceneScaleFactor;
  152. (* Root object used when rendering to the FBO
  153. if not assigned, uses itself as root and renders the child objects to the FBO *)
  154. property RootObject: TGLBaseSceneObject read FRootObject
  155. write SetRootObject;
  156. (* Determines if target is rendered to FBO only or rendered normally
  157. in FBO only mode, if RootObject is assigned, the RootObject's Visible flag is modified
  158. in default mode, if RootObject is not assigned, children are rendered normally after being
  159. rendered to the FBO *)
  160. property TargetVisibility: TGLFBOTargetVisibility read FTargetVisibility
  161. write SetTargetVisibility default tvDefault;
  162. // Enables the use of a render buffer if a texture is not assigned
  163. property EnabledRenderBuffers: TGLEnabledRenderBuffers
  164. read FEnabledRenderBuffers write SetEnabledRenderBuffers;
  165. // use stencil buffer
  166. property StencilPrecision: TGLStencilPrecision read FStencilPrecision
  167. write SetStencilPrecision default spDefault;
  168. // called before rendering to the FBO
  169. property BeforeRender: TGLDirectRenderEvent read FBeforeRender write FBeforeRender;
  170. // called after the rendering to the FBO
  171. property AfterRender: TGLDirectRenderEvent read FAfterRender write FAfterRender;
  172. (* Called before the FBO is initialized
  173. the FBO is bound before calling this event *)
  174. property PreInitialize: TNotifyEvent read FPreInitialize write FPreInitialize;
  175. (* Called after the FBO is initialized, but before any rendering
  176. the FBO is bound before calling this event *)
  177. property PostInitialize: TNotifyEvent read FPostInitialize write FPostInitialize;
  178. property UseLibraryAsMultiTarget: Boolean read FUseLibraryAsMultiTarget
  179. write SetUseLibraryAsMultiTarget default False;
  180. (* Control mipmap generation after rendering
  181. texture must have MinFilter with mipmaping *)
  182. property PostGenerateMipmap: Boolean read FPostGenerateMipmap
  183. write SetPostGenerateMipmap default True;
  184. (* Allows multiTargeting to different texture sources instead of all coming
  185. from one single MatLib with UseLibraryAsMultiTarget. OnSetTextureTargets
  186. overrides the other method of setting target textures via the MaterialLibrary,
  187. ColorTextureName and DepthTextureName propertes *)
  188. property OnSetTextureTargets: TSetTextureTargetsEvent read FOnSetTextureTargets
  189. write FOnSetTextureTargets;
  190. end;
  191. //======================================================================
  192. implementation
  193. //======================================================================
  194. //
  195. // TGLFBORenderer
  196. //
  197. procedure TGLFBORenderer.ApplyCamera(var ARci: TGLRenderContextInfo);
  198. var
  199. sc: Single;
  200. begin
  201. with ARci.PipelineTransformation do
  202. begin
  203. Push;
  204. if Assigned(Camera) then
  205. begin
  206. FStoreCamera[0] := ARci.cameraPosition;
  207. FStoreCamera[1] := ARci.cameraDirection;
  208. FStoreCamera[2] := ARci.cameraUp;
  209. IdentityAll;
  210. sc := FCamera.SceneScale;
  211. if FSceneScaleFactor > 0 then
  212. FCamera.SceneScale := Width / FSceneScaleFactor;
  213. FCamera.ApplyPerspective(Viewport, Width, Height, 96);
  214. // 96 is default dpi
  215. FCamera.SceneScale := sc;
  216. SetViewMatrix(CreateScaleMatrix(Vector3fMake(1.0 / FAspect, 1.0, 1.0)));
  217. FCamera.Apply;
  218. end
  219. else
  220. begin
  221. SetViewMatrix(MatrixMultiply(ViewMatrix^,
  222. CreateScaleMatrix(Vector3fMake(1.0 / FAspect, 1.0, 1.0))));
  223. end;
  224. end;
  225. end;
  226. procedure TGLFBORenderer.UnApplyCamera(var ARci: TGLRenderContextInfo);
  227. begin
  228. ARci.cameraPosition := FStoreCamera[0];
  229. ARci.cameraDirection := FStoreCamera[1];
  230. ARci.cameraUp := FStoreCamera[2];
  231. ARci.PipelineTransformation.Pop;
  232. end;
  233. constructor TGLFBORenderer.Create(AOwner: TComponent);
  234. begin
  235. inherited;
  236. ObjectStyle := [osDirectDraw, osNoVisibilityCulling];
  237. FFbo := TGLFrameBuffer.Create;
  238. FBackgroundColor := TGLColor.Create(Self);
  239. FUseLibraryAsMultiTarget := False;
  240. FForceTextureDimensions := True;
  241. FWidth := 256;
  242. FHeight := 256;
  243. FEnabledRenderBuffers := [erbDepth];
  244. FClearOptions := [coColorBufferClear, coDepthBufferClear,
  245. coStencilBufferClear, coUseBufferBackground];
  246. PickableTarget := False;
  247. FAspect := 1.0;
  248. FSceneScaleFactor := 0.0;
  249. FPostGenerateMipmap := True;
  250. StructureChanged;
  251. end;
  252. destructor TGLFBORenderer.Destroy;
  253. begin
  254. FFbo.Free;
  255. FDepthRBO.Free;
  256. FStencilRBO.Free;
  257. FBackgroundColor.Free;
  258. inherited;
  259. end;
  260. procedure TGLFBORenderer.Notification(AComponent: TComponent;
  261. Operation: TOperation);
  262. begin
  263. inherited;
  264. if (AComponent = FRootObject) and (Operation = opRemove) then
  265. FRootObject := nil;
  266. end;
  267. procedure TGLFBORenderer.DoAfterRender(var ARci: TGLRenderContextInfo);
  268. begin
  269. if Assigned(FAfterRender) then
  270. FAfterRender(Self, ARci);
  271. end;
  272. procedure TGLFBORenderer.DoBeforeRender(var ARci: TGLRenderContextInfo);
  273. begin
  274. if Assigned(FBeforeRender) then
  275. FBeforeRender(Self, ARci);
  276. end;
  277. procedure TGLFBORenderer.DoPostInitialize;
  278. begin
  279. if Assigned(FPostInitialize) then
  280. FPostInitialize(Self);
  281. end;
  282. procedure TGLFBORenderer.DoPreInitialize;
  283. begin
  284. if Assigned(FPreInitialize) then
  285. FPreInitialize(Self);
  286. end;
  287. procedure TGLFBORenderer.DoRender(var ARci: TGLRenderContextInfo;
  288. ARenderSelf, ARenderChildren: Boolean);
  289. begin
  290. if not (csDesigning in ComponentState) then
  291. RenderToFBO(ARci);
  292. if (not Assigned(FRootObject)) and (TargetVisibility = tvDefault) and ARenderChildren
  293. then
  294. RenderChildren(0, Count - 1, ARci);
  295. end;
  296. procedure TGLFBORenderer.ForceDimensions(Texture: TGLTexture);
  297. var
  298. bi: TGLBlankImage;
  299. mi: TGLMultisampleImage;
  300. begin
  301. if Texture.Image is TGLBlankImage then
  302. begin
  303. bi := TGLBlankImage(Texture.Image);
  304. bi.Width := Width;
  305. bi.Height := Height;
  306. end
  307. else if Texture.Image is TGLMultisampleImage then
  308. begin
  309. mi := TGLMultisampleImage(Texture.Image);
  310. mi.Width := Width;
  311. mi.Height := Height;
  312. end;
  313. end;
  314. function TGLFBORenderer.GetViewport: TRectangle;
  315. begin
  316. Result.Left := 0;
  317. Result.Top := 0;
  318. Result.Width := Width;
  319. Result.Height := Height;
  320. end;
  321. procedure TGLFBORenderer.Initialize;
  322. procedure AddOneMultiTarget(colorTex: TGLTexture);
  323. begin
  324. if ForceTextureDimensions then
  325. ForceDimensions(colorTex);
  326. if FColorAttachment >= FMaxAttachment then
  327. begin
  328. GLSLogger.LogError
  329. ('Number of color attachments out of GL_MAX_COLOR_ATTACHMENTS');
  330. Visible := False;
  331. Abort;
  332. end;
  333. FFbo.AttachTexture(FColorAttachment, colorTex);
  334. Inc(FColorAttachment);
  335. end;
  336. const
  337. cDrawBuffers: array [0 .. 15] of Cardinal = (GL_COLOR_ATTACHMENT0,
  338. GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2,
  339. GL_COLOR_ATTACHMENT3, GL_COLOR_ATTACHMENT4,
  340. GL_COLOR_ATTACHMENT5, GL_COLOR_ATTACHMENT6,
  341. GL_COLOR_ATTACHMENT7, GL_COLOR_ATTACHMENT8,
  342. GL_COLOR_ATTACHMENT9, GL_COLOR_ATTACHMENT10,
  343. GL_COLOR_ATTACHMENT11, GL_COLOR_ATTACHMENT12,
  344. GL_COLOR_ATTACHMENT13, GL_COLOR_ATTACHMENT14,
  345. GL_COLOR_ATTACHMENT15);
  346. var
  347. colorTex: TGLTexture;
  348. depthTex: TGLTexture;
  349. I: Integer;
  350. MulTexture : TGLTextureArray;
  351. begin
  352. for I := 0 to MaxColorAttachments - 1 do
  353. FFbo.DetachTexture(I);
  354. if FMaxSize = 0 then
  355. gl.GetIntegerv(GL_MAX_RENDERBUFFER_SIZE, @FMaxSize);
  356. if Width > FMaxSize then
  357. begin
  358. FWidth := FMaxSize;
  359. GLSLogger.LogWarningFmt('%s.Width out of GL_MAX_RENDERBUFFER_SIZE', [Name]);
  360. end;
  361. if Height > FMaxSize then
  362. begin
  363. FHeight := FMaxSize;
  364. GLSLogger.LogWarningFmt('%s.Height out of GL_MAX_RENDERBUFFER_SIZE', [Name]);
  365. end;
  366. FFbo.Width := Width;
  367. FFbo.Height := Height;
  368. FFbo.Bind;
  369. DoPreInitialize;
  370. FFbo.Unbind;
  371. if Assigned(FMaterialLibrary) then
  372. begin
  373. colorTex := FMaterialLibrary.TextureByName(ColorTextureName);
  374. depthTex := FMaterialLibrary.TextureByName(DepthTextureName);
  375. end
  376. else
  377. begin
  378. colorTex := nil;
  379. depthTex := nil;
  380. end;
  381. FHasColor := False;
  382. FHasDepth := False;
  383. FHasStencil := False;
  384. FColorAttachment := 0;
  385. if FUseLibraryAsMultiTarget or Assigned(FOnSetTextureTargets) then
  386. begin
  387. if not(gl.ARB_draw_buffers or gl.ATI_draw_buffers) then
  388. begin
  389. GLSLogger.LogError('Hardware do not support MRT');
  390. Active := False;
  391. exit;
  392. end;
  393. if FMaxAttachment = 0 then
  394. gl.GetIntegerv(GL_MAX_COLOR_ATTACHMENTS, @FMaxAttachment);
  395. if Assigned(FOnSetTextureTargets) then
  396. begin
  397. FOnSetTextureTargets(Self, MulTexture);
  398. for I := 0 to High(MulTexture) do
  399. begin
  400. colorTex := MulTexture[i];
  401. // Skip depth texture
  402. if colorTex = depthTex then
  403. Continue;
  404. AddOneMultiTarget(colorTex);
  405. end;
  406. end
  407. else
  408. // Multicolor attachments
  409. for I := 0 to FMaterialLibrary.Materials.Count - 1 do
  410. begin
  411. colorTex := FMaterialLibrary.Materials[I].Material.Texture;
  412. // Skip depth texture
  413. if colorTex = depthTex then
  414. Continue;
  415. AddOneMultiTarget(colorTex);
  416. end;
  417. FHasColor := FColorAttachment > 0;
  418. end
  419. else
  420. begin
  421. // One color attachment
  422. if Assigned(colorTex) then
  423. begin
  424. if ForceTextureDimensions then
  425. ForceDimensions(colorTex);
  426. FFbo.AttachTexture(0, colorTex);
  427. Inc(FColorAttachment);
  428. FHasColor := True;
  429. end;
  430. end;
  431. if Assigned(depthTex) then
  432. begin
  433. if ForceTextureDimensions then
  434. ForceDimensions(depthTex);
  435. FFbo.AttachDepthTexture(depthTex);
  436. FDepthRBO.Free;
  437. FDepthRBO := nil;
  438. FHasDepth := True;
  439. FHasStencil := depthTex.TextureFormatEx = tfDEPTH24_STENCIL8;
  440. end
  441. else if erbDepth in EnabledRenderBuffers then
  442. begin
  443. if not Assigned(FDepthRBO) then
  444. FDepthRBO := TGLDepthRBO.Create;
  445. FDepthRBO.Width := Width;
  446. FDepthRBO.Height := Height;
  447. FFbo.AttachDepthBuffer(FDepthRBO);
  448. FHasDepth := True;
  449. end
  450. else
  451. begin
  452. FFbo.DetachDepthBuffer;
  453. if Assigned(FDepthRBO) then
  454. begin
  455. FDepthRBO.Free;
  456. FDepthRBO := nil;
  457. end;
  458. end;
  459. if erbStencil in EnabledRenderBuffers then
  460. begin
  461. if not Assigned(FStencilRBO) then
  462. FStencilRBO := TGLStencilRBO.Create;
  463. FStencilRBO.StencilPrecision := FStencilPrecision;
  464. FStencilRBO.Width := Width;
  465. FStencilRBO.Height := Height;
  466. FFbo.AttachStencilBuffer(FStencilRBO);
  467. FHasStencil := True;
  468. end
  469. else
  470. begin
  471. if not FHasStencil then
  472. FFbo.DetachStencilBuffer;
  473. if Assigned(FStencilRBO) then
  474. begin
  475. FStencilRBO.Free;
  476. FStencilRBO := nil;
  477. end;
  478. end;
  479. FFbo.Bind;
  480. if FColorAttachment = 0 then
  481. begin
  482. gl.DrawBuffer(GL_NONE);
  483. gl.ReadBuffer(GL_NONE);
  484. end
  485. else
  486. gl.DrawBuffers(FColorAttachment, @cDrawBuffers);
  487. DoPostInitialize;
  488. FFbo.Unbind;
  489. gl.CheckError;
  490. ClearStructureChanged;
  491. end;
  492. procedure TGLFBORenderer.RenderToFBO(var ARci: TGLRenderContextInfo);
  493. function GetClearBits: cardinal;
  494. begin
  495. Result := 0;
  496. if HasColor and (coColorBufferClear in FClearOptions) then
  497. Result := Result or GL_COLOR_BUFFER_BIT;
  498. if HasDepth and (coDepthBufferClear in FClearOptions) then
  499. Result := Result or GL_DEPTH_BUFFER_BIT;
  500. if HasStencil and (coStencilBufferClear in FClearOptions) then
  501. Result := Result or GL_STENCIL_BUFFER_BIT;
  502. end;
  503. type
  504. TGLStoredStates = record
  505. ColorClearValue: TColorVector;
  506. ColorWriteMask: TGLColorMask;
  507. Tests: TGLStates;
  508. end;
  509. function StoreStates: TGLStoredStates;
  510. begin
  511. Result.ColorClearValue := ARci.GLStates.ColorClearValue;
  512. Result.ColorWriteMask := ARci.GLStates.ColorWriteMask[0];
  513. Result.Tests := [stDepthTest, stStencilTest] * ARci.GLStates.States;
  514. end;
  515. procedure RestoreStates(const aStates: TGLStoredStates);
  516. begin
  517. ARci.GLStates.ColorClearValue := aStates.ColorClearValue;
  518. ARci.GLStates.SetColorMask(aStates.ColorWriteMask);
  519. if stDepthTest in aStates.Tests then
  520. ARci.GLStates.Enable(stDepthTest)
  521. else
  522. ARci.GLStates.Disable(stDepthTest);
  523. if stStencilTest in aStates.Tests then
  524. ARci.GLStates.Enable(stStencilTest)
  525. else
  526. ARci.GLStates.Disable(stStencilTest);
  527. end;
  528. var
  529. backColor: TColorVector;
  530. buffer: TGLSceneBuffer;
  531. savedStates: TGLStoredStates;
  532. w, h: Integer;
  533. s: string;
  534. begin
  535. if (ARci.drawState = dsPicking) and not PickableTarget then
  536. Exit;
  537. if not TGLFramebufferHandle.IsSupported then
  538. begin
  539. GLSLogger.LogError('Framebuffer not supported - deactivated');
  540. Active := False;
  541. Exit;
  542. end;
  543. // prevent recursion
  544. if FRendering then
  545. Exit;
  546. FRendering := True;
  547. if (ocStructure in Changes) or Assigned(FOnSetTextureTargets) then
  548. begin
  549. Initialize;
  550. if not Active then
  551. Exit;
  552. end;
  553. ApplyCamera(ARci);
  554. try
  555. savedStates := StoreStates;
  556. FFbo.Bind;
  557. if FFbo.GetStringStatus(s) <> fsComplete then
  558. begin
  559. GLSLogger.LogErrorFmt('Framebuffer error: %s. Deactivated', [s]);
  560. Active := False;
  561. Exit;
  562. end;
  563. DoBeforeRender(ARci);
  564. if Assigned(Camera) then
  565. Camera.Scene.SetupLights(ARci.GLStates.MaxLights);
  566. w := Width;
  567. h := Height;
  568. if FFbo.Level > 0 then
  569. begin
  570. w := w shr FFbo.Level;
  571. h := h shr FFbo.Level;
  572. if w = 0 then
  573. w := 1;
  574. if h = 0 then
  575. h := 1;
  576. end;
  577. ARci.GLStates.Viewport := Vector4iMake(0, 0, w, h);
  578. buffer := ARci.buffer as TGLSceneBuffer;
  579. if HasColor then
  580. ARci.GLStates.SetColorMask(cAllColorComponents)
  581. else
  582. ARci.GLStates.SetColorMask([]);
  583. ARci.GLStates.DepthWriteMask := HasDepth;
  584. if HasStencil then
  585. ARci.GLStates.Enable(stStencilTest)
  586. else
  587. ARci.GLStates.Disable(stStencilTest);
  588. if coUseBufferBackground in FClearOptions then
  589. begin
  590. backColor := ConvertWinColor(buffer.BackgroundColor);
  591. backColor.W := buffer.BackgroundAlpha;
  592. ARci.GLStates.ColorClearValue := backColor;
  593. end
  594. else
  595. begin
  596. ARci.GLStates.ColorClearValue := FBackgroundColor.Color;
  597. end;
  598. gl.Clear(GetClearBits);
  599. FFbo.PreRender;
  600. // render to fbo
  601. if Assigned(RootObject) then
  602. begin
  603. // if object should only be rendered to the fbo
  604. // ensure it's visible before rendering to fbo
  605. if TargetVisibility = tvFBOOnly then
  606. RootObject.Visible := True;
  607. RootObject.Render(ARci);
  608. // then make it invisible afterwards
  609. if TargetVisibility = tvFBOOnly then
  610. RootObject.Visible := False;
  611. end
  612. else if (Count > 0) then
  613. RenderChildren(0, Count - 1, ARci);
  614. FFbo.PostRender(FPostGenerateMipmap);
  615. RestoreStates(savedStates);
  616. ARci.GLStates.Viewport := Vector4iMake(0, 0, ARci.viewPortSize.cx,
  617. ARci.viewPortSize.cy);
  618. finally
  619. FFbo.Unbind;
  620. FRendering := False;
  621. DoAfterRender(ARci);
  622. UnApplyCamera(ARci);
  623. if Assigned(Camera) then
  624. Camera.Scene.SetupLights(ARci.GLStates.MaxLights);
  625. end;
  626. end;
  627. procedure TGLFBORenderer.SetBackgroundColor(const Value: TGLColor);
  628. begin
  629. FBackgroundColor.Assign(Value);
  630. end;
  631. procedure TGLFBORenderer.SetCamera(const Value: TGLCamera);
  632. begin
  633. if FCamera <> Value then
  634. begin
  635. FCamera := Value;
  636. StructureChanged;
  637. end;
  638. end;
  639. procedure TGLFBORenderer.SetColorTextureName(const Value: TGLLibMaterialName);
  640. begin
  641. if FColorTextureName <> Value then
  642. begin
  643. FColorTextureName := Value;
  644. StructureChanged;
  645. end;
  646. end;
  647. procedure TGLFBORenderer.SetDepthTextureName(const Value: TGLLibMaterialName);
  648. begin
  649. if FDepthTextureName <> Value then
  650. begin
  651. FDepthTextureName := Value;
  652. StructureChanged;
  653. end;
  654. end;
  655. procedure TGLFBORenderer.SetEnabledRenderBuffers(const Value
  656. : TGLEnabledRenderBuffers);
  657. begin
  658. if FEnabledRenderBuffers <> Value then
  659. begin
  660. FEnabledRenderBuffers := Value;
  661. StructureChanged;
  662. end;
  663. end;
  664. procedure TGLFBORenderer.SetForceTextureDimentions(const Value: Boolean);
  665. begin
  666. if FForceTextureDimensions <> Value then
  667. begin
  668. FForceTextureDimensions := Value;
  669. StructureChanged;
  670. end;
  671. end;
  672. function TGLFBORenderer.GetMaterialLibrary: TGLAbstractMaterialLibrary;
  673. begin
  674. Result := FMaterialLibrary;
  675. end;
  676. procedure TGLFBORenderer.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
  677. begin
  678. if FMaterialLibrary <> Value then
  679. begin
  680. if Value is TGLMaterialLibrary then
  681. begin
  682. FMaterialLibrary := TGLMaterialLibrary(Value);
  683. StructureChanged;
  684. end;
  685. end;
  686. end;
  687. procedure TGLFBORenderer.SetUseLibraryAsMultiTarget(Value: Boolean);
  688. begin
  689. if FUseLibraryAsMultiTarget <> Value then
  690. begin
  691. FUseLibraryAsMultiTarget := Value;
  692. StructureChanged;
  693. end;
  694. end;
  695. procedure TGLFBORenderer.SetPostGenerateMipmap(const Value: Boolean);
  696. begin
  697. if FPostGenerateMipmap <> Value then
  698. FPostGenerateMipmap := Value;
  699. end;
  700. procedure TGLFBORenderer.SetRootObject(const Value: TGLBaseSceneObject);
  701. begin
  702. if FRootObject <> Value then
  703. begin
  704. if Assigned(FRootObject) then
  705. FRootObject.RemoveFreeNotification(Self);
  706. FRootObject := Value;
  707. if Assigned(FRootObject) then
  708. FRootObject.FreeNotification(Self);
  709. StructureChanged;
  710. end;
  711. end;
  712. procedure TGLFBORenderer.SetStencilPrecision(const Value: TGLStencilPrecision);
  713. begin
  714. if FStencilPrecision <> Value then
  715. begin
  716. FStencilPrecision := Value;
  717. StructureChanged;
  718. end;
  719. end;
  720. procedure TGLFBORenderer.SetTargetVisibility(const Value
  721. : TGLFBOTargetVisibility);
  722. begin
  723. if FTargetVisibility <> Value then
  724. begin
  725. if Assigned(RootObject) then
  726. begin
  727. if (TargetVisibility = tvFBOOnly) then
  728. begin
  729. // we went from fbo only, restore root's old visibility
  730. RootObject.Visible := FRootVisible;
  731. end
  732. else
  733. begin
  734. // we're going to fbo only, save root visibility for later
  735. FRootVisible := RootObject.Visible;
  736. end;
  737. end;
  738. FTargetVisibility := Value;
  739. StructureChanged;
  740. end;
  741. end;
  742. function TGLFBORenderer.StoreSceneScaleFactor: Boolean;
  743. begin
  744. Result := (FSceneScaleFactor <> 0.0);
  745. end;
  746. function TGLFBORenderer.StoreAspect: Boolean;
  747. begin
  748. Result := (FAspect <> 1.0);
  749. end;
  750. procedure TGLFBORenderer.SetWidth(Value: Integer);
  751. begin
  752. if FWidth <> Value then
  753. begin
  754. FWidth := Value;
  755. StructureChanged;
  756. end;
  757. end;
  758. procedure TGLFBORenderer.SetHeight(Value: Integer);
  759. begin
  760. if FHeight <> Value then
  761. begin
  762. FHeight := Value;
  763. StructureChanged;
  764. end;
  765. end;
  766. procedure TGLFBORenderer.SetLayer(const Value: Integer);
  767. begin
  768. if Value <> FFbo.Layer then
  769. begin
  770. if FRendering or (ocStructure in Changes) then
  771. FFbo.Layer := Value
  772. else
  773. begin
  774. FFbo.Bind;
  775. FFbo.Layer := Value;
  776. FFbo.Unbind;
  777. end;
  778. end;
  779. end;
  780. function TGLFBORenderer.GetLayer: Integer;
  781. begin
  782. Result := FFbo.Layer;
  783. end;
  784. procedure TGLFBORenderer.SetLevel(const Value: Integer);
  785. var
  786. w, h: Integer;
  787. begin
  788. if Value <> FFbo.Level then
  789. begin
  790. if FRendering or (ocStructure in Changes) then
  791. begin
  792. FFbo.Level := Value;
  793. w := Width;
  794. h := Height;
  795. if FFbo.Level > 0 then
  796. begin
  797. w := w shr FFbo.Level;
  798. h := h shr FFbo.Level;
  799. if w = 0 then
  800. w := 1;
  801. if h = 0 then
  802. h := 1;
  803. CurrentGLContext.GLStates.Viewport := Vector4iMake(0, 0, w, h);
  804. end;
  805. end
  806. else
  807. begin
  808. FFbo.Bind;
  809. FFbo.Level := Value;
  810. FFbo.Unbind;
  811. end;
  812. end;
  813. end;
  814. function TGLFBORenderer.GetLevel: Integer;
  815. begin
  816. Result := FFbo.Level;
  817. end;
  818. //-------------------------------------------------
  819. initialization
  820. //-------------------------------------------------
  821. RegisterClasses([TGLFBORenderer]);
  822. end.