GLS.LensFlare.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859
  1. //
  2. // The graphics engine GLScene https://github.com/glscene
  3. //
  4. unit GLS.LensFlare;
  5. (* Lens flare object. *)
  6. interface
  7. {$I GLScene.Defines.inc}
  8. uses
  9. Winapi.OpenGL,
  10. Winapi.OpenGLext,
  11. System.Classes,
  12. System.SysUtils,
  13. System.Math,
  14. GLScene.OpenGLTokens,
  15. GLS.Scene,
  16. GLS.PersistentClasses,
  17. GLS.PipelineTransformation,
  18. GLScene.VectorGeometry,
  19. GLS.Objects,
  20. GLS.Context,
  21. GLS.Color,
  22. GLS.BaseClasses,
  23. GLS.RenderContextInfo,
  24. GLS.State,
  25. GLScene.VectorTypes,
  26. GLScene.Utils,
  27. GLS.TextureFormat;
  28. type
  29. TGLFlareElement = (feGlow, feRing, feStreaks, feRays, feSecondaries);
  30. TGLFlareElements = set of TGLFlareElement;
  31. (* The actual gradients between two colors are, of course, calculated by OpenGL.
  32. The start and end colors of a gradient are stored to represent the color of
  33. lens flare elements. *)
  34. TGLFlareGradient = class(TGLUpdateAbleObject)
  35. private
  36. FFromColor: TGLColor;
  37. FToColor: TGLColor;
  38. protected
  39. procedure SetFromColor(const val: TGLColor);
  40. procedure SetToColor(const val: TGLColor);
  41. public
  42. constructor Create(AOwner: TPersistent); override;
  43. constructor CreateInitialized(AOwner: TPersistent;
  44. const fromColor, toColor: TGLColorVector);
  45. destructor Destroy; override;
  46. procedure Assign(Source: TPersistent); override;
  47. published
  48. property FromColor: TGLColor read FFromColor write SetFromColor;
  49. property ToColor: TGLColor read FToColor write SetToColor;
  50. end;
  51. const
  52. cDefaultFlareElements = [feGlow, feRing, feStreaks, feRays, feSecondaries];
  53. type
  54. TGLLensFlare = class(TGLBaseSceneObject)
  55. private
  56. FSize: Integer;
  57. FDeltaTime: Single;
  58. FCurrSize: Single;
  59. FSeed: Integer;
  60. FSqueeze: Single;
  61. FNumStreaks: Integer;
  62. FStreakWidth, FStreakAngle: Single;
  63. FNumSecs: Integer;
  64. FResolution: Integer;
  65. FAutoZTest: Boolean;
  66. FElements: TGLFlareElements;
  67. FSin20Res, FCos20Res: array of Single;
  68. FSinRes, FCosRes: array of Single;
  69. FTexRays: TGLTextureHandle;
  70. FFlareIsNotOccluded: Boolean;
  71. FOcclusionQuery: TGLOcclusionQueryHandle;
  72. FGlowGradient: TGLFlareGradient;
  73. FRingGradient: TGLFlareGradient;
  74. FStreaksGradient: TGLFlareGradient;
  75. FRaysGradient: TGLFlareGradient;
  76. FSecondariesGradient: TGLFlareGradient;
  77. FDynamic: Boolean;
  78. FPreRenderPoint: TGLRenderPoint;
  79. protected
  80. procedure SetGlowGradient(const val: TGLFlareGradient);
  81. procedure SetRingGradient(const val: TGLFlareGradient);
  82. procedure SetStreaksGradient(const val: TGLFlareGradient);
  83. procedure SetRaysGradient(const val: TGLFlareGradient);
  84. procedure SetSecondariesGradient(const val: TGLFlareGradient);
  85. procedure SetSize(aValue: Integer);
  86. procedure SetSeed(aValue: Integer);
  87. procedure SetSqueeze(aValue: Single);
  88. function StoreSqueeze: Boolean;
  89. procedure SetNumStreaks(aValue: Integer);
  90. procedure SetStreakWidth(aValue: Single);
  91. function StoreStreakWidth: Boolean;
  92. procedure SetStreakAngle(aValue: Single);
  93. procedure SetNumSecs(aValue: Integer);
  94. procedure SetResolution(aValue: Integer);
  95. procedure SetAutoZTest(aValue: Boolean);
  96. procedure SetElements(aValue: TGLFlareElements);
  97. procedure SetDynamic(aValue: Boolean);
  98. procedure SetPreRenderPoint(const val: TGLRenderPoint);
  99. procedure PreRenderEvent(Sender: TObject; var rci: TGLRenderContextInfo);
  100. procedure PreRenderPointFreed(Sender: TObject);
  101. (* These are quite unusual in that they don't use an RCI, since
  102. PreRender is done before proper rendering starts, but we do know
  103. which RC is being used, so we can use this state cache *)
  104. procedure SetupRenderingOptions(StateCache: TGLStateCache);
  105. procedure RenderRays(StateCache: TGLStateCache; const size: Single);
  106. procedure RenderStreaks(StateCache: TGLStateCache);
  107. procedure RenderRing;
  108. procedure RenderSecondaries(const posVector: TAffineVector);
  109. public
  110. constructor Create(AOwner: TComponent); override;
  111. destructor Destroy; override;
  112. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  113. procedure BuildList(var rci: TGLRenderContextInfo); override;
  114. procedure DoProgress(const progressTime: TGLProgressTimes); override;
  115. (* Prepares pre-rendered texture to speed up actual rendering.
  116. Will use the currently active context as scratch space, and will
  117. automatically do nothing if things have already been prepared,
  118. thus you can invoke it systematically in a Viewer.BeforeRender
  119. event f.i. *)
  120. procedure PreRender(activeBuffer: TGLSceneBuffer);
  121. (* Access to the Flare's current size.
  122. Flares decay or grow back over several frames, depending on their
  123. occlusion status, and this property allows to track or manually
  124. alter this instantaneous size. *)
  125. property FlareInstantaneousSize: Single read FCurrSize write FCurrSize;
  126. published
  127. property GlowGradient: TGLFlareGradient read FGlowGradient write SetGlowGradient;
  128. property RingGradient: TGLFlareGradient read FRingGradient;
  129. property StreaksGradient: TGLFlareGradient read FStreaksGradient;
  130. property RaysGradient: TGLFlareGradient read FRaysGradient;
  131. property SecondariesGradient: TGLFlareGradient read FSecondariesGradient;
  132. // MaxRadius of the flare.
  133. property Size: Integer read FSize write SetSize default 50;
  134. // Random seed
  135. property Seed: Integer read FSeed write SetSeed;
  136. // To create elliptic flares.
  137. property Squeeze: Single read FSqueeze write SetSqueeze stored StoreSqueeze;
  138. // Number of streaks.
  139. property NumStreaks: Integer read FNumStreaks write SetNumStreaks default 4;
  140. // Width of the streaks.
  141. property StreakWidth: Single read FStreakWidth write SetStreakWidth stored
  142. StoreStreakWidth;
  143. // Angle of the streaks (in degrees)
  144. property StreakAngle: Single read FStreakAngle write SetStreakAngle;
  145. // Number of secondary flares.
  146. property NumSecs: Integer read FNumSecs write SetNumSecs default 8;
  147. // Number of segments used when rendering circles.
  148. property Resolution: Integer read FResolution write SetResolution default 64;
  149. (* Automatically computes FlareIsNotOccluded depending on ZBuffer test.
  150. Not that the automated test may use test result from the previous
  151. frame into the next (to avoid a rendering stall). *)
  152. property AutoZTest: Boolean read FAutoZTest write SetAutoZTest default True;
  153. (* Is the LensFlare not occluded?.
  154. If false the flare will fade away, if true, it will fade in and stay.
  155. This value is automatically updated if AutoZTest is set. *)
  156. property FlareIsNotOccluded: Boolean read FFlareIsNotOccluded write
  157. FFlareIsNotOccluded;
  158. // Which elements should be rendered?
  159. property Elements: TGLFlareElements read FElements write SetElements default
  160. cDefaultFlareElements;
  161. (* Is the flare size adjusted dynamically?
  162. If true, the flare size will be grown and reduced over a few frames
  163. when it switches between occluded and non-occluded states. This
  164. requires animation to be active, but results in a smoother appearance.
  165. When false, flare will either be at full size or hidden.
  166. The flare is always considered non-dynamic at design-time. *)
  167. property Dynamic: Boolean read FDynamic write FDynamic default True;
  168. (* PreRender point for pre-rendered flare textures.
  169. See PreRender method for more details. *)
  170. property PreRenderPoint: TGLRenderPoint read FPreRenderPoint write
  171. SetPreRenderPoint;
  172. property ObjectsSorting;
  173. property Position;
  174. property Visible;
  175. property OnProgress;
  176. property Behaviours;
  177. property Effects;
  178. end;
  179. // ------------------------------------------------------------------
  180. implementation
  181. // ------------------------------------------------------------------
  182. // ------------------
  183. // ------------------ TGLFlareGradient ------------------
  184. // ------------------
  185. constructor TGLFlareGradient.Create(AOwner: TPersistent);
  186. begin
  187. inherited;
  188. FFromColor := TGLColor.Create(Self);
  189. FToColor := TGLColor.Create(Self);
  190. end;
  191. constructor TGLFlareGradient.CreateInitialized(AOwner: TPersistent;
  192. const fromColor, toColor: TGLColorVector);
  193. begin
  194. Create(AOwner);
  195. FFromColor.Initialize(fromColor);
  196. FToColor.Initialize(toColor);
  197. end;
  198. destructor TGLFlareGradient.Destroy;
  199. begin
  200. FToColor.Free;
  201. FFromColor.Free;
  202. inherited;
  203. end;
  204. procedure TGLFlareGradient.Assign(Source: TPersistent);
  205. begin
  206. if Source is TGLFlareGradient then
  207. begin
  208. FromColor := TGLFlareGradient(Source).FromColor;
  209. ToColor := TGLFlareGradient(Source).ToColor;
  210. end;
  211. inherited;
  212. end;
  213. procedure TGLFlareGradient.SetFromColor(const val: TGLColor);
  214. begin
  215. FFromColor.Assign(val);
  216. end;
  217. procedure TGLFlareGradient.SetToColor(const val: TGLColor);
  218. begin
  219. FToColor.Assign(val);
  220. end;
  221. // ------------------
  222. // ------------------ TGLLensFlare ------------------
  223. // ------------------
  224. constructor TGLLensFlare.Create(AOwner: TComponent);
  225. begin
  226. inherited;
  227. // Set default parameters:
  228. ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
  229. FSize := 50;
  230. FSeed := 1465;
  231. FSqueeze := 1;
  232. FNumStreaks := 4;
  233. FStreakWidth := 2;
  234. FNumSecs := 8;
  235. FAutoZTest := True;
  236. FlareIsNotOccluded := True;
  237. FDynamic := True;
  238. SetResolution(64);
  239. // Render all elements by default.
  240. FElements := [feGlow, feRing, feStreaks, feRays, feSecondaries];
  241. // Setup default gradients:
  242. FGlowGradient := TGLFlareGradient.CreateInitialized(Self,
  243. VectorMake(1, 1, 0.8, 0.3), VectorMake(1, 0.2, 0, 0));
  244. FRingGradient := TGLFlareGradient.CreateInitialized(Self,
  245. VectorMake(0.5, 0.2, 0, 0.1), VectorMake(0.5, 0.4, 0, 0.1));
  246. FStreaksGradient := TGLFlareGradient.CreateInitialized(Self,
  247. VectorMake(1, 1, 1, 0.2), VectorMake(0.2, 0, 1, 0));
  248. FRaysGradient := TGLFlareGradient.CreateInitialized(Self,
  249. VectorMake(1, 0.8, 0.5, 0.05), VectorMake(0.5, 0.2, 0, 0));
  250. FSecondariesGradient := TGLFlareGradient.CreateInitialized(Self,
  251. VectorMake(0, 0.2, 1, 0), VectorMake(0, 0.8, 0.2, 0.15));
  252. FTexRays := TGLTextureHandle.Create;
  253. end;
  254. destructor TGLLensFlare.Destroy;
  255. begin
  256. PreRenderPoint := nil;
  257. FGlowGradient.Free;
  258. FRingGradient.Free;
  259. FStreaksGradient.Free;
  260. FRaysGradient.Free;
  261. FSecondariesGradient.Free;
  262. FOcclusionQuery.Free;
  263. FTexRays.Free;
  264. inherited;
  265. end;
  266. procedure TGLLensFlare.Notification(AComponent: TComponent; Operation:
  267. TOperation);
  268. begin
  269. if (Operation = opRemove) and (AComponent = FPreRenderPoint) then
  270. PreRenderPoint := nil;
  271. inherited;
  272. end;
  273. procedure TGLLensFlare.SetupRenderingOptions(StateCache: TGLStateCache);
  274. begin
  275. StateCache.Disable(stLighting);
  276. StateCache.Disable(stDepthTest);
  277. StateCache.Disable(stFog);
  278. StateCache.Disable(stColorMaterial);
  279. StateCache.Disable(stCullFace);
  280. StateCache.DepthWriteMask := False;
  281. StateCache.Enable(stBlend);
  282. StateCache.SetBlendFunc(bfSrcAlpha, bfOne);
  283. StateCache.Disable(stAlphaTest);
  284. StateCache.PolygonMode := pmFill;
  285. end;
  286. procedure TGLLensFlare.RenderRays(StateCache: TGLStateCache; const size:
  287. Single);
  288. var
  289. i: Integer;
  290. rnd: Single;
  291. begin
  292. {$IFDEF USE_OPENGL_DEBUG}
  293. if gl.GREMEDY_string_marker then
  294. gl.StringMarkerGREMEDY(14, 'LensFlare.Rays');
  295. {$ENDIF}
  296. StateCache.LineWidth := 1;
  297. StateCache.Disable(stLineSmooth);
  298. StateCache.Disable(stLineStipple);
  299. gl.Begin_(GL_LINES);
  300. for i := 0 to Resolution * 20 - 1 do
  301. begin
  302. if (i and 1) <> 0 then
  303. rnd := 1.5 * Random * size
  304. else
  305. rnd := Random * size;
  306. gl.Color4fv(RaysGradient.FromColor.AsAddress);
  307. gl.Vertex2f(0, 0);
  308. gl.Color4fv(RaysGradient.ToColor.AsAddress);
  309. gl.Vertex2f(rnd * FCos20Res[i], rnd * FSin20Res[i] * Squeeze);
  310. end;
  311. gl.End_;
  312. end;
  313. procedure TGLLensFlare.RenderStreaks(StateCache: TGLStateCache);
  314. var
  315. i: Integer;
  316. a, f, s, c: Single;
  317. begin
  318. {$IFDEF USE_OPENGL_DEBUG}
  319. if gl.GREMEDY_string_marker then
  320. gl.StringMarkerGREMEDY(17, 'LensFlare.Streaks');
  321. {$ENDIF}
  322. StateCache.Enable(stLineSmooth);
  323. StateCache.LineWidth := StreakWidth;
  324. a := c2PI / NumStreaks;
  325. f := 1.5 * FCurrSize;
  326. gl.Begin_(GL_LINES);
  327. for i := 0 to NumStreaks - 1 do
  328. begin
  329. SinCosine(StreakAngle * cPIdiv180 + a * i, f, s, c);
  330. gl.Color4fv(StreaksGradient.FromColor.AsAddress);
  331. gl.Vertex3fv(@NullVector);
  332. gl.Color4fv(StreaksGradient.ToColor.AsAddress);
  333. gl.Vertex2f(c, Squeeze * s);
  334. end;
  335. gl.End_;
  336. StateCache.Disable(stLineSmooth);
  337. end;
  338. procedure TGLLensFlare.RenderRing;
  339. var
  340. i: Integer;
  341. rW, s0, c0, s, c: Single;
  342. begin
  343. {$IFDEF USE_OPENGL_DEBUG}
  344. if GL.GREMEDY_string_marker then
  345. GL.StringMarkerGREMEDY(14, 'LensFlare.Ring');
  346. {$ENDIF}
  347. rW := FCurrSize * (1 / 15); // Ring width
  348. gl.Begin_(GL_QUADS);
  349. s0 := 0;
  350. c0 := 0.6;
  351. for i := 0 to Resolution - 1 do
  352. begin
  353. s := s0;
  354. c := c0;
  355. s0 := FSinRes[i] * 0.6 * Squeeze;
  356. c0 := FCosRes[i] * 0.6;
  357. gl.Color4fv(GlowGradient.ToColor.AsAddress);
  358. gl.Vertex2f((FCurrSize - rW) * c, (FCurrSize - rW) * s);
  359. gl.Color4fv(RingGradient.FromColor.AsAddress);
  360. gl.Vertex2f(FCurrSize * c, Squeeze * FCurrSize * s);
  361. gl.Vertex2f(FCurrSize * c0, FCurrSize * s0);
  362. gl.Color4fv(GlowGradient.ToColor.AsAddress);
  363. gl.Vertex2f((FCurrSize - rW) * c0, (FCurrSize - rW) * s0);
  364. gl.Color4fv(RingGradient.FromColor.AsAddress);
  365. gl.Vertex2f(FCurrSize * c, FCurrSize * s);
  366. gl.Vertex2f(FCurrSize * c0, FCurrSize * s0);
  367. gl.Color4fv(GlowGradient.ToColor.AsAddress);
  368. gl.Vertex2f((FCurrSize + rW) * c0, (FCurrSize + rW) * s0);
  369. gl.Vertex2f((FCurrSize + rW) * c, (FCurrSize + rW) * s);
  370. end;
  371. gl.End_;
  372. end;
  373. procedure TGLLensFlare.RenderSecondaries(const posVector: TAffineVector);
  374. var
  375. i, j: Integer;
  376. rnd: Single;
  377. v: TAffineVector;
  378. grad: TGLFlareGradient;
  379. begin
  380. {$IFDEF USE_OPENGL_DEBUG}
  381. if GL.GREMEDY_string_marker then
  382. GL.StringMarkerGREMEDY(21, 'LensFlare.Secondaries');
  383. {$ENDIF}
  384. // Other secondaries (plain gradiented circles, like the glow):
  385. for j := 1 to NumSecs do
  386. begin
  387. rnd := 2 * Random - 1;
  388. // If rnd < 0 then the secondary glow will end up on the other side
  389. // of the origin. In this case, we can push it really far away from
  390. // the flare. If the secondary is on the flare's side, we pull it
  391. // slightly towards the origin to avoid it winding up in the middle
  392. // of the flare.
  393. if rnd < 0 then
  394. v := VectorScale(posVector, rnd)
  395. else
  396. v := VectorScale(posVector, 0.8 * rnd);
  397. if j mod 3 = 0 then
  398. grad := GlowGradient
  399. else
  400. grad := SecondariesGradient;
  401. rnd := (Random + 0.1) * FCurrSize * 0.25;
  402. gl.Begin_(GL_TRIANGLE_FAN);
  403. gl.Color4fv(grad.FromColor.AsAddress);
  404. gl.Vertex2f(v.X, v.Y);
  405. gl.Color4fv(grad.ToColor.AsAddress);
  406. for i := 0 to Resolution - 1 do
  407. gl.Vertex2f(FCosRes[i] * rnd + v.X, FSinRes[i] * rnd + v.Y);
  408. gl.End_;
  409. end;
  410. end;
  411. procedure TGLLensFlare.BuildList(var rci: TGLRenderContextInfo);
  412. var
  413. i: Integer;
  414. depth, dist: Single;
  415. posVector, v, rv: TAffineVector;
  416. screenPos: TAffineVector;
  417. flareInViewPort, dynamicSize: Boolean;
  418. oldSeed: LongInt;
  419. projMatrix: TGLMatrix;
  420. CurrentBuffer: TGLSceneBuffer;
  421. begin
  422. if (rci.drawState = dsPicking) then
  423. begin
  424. if Count <> 0 then
  425. Self.RenderChildren(0, Count - 1, rci);
  426. Exit;
  427. end;
  428. CurrentBuffer := TGLSceneBuffer(rci.buffer);
  429. SetVector(v, AbsolutePosition);
  430. // are we looking towards the flare?
  431. rv := VectorSubtract(v, PAffineVector(@rci.cameraPosition)^);
  432. if VectorDotProduct(rci.cameraDirection, rv) > 0 then
  433. begin
  434. // find out where it is on the screen.
  435. screenPos := CurrentBuffer.WorldToScreen(v);
  436. flareInViewPort := (screenPos.X < rci.viewPortSize.cx)
  437. and (screenPos.X >= 0)
  438. and (screenPos.Y < rci.viewPortSize.cy)
  439. and (screenPos.Y >= 0);
  440. end
  441. else
  442. flareInViewPort := False;
  443. dynamicSize := FDynamic and not (csDesigning in ComponentState);
  444. if dynamicSize then
  445. begin
  446. // make the glow appear/disappear progressively
  447. if flareInViewPort and FlareIsNotOccluded then
  448. begin
  449. FCurrSize := FCurrSize + FDeltaTime * 10 * Size;
  450. if FCurrSize > Size then
  451. FCurrSize := Size;
  452. end
  453. else
  454. begin
  455. FCurrSize := FCurrSize - FDeltaTime * 10 * Size;
  456. if FCurrSize < 0 then
  457. FCurrSize := 0;
  458. end;
  459. end
  460. else
  461. begin
  462. if flareInViewPort and FlareIsNotOccluded then
  463. FCurrSize := Size
  464. else
  465. FCurrSize := 0;
  466. end;
  467. // Prepare matrices
  468. gl.PushMatrix;
  469. gl.LoadMatrixf(@CurrentBuffer.BaseProjectionMatrix);
  470. gl.MatrixMode(GL_PROJECTION);
  471. gl.PushMatrix;
  472. projMatrix := IdentityHmgMatrix;
  473. projMatrix.V[0].X := 2 / rci.viewPortSize.cx;
  474. projMatrix.V[1].Y := 2 / rci.viewPortSize.cy;
  475. gl.LoadMatrixf(@projMatrix);
  476. MakeVector(posVector,
  477. screenPos.X - rci.viewPortSize.cx * 0.5,
  478. screenPos.Y - rci.viewPortSize.cy * 0.5,
  479. 0);
  480. if AutoZTest then
  481. begin
  482. if (dynamicSize and (GL.HP_occlusion_test or
  483. TGLOcclusionQueryHandle.IsSupported)) then
  484. begin
  485. // hardware-based occlusion test is possible
  486. FlareIsNotOccluded := True;
  487. rci.GLStates.SetColorMask([]);
  488. rci.GLStates.Disable(stAlphaTest);
  489. rci.GLStates.DepthWriteMask := False;
  490. rci.GLStates.Enable(stDepthTest);
  491. rci.GLStates.DepthFunc := cfLEqual;
  492. if TGLOcclusionQueryHandle.IsSupported then
  493. begin
  494. // preferred method, doesn't stall rendering too badly
  495. if not Assigned(FOcclusionQuery) then
  496. FOcclusionQuery := TGLOcclusionQueryHandle.Create;
  497. FOcclusionQuery.AllocateHandle;
  498. if FOcclusionQuery.IsDataNeedUpdate then
  499. FOcclusionQuery.NotifyDataUpdated
  500. else
  501. FlareIsNotOccluded := (FOcclusionQuery.PixelCount <> 0);
  502. FOcclusionQuery.BeginQuery;
  503. end
  504. else
  505. begin
  506. // occlusion_test, stalls rendering a bit
  507. gl.Enable(GL_OCCLUSION_TEST_HP);
  508. end;
  509. gl.Begin_(GL_QUADS);
  510. gl.Vertex3f(posVector.X + 2, posVector.Y, 1);
  511. gl.Vertex3f(posVector.X, posVector.Y + 2, 1);
  512. gl.Vertex3f(posVector.X - 2, posVector.Y, 1);
  513. gl.Vertex3f(posVector.X, posVector.Y - 2, 1);
  514. gl.End_;
  515. if TGLOcclusionQueryHandle.IsSupported then
  516. FOcclusionQuery.EndQuery
  517. else
  518. begin
  519. gl.Disable(GL_OCCLUSION_TEST_HP);
  520. gl.GetBooleanv(GL_OCCLUSION_TEST_RESULT_HP, @FFlareIsNotOccluded)
  521. end;
  522. rci.GLStates.DepthFunc := cfLEqual;
  523. rci.GLStates.SetColorMask(cAllColorComponents);
  524. end
  525. else
  526. begin
  527. //Compares the distance to the lensflare, to the z-buffer depth.
  528. //This prevents the flare from being occluded by objects BEHIND the light.
  529. (*
  530. depth := CurrentBuffer.PixelToDistance(Round(ScreenPos.X),
  531. Round(rci.viewPortSize.cy - ScreenPos.Y));
  532. dist := VectorDistance(rci.cameraPosition, self.AbsolutePosition);
  533. FlareIsNotOccluded := ((dist - depth) < 1);
  534. *)
  535. end;
  536. end;
  537. if FCurrSize >= 0 then
  538. begin
  539. // Random seed must be backed up, could be used for other purposes
  540. // (otherwise we essentially reset the random generator at each frame)
  541. oldSeed := RandSeed;
  542. RandSeed := Seed;
  543. SetupRenderingOptions(rci.GLStates);
  544. if [feGlow, feStreaks, feRays, feRing] * Elements <> [] then
  545. begin
  546. gl.Translatef(posVector.X, posVector.Y, posVector.Z);
  547. // Glow (a circle with transparent edges):
  548. if feGlow in Elements then
  549. begin
  550. gl.Begin_(GL_TRIANGLE_FAN);
  551. gl.Color4fv(GlowGradient.FromColor.AsAddress);
  552. gl.Vertex2f(0, 0);
  553. gl.Color4fv(GlowGradient.ToColor.AsAddress);
  554. for i := 0 to Resolution - 1 do
  555. gl.Vertex2f(FCurrSize * FCosRes[i],
  556. Squeeze * FCurrSize * FSinRes[i]);
  557. gl.End_;
  558. end;
  559. if feStreaks in Elements then
  560. RenderStreaks(rci.GLStates);
  561. // Rays (random-length lines from the origin):
  562. if feRays in Elements then
  563. begin
  564. if FTexRays.Handle <> 0 then
  565. begin
  566. {$IFDEF USE_OPENGL_DEBUG}
  567. if GL.GREMEDY_string_marker then
  568. GL.StringMarkerGREMEDY(19, 'LensFlare.RaysQuad');
  569. {$ENDIF}
  570. rci.GLStates.TextureBinding[0, ttTexture2D] := FTexRays.Handle;
  571. rci.GLStates.ActiveTextureEnabled[ttTexture2D] := True;
  572. gl.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
  573. gl.Begin_(GL_QUADS);
  574. gl.TexCoord2f(0, 0);
  575. gl.Vertex2f(-FCurrSize, -FCurrSize);
  576. gl.TexCoord2f(1, 0);
  577. gl.Vertex2f(FCurrSize, -FCurrSize);
  578. gl.TexCoord2f(1, 1);
  579. gl.Vertex2f(FCurrSize, FCurrSize);
  580. gl.TexCoord2f(0, 1);
  581. gl.Vertex2f(-FCurrSize, FCurrSize);
  582. gl.End_;
  583. rci.GLStates.ActiveTextureEnabled[ttTexture2D] := False;
  584. end
  585. else
  586. RenderRays(rci.GLStates, FCurrSize);
  587. end;
  588. if feRing in Elements then
  589. RenderRing;
  590. gl.LoadMatrixf(@projMatrix);
  591. end;
  592. if feSecondaries in Elements then
  593. RenderSecondaries(posVector);
  594. RandSeed := oldSeed;
  595. end;
  596. gl.PopMatrix;
  597. gl.MatrixMode(GL_MODELVIEW);
  598. gl.PopMatrix;
  599. if Count > 0 then
  600. Self.RenderChildren(0, Count - 1, rci);
  601. end;
  602. procedure TGLLensFlare.DoProgress(const progressTime: TGLProgressTimes);
  603. begin
  604. inherited;
  605. FDeltaTime := progressTime.deltaTime;
  606. end;
  607. procedure TGLLensFlare.PreRender(activeBuffer: TGLSceneBuffer);
  608. var
  609. i, texSize, maxSize: Integer;
  610. stateCache: TGLStateCache;
  611. begin
  612. if FTexRays.Handle <> 0 then
  613. Exit;
  614. with activeBuffer.RenderingContext do
  615. begin
  616. stateCache := GLStates;
  617. PipelineTransformation.Push;
  618. PipelineTransformation.SetProjectionMatrix(CreateOrthoMatrix(0, activeBuffer.Width, 0, activeBuffer.Height, -1, 1));
  619. PipelineTransformation.SetViewMatrix(IdentityHmgMatrix);
  620. end;
  621. SetupRenderingOptions(stateCache);
  622. texSize := RoundUpToPowerOf2(Size);
  623. if texSize < Size * 1.5 then
  624. texSize := texSize * 2;
  625. gl.GetIntegerv(GL_MAX_TEXTURE_SIZE, @maxSize);
  626. if texSize > maxSize then
  627. texSize := maxSize;
  628. stateCache.Disable(stBlend);
  629. gl.Color4f(0, 0, 0, 0);
  630. gl.Begin_(GL_QUADS);
  631. gl.Vertex2f(0, 0);
  632. gl.Vertex2f(texSize + 4, 0);
  633. gl.Vertex2f(texSize + 4, texSize + 4);
  634. gl.Vertex2f(0, texSize + 4);
  635. gl.End_;
  636. stateCache.Enable(stBlend);
  637. gl.Translatef(texSize * 0.5 + 2, texSize * 0.5 + 2, 0);
  638. RenderRays(stateCache, texSize * 0.5);
  639. FTexRays.AllocateHandle;
  640. stateCache.TextureBinding[0, ttTexture2D] := FTexRays.Handle;
  641. if gl.EXT_texture_edge_clamp then
  642. i := GL_CLAMP_TO_EDGE
  643. else
  644. i := GL_CLAMP;
  645. gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, i);
  646. gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, i);
  647. gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  648. gl.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  649. gl.CopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 2, 2, texSize, texSize, 0);
  650. activeBuffer.RenderingContext.PipelineTransformation.Pop;
  651. gl.CheckError;
  652. end;
  653. procedure TGLLensFlare.SetGlowGradient(const val: TGLFlareGradient);
  654. begin
  655. FGlowGradient.Assign(val);
  656. StructureChanged;
  657. end;
  658. procedure TGLLensFlare.SetRingGradient(const val: TGLFlareGradient);
  659. begin
  660. FRingGradient.Assign(val);
  661. StructureChanged;
  662. end;
  663. procedure TGLLensFlare.SetStreaksGradient(const val: TGLFlareGradient);
  664. begin
  665. FStreaksGradient.Assign(val);
  666. StructureChanged;
  667. end;
  668. procedure TGLLensFlare.SetRaysGradient(const val: TGLFlareGradient);
  669. begin
  670. FRaysGradient.Assign(val);
  671. StructureChanged;
  672. end;
  673. procedure TGLLensFlare.SetSecondariesGradient(const val: TGLFlareGradient);
  674. begin
  675. FSecondariesGradient.Assign(val);
  676. StructureChanged;
  677. end;
  678. procedure TGLLensFlare.SetSize(aValue: Integer);
  679. begin
  680. FSize := aValue;
  681. StructureChanged;
  682. end;
  683. procedure TGLLensFlare.SetSeed(aValue: Integer);
  684. begin
  685. FSeed := aValue;
  686. StructureChanged;
  687. end;
  688. procedure TGLLensFlare.SetSqueeze(aValue: Single);
  689. begin
  690. FSqueeze := aValue;
  691. StructureChanged;
  692. end;
  693. function TGLLensFlare.StoreSqueeze: Boolean;
  694. begin
  695. Result := (FSqueeze <> 1);
  696. end;
  697. procedure TGLLensFlare.SetNumStreaks(aValue: Integer);
  698. begin
  699. FNumStreaks := aValue;
  700. StructureChanged;
  701. end;
  702. procedure TGLLensFlare.SetStreakWidth(aValue: Single);
  703. begin
  704. FStreakWidth := aValue;
  705. StructureChanged;
  706. end;
  707. function TGLLensFlare.StoreStreakWidth: Boolean;
  708. begin
  709. Result := (FStreakWidth <> 2);
  710. end;
  711. procedure TGLLensFlare.SetStreakAngle(aValue: Single);
  712. begin
  713. FStreakAngle := aValue;
  714. StructureChanged;
  715. end;
  716. procedure TGLLensFlare.SetNumSecs(aValue: Integer);
  717. begin
  718. FNumSecs := aValue;
  719. StructureChanged;
  720. end;
  721. procedure TGLLensFlare.SetResolution(aValue: Integer);
  722. begin
  723. if FResolution <> aValue then
  724. begin
  725. FResolution := aValue;
  726. StructureChanged;
  727. SetLength(FSin20Res, 20 * FResolution);
  728. SetLength(FCos20Res, 20 * FResolution);
  729. PrepareSinCosCache(FSin20Res, FCos20Res, 0, 360);
  730. SetLength(FSinRes, FResolution);
  731. SetLength(FCosRes, FResolution);
  732. PrepareSinCosCache(FSinRes, FCosRes, 0, 360);
  733. end;
  734. end;
  735. procedure TGLLensFlare.SetAutoZTest(aValue: Boolean);
  736. begin
  737. if FAutoZTest <> aValue then
  738. begin
  739. FAutoZTest := aValue;
  740. StructureChanged;
  741. end;
  742. end;
  743. procedure TGLLensFlare.SetElements(aValue: TGLFlareElements);
  744. begin
  745. if FElements <> aValue then
  746. begin
  747. FElements := aValue;
  748. StructureChanged;
  749. end;
  750. end;
  751. procedure TGLLensFlare.SetDynamic(aValue: Boolean);
  752. begin
  753. if aValue <> FDynamic then
  754. begin
  755. FDynamic := aValue;
  756. NotifyChange(Self);
  757. end;
  758. end;
  759. procedure TGLLensFlare.SetPreRenderPoint(const val: TGLRenderPoint);
  760. begin
  761. if val <> FPreRenderPoint then
  762. begin
  763. if Assigned(FPreRenderPoint) then
  764. FPreRenderPoint.UnRegisterCallBack(Self.PreRenderEvent);
  765. FPreRenderPoint := val;
  766. if Assigned(FPreRenderPoint) then
  767. FPreRenderPoint.RegisterCallBack(Self.PreRenderEvent,
  768. Self.PreRenderPointFreed);
  769. end;
  770. end;
  771. procedure TGLLensFlare.PreRenderEvent(Sender: TObject; var rci:
  772. TGLRenderContextInfo);
  773. begin
  774. PreRender(rci.buffer as TGLSceneBuffer);
  775. end;
  776. procedure TGLLensFlare.PreRenderPointFreed(Sender: TObject);
  777. begin
  778. FPreRenderPoint := nil;
  779. end;
  780. // ------------------------------------------------------------------
  781. initialization
  782. // ------------------------------------------------------------------
  783. RegisterClasses([TGLLensFlare]);
  784. end.