LZScene

1

2
// This unit is part of the GLScene Engine https://github.com/glscene
3

4
{
5
   Lens flare object.
6

7
  History :  
8
       10/11/12 - PW - Added CPP compatibility: changed vector arrays to records
9
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
10
       22/04/10 - Yar - Fixes after GLState revision
11
       05/03/10 - DanB - More state added to TGLStateCache
12
       13/03/09 - DanB - changed glReadPixels/glTexImage2D calls to glCopyTexImage2D
13
       10/10/08 - DanB - changed Lensflare buildlists to use rci.cameraPosition instead
14
                            of Scene.CurrentGLCamera.DistanceTo
15
       08/08/07 - Lin - Bugfix for AutoZTest:
16
                           Lensflare is no longer occluded by objects BEHIND the flare.
17
       06/06/07 - DaStr - Added GLColor to uses (BugtrackerID = 1732211)
18
       30/03/07 - DaStr - Moved all UNSAFE_TYPE, UNSAFE_CODE checks to GLSCene.inc
19
       25/03/07 - DaStr - UNSAFE_TYPE and UNSAFE_CODE warnings are now ignored
20
       23/03/07 - DaStr - Added missing parameters in procedure's implementation
21
                             (thanks Burkhard Carstens) (Bugtracker ID = 1681409)
22
       22/03/07 - DaStr - Cleanup after previous fix - now object does not
23
                             igore its children in picking state
24
                             Removed "unsafe type/unsafe code" warnings
25
       15/03/07 - DaStr - Removed flicker that occured when LensFlare was
26
                             rendered in a picking state (BugTracker ID = 1681031)
27
       19/04/04 - EG - Fixed occlusion test and pojection matrix stack issues
28
       16/04/04 - EG - Added StreakAngle
29
       15/04/04 - EG - Texture-based Lens-flare moved to GLTexLensFlare,
30
                          replaced gradient arrays with design-time editable colors
31
       25/09/03 - EG - Increased occlusion testing robustness
32
       20/09/03 - EG - Can now use occlusion testing/query for AutoZTest
33
       19/09/03 - EG - Misc. cleanup, added PreRender
34
       18/08/03 - SG - Added TGLTextureLensFlare (Tobias Peirick)
35
       26/03/03 - EG - Framerate independant glow transitions (Tobias Peirick)
36
       08/12/02 - EG - Added AutoZTest
37
       29/10/02 - EG - Initial, added defaults and encapsulation,
38
                          fixed positionning, RandSeed now preserved,
39
                          minor speedup
40
  
41

42
   Author  : Tobias Peirick 
43
   eMail   : peirick@onlinehome.de 
44
   Homepage: http://www.TobSoft.de
45
}
46
Unit GLLensFlare;
47

48
Interface
49

50
{$I GLScene.inc}
51

52
Uses
53
  Classes, SysUtils,
54
  GLScene, GLVectorGeometry, GLObjects, OpenGLTokens,
55
  GLContext, GLColor, GLBaseClasses, GLRenderContextInfo, GLState,
56
  GLVectorTypes, GLUtils, GLTextureFormat, GLRandomGenerator;
57

58
Type
59

60
  // TFlareElement
61

62
  TFlareElement  = (feGlow, feRing, feStreaks, feRays, feSecondaries);
63
  TFlareElements = Set Of TFlareElement;
64

65
  { The actual gradients between two colors are, of course, calculated by OpenGL.
66
     The start and end colors of a gradient are stored to represent the color of
67
     lens flare elements. }
68
  TGLFlareGradient = Class(TGLUpdateAbleObject)
69
  Private
70

71
    FFromColor: TGLColor;
72
    FToColor:   TGLColor;
73

74
  Protected
75

76
    Procedure SetFromColor(Const val: TGLColor);
77
    Procedure SetToColor(Const val: TGLColor);
78

79
  Public
80

81
    Constructor Create(AOwner: TPersistent); Override;
82
    Constructor CreateInitialized(AOwner: TPersistent; Const fromColor, toColor: TColorVector);
83
    Destructor Destroy; Override;
84
    Procedure Assign(Source: TPersistent); Override;
85

86
  Published
87

88
    Property FromColor: TGLColor read FFromColor write SetFromColor;
89
    Property ToColor: TGLColor read FToColor write SetToColor;
90
  End;
91

92
Const
93
  cDefaultFlareElements = [feGlow, feRing, feStreaks, feRays, feSecondaries];
94

95
Type
96

97
  // TGLLensFlare
98

99
  TGLLensFlare = Class(TGLBaseSceneObject)
100
  Private
101

102
    FSize:      Integer;
103
    FDeltaTime: Single;
104
    FCurrSize:  Single;
105
    FSeed:      Integer;
106
    FSqueeze:   Single;
107
    FNumStreaks: Integer;
108
    FStreakWidth, FStreakAngle: Single;
109
    FNumSecs:   Integer;
110
    FResolution: Integer;
111
    FAutoZTest: Boolean;
112
    FElements:  TFlareElements;
113
    FSin20Res, FCos20Res: Array Of Single;
114
    FSinRes, FCosRes: Array Of Single;
115
    FTexRays:   TGLTextureHandle;
116
    FFlareIsNotOccluded: Boolean;
117
    FOcclusionQuery: TGLOcclusionQueryHandle;
118
    FGlowGradient: TGLFlareGradient;
119
    FRingGradient: TGLFlareGradient;
120
    FStreaksGradient: TGLFlareGradient;
121
    FRaysGradient: TGLFlareGradient;
122
    FSecondariesGradient: TGLFlareGradient;
123
    FDynamic:   Boolean;
124
    FPreRenderPoint: TGLRenderPoint;
125
    FCustomRNG : TGLRandomNumGenerator;
126
  Protected
127

128
    Procedure SetGlowGradient(Const val: TGLFlareGradient);
129
    Procedure SetRingGradient(Const val: TGLFlareGradient);
130
    Procedure SetStreaksGradient(Const val: TGLFlareGradient);
131
    Procedure SetRaysGradient(Const val: TGLFlareGradient);
132
    Procedure SetSecondariesGradient(Const val: TGLFlareGradient);
133
    Procedure SetSize(aValue: Integer);
134
    Procedure SetSeed(aValue: Integer);
135
    Procedure SetSqueeze(aValue: Single);
136
    Function StoreSqueeze: Boolean;
137
    Procedure SetNumStreaks(aValue: Integer);
138
    Procedure SetStreakWidth(aValue: Single);
139
    Function StoreStreakWidth: Boolean;
140
    Procedure SetStreakAngle(aValue: Single);
141
    Procedure SetNumSecs(aValue: Integer);
142
    Procedure SetResolution(aValue: Integer);
143
    Procedure SetAutoZTest(aValue: Boolean);
144
    Procedure SetElements(aValue: TFlareElements);
145
    Procedure SetDynamic(aValue: Boolean);
146
    Procedure SetPreRenderPoint(Const val: TGLRenderPoint);
147
    Procedure PreRenderEvent(Sender: TObject; Var rci: TGLRenderContextInfo);
148
    Procedure PreRenderPointFreed(Sender: TObject);
149

150
    // These are quite unusual in that they don't use an RCI, since
151
    // PreRender is done before proper rendering starts, but we do know
152
    // which RC is being used, so we can use this state cache
153
    Procedure SetupRenderingOptions(StateCache: TGLStateCache);
154

155
    Procedure RenderRays(StateCache: TGLStateCache; Const size: Single);
156
    Procedure RenderStreaks(StateCache: TGLStateCache);
157
    Procedure RenderRing;
158
    Procedure RenderSecondaries(Const posVector: TAffineVector);
159

160
  Public
161

162
    Constructor Create(AOwner: TComponent); Override;
163
    Destructor Destroy; Override;
164
    Procedure Notification(AComponent: TComponent; Operation: TOperation);
165
      Override;
166

167
    Procedure BuildList(Var rci: TGLRenderContextInfo); Override;
168
    Procedure DoProgress(Const progressTime: TProgressTimes); Override;
169

170
    { Prepares pre-rendered texture to speed up actual rendering.
171
       Will use the currently active context as scratch space, and will
172
       automatically do nothing if things have already been prepared,
173
       thus you can invoke it systematically in a Viewer.BeforeRender
174
       event f.i. }
175
    Procedure PreRender(activeBuffer: TGLSceneBuffer);
176
    { Access to the Flare's current size.
177
       Flares decay or grow back over several frames, depending on their
178
       occlusion status, and this property allows to track or manually
179
       alter this instantaneous size. }
180
    Property FlareInstantaneousSize: Single read FCurrSize write FCurrSize;
181

182
  Published
183

184
    Property GlowGradient: TGLFlareGradient read FGlowGradient write SetGlowGradient;
185
    Property RingGradient: TGLFlareGradient read FRingGradient;
186
    Property StreaksGradient: TGLFlareGradient read FStreaksGradient;
187
    Property RaysGradient: TGLFlareGradient read FRaysGradient;
188
    Property SecondariesGradient: TGLFlareGradient read FSecondariesGradient;
189

190
    // MaxRadius of the flare.
191
    Property Size: Integer read FSize write SetSize Default 50;
192
    // GLTSRandom.Random seed
193
    Property Seed: Integer read FSeed write SetSeed;
194
    // To create elliptic flares.
195
    Property Squeeze: Single read FSqueeze write SetSqueeze Stored StoreSqueeze;
196
    // Number of streaks.
197
    Property NumStreaks: Integer read FNumStreaks write SetNumStreaks Default 4;
198
    // Width of the streaks.
199
    Property StreakWidth: Single read FStreakWidth write SetStreakWidth Stored StoreStreakWidth;
200
    // Angle of the streaks (in degrees)
201
    Property StreakAngle: Single read FStreakAngle write SetStreakAngle;
202
    // Number of secondary flares.
203
    Property NumSecs: Integer read FNumSecs write SetNumSecs Default 8;
204
    // Number of segments used when rendering circles.
205
    Property Resolution: Integer read FResolution write SetResolution Default 64;
206
    { Automatically computes FlareIsNotOccluded depending on ZBuffer test.
207
       Not that the automated test may use test result from the previous
208
       frame into the next (to avoid a rendering stall). }
209
    Property AutoZTest: Boolean read FAutoZTest write SetAutoZTest Default True;
210
    { Is the LensFlare not occluded?.
211
       If false the flare will fade away, if true, it will fade in and stay.
212
       This value is automatically updated if AutoZTest is set. }
213
    Property FlareIsNotOccluded: Boolean read FFlareIsNotOccluded write FFlareIsNotOccluded;
214
    // Which elements should be rendered?
215
    Property Elements: TFlareElements read FElements write SetElements Default cDefaultFlareElements;
216
    { Is the flare size adjusted dynamically?
217
       If true, the flare size will be grown and reduced over a few frames
218
       when it switches between occluded and non-occluded states. This
219
       requires animation to be active, but results in a smoother appearance.
220
       When false, flare will either be at full size or hidden.
221
       The flare is always considered non-dynamic at design-time. }
222
    Property Dynamic: Boolean read FDynamic write FDynamic Default True;
223

224
    { PreRender point for pre-rendered flare textures.
225
       See PreRender method for more details. }
226
    Property PreRenderPoint: TGLRenderPoint read FPreRenderPoint write SetPreRenderPoint;
227

228
    Property ObjectsSorting;
229
    Property Position;
230
    Property Visible;
231
    Property OnProgress;
232
    Property Behaviours;
233
    Property Effects;
234
  End;
235

236
Implementation
237

238
{%region%=====[ TGLFlareGradient ]==============================================}
239

240
Constructor TGLFlareGradient.Create(AOwner: TPersistent);
241
Begin
242
  Inherited;
243
  FFromColor := TGLColor.Create(Self);
244
  FToColor := TGLColor.Create(Self);
245
End;
246

247
Constructor TGLFlareGradient.CreateInitialized(AOwner: TPersistent; Const fromColor, toColor: TColorVector);
248
Begin
249
  Create(AOwner);
250
  FFromColor.Initialize(fromColor);
251
  FToColor.Initialize(toColor);
252
End;
253

254
Destructor TGLFlareGradient.Destroy;
255
Begin
256
  FToColor.Free;
257
  FFromColor.Free;
258
  Inherited;
259
End;
260

261
Procedure TGLFlareGradient.Assign(Source: TPersistent);
262
Begin
263
  If Source Is TGLFlareGradient Then
264
  Begin
265
    FromColor := TGLFlareGradient(Source).FromColor;
266
    ToColor := TGLFlareGradient(Source).ToColor;
267
  End;
268
  Inherited;
269
End;
270

271
Procedure TGLFlareGradient.SetFromColor(Const val: TGLColor);
272
Begin
273
  FFromColor.Assign(val);
274
End;
275

276
Procedure TGLFlareGradient.SetToColor(Const val: TGLColor);
277
Begin
278
  FToColor.Assign(val);
279
End;
280

281
{%endregion%}
282

283
Constructor TGLLensFlare.Create(AOwner: TComponent);
284
Begin
285
  Inherited;
286
  // Set default parameters:
287
  ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
288
  FSize := 50;
289
  FCustomRNG := TGLRandomNumGenerator.create;
290

291
  FSeed :=1465;// GettickCount64; // 1465;
292
 // FCustomRNG.RandSeed := FSeed;
293
  FSqueeze := 1;
294
  FNumStreaks := 4;
295
  FStreakWidth := 2;
296
  FNumSecs := 8;
297
  FAutoZTest := True;
298
  FlareIsNotOccluded := True;
299
  FDynamic := True;
300

301
  SetResolution(64);
302

303
  // Render all elements by default.
304
  FElements := [feGlow, feRing, feStreaks, feRays, feSecondaries];
305
  // Setup default gradients:
306
  FGlowGradient := TGLFlareGradient.CreateInitialized(Self, VectorMake(1, 1, 0.8, 0.3), VectorMake(1, 0.2, 0, 0));
307
  FRingGradient := TGLFlareGradient.CreateInitialized(Self, VectorMake(0.5, 0.2, 0, 0.1), VectorMake(0.5, 0.4, 0, 0.1));
308
  FStreaksGradient := TGLFlareGradient.CreateInitialized(Self, VectorMake(1, 1, 1, 0.2), VectorMake(0.2, 0, 1, 0));
309
  FRaysGradient := TGLFlareGradient.CreateInitialized(Self, VectorMake(1, 0.8, 0.5, 0.05), VectorMake(0.5, 0.2, 0, 0));
310
  FSecondariesGradient := TGLFlareGradient.CreateInitialized(Self, VectorMake(0, 0.2, 1, 0), VectorMake(0, 0.8, 0.2, 0.15));
311

312
  FTexRays := TGLTextureHandle.Create;
313
End;
314

315
Destructor TGLLensFlare.Destroy;
316
Begin
317
  PreRenderPoint := nil;
318
  FGlowGradient.Free;
319
  FRingGradient.Free;
320
  FStreaksGradient.Free;
321
  FRaysGradient.Free;
322
  FSecondariesGradient.Free;
323
  FOcclusionQuery.Free;
324
  FTexRays.Free;
325
  FreeAndNil(FCustomRNG);
326
  Inherited;
327
End;
328

329
Procedure TGLLensFlare.Notification(AComponent: TComponent; Operation: TOperation);
330
Begin
331
  If (Operation = opRemove) And (AComponent = FPreRenderPoint) Then
332
    PreRenderPoint := nil;
333
  Inherited;
334
End;
335

336
Procedure TGLLensFlare.SetupRenderingOptions(StateCache: TGLStateCache);
337
Begin
338
  With StateCache Do
339
  Begin
340
    Disable(stLighting);
341
    Disable(stDepthTest);
342
    Disable(stFog);
343
    Disable(stColorMaterial);
344
    Disable(stCullFace);
345
    DepthWriteMask := False;
346
    Enable(stBlend);
347
    SetBlendFunc(bfSrcAlpha, bfOne);
348
    Disable(stAlphaTest);
349
    PolygonMode := pmFill;
350
  End;
351
End;
352

353
Procedure TGLLensFlare.RenderRays(StateCache: TGLStateCache; Const size: Single);
354
Var
355
  i:   Integer;
356
  rnd: Single;
357
  Rand : Single;
358
Begin
359
{$IFDEF GLS_OPENGL_DEBUG}
360
  If GL.GREMEDY_string_marker Then
361
    GL.StringMarkerGREMEDY(14, 'LensFlare.Rays');
362
{$ENDIF}
363

364
  With StateCache Do
365
  Begin
366
    LineWidth := 1;
367
    Disable(stLineSmooth);
368
    Disable(stLineStipple);
369
  End;
370

371

372
  GL.Begin_(GL_LINES);
373
  rnd := 0;
374
  For i := 0 To Resolution * 20 - 1 Do
375
 Begin
376
    rand := FCustomRNG.Random;// random; //TSRand.Random;  // 138867;
377
    If (i And 1) <> 0 Then
378
      rnd := 1.5 * rand * size
379
    Else
380
      rnd := rand * size;
381

382
    GL.Color4fv(RaysGradient.FromColor.AsAddress);
383
    GL.Vertex2f(0, 0);
384
    GL.Color4fv(RaysGradient.ToColor.AsAddress);
385
    GL.Vertex2f(rnd * FCos20Res[i], rnd * FSin20Res[i] * Squeeze);
386
  End;
387
  GL.End_;
388
End;
389

390
Procedure TGLLensFlare.RenderStreaks(StateCache: TGLStateCache);
391
Var
392
  i: Integer;
393
  a, f, s, c: Single;
394
Begin
395
{$IFDEF GLS_OPENGL_DEBUG}
396
  If GL.GREMEDY_string_marker Then
397
    GL.StringMarkerGREMEDY(17, 'LensFlare.Streaks');
398
{$ENDIF}
399
  StateCache.Enable(stLineSmooth);
400
  StateCache.LineWidth := StreakWidth;
401
  a := c2PI / NumStreaks;
402
  f := 1.5 * FCurrSize;
403
  GL.Begin_(GL_LINES);
404
  For i := 0 To NumStreaks - 1 Do
405
  Begin
406
    SinCos(StreakAngle * cPIdiv180 + a * i, f, s, c);
407
    GL.Color4fv(StreaksGradient.FromColor.AsAddress);
408
    GL.Vertex3fv(@NullVector);
409
    GL.Color4fv(StreaksGradient.ToColor.AsAddress);
410
    GL.Vertex2f(c, Squeeze * s);
411
  End;
412
  GL.End_;
413
  StateCache.Disable(stLineSmooth);
414
End;
415

416
Procedure TGLLensFlare.RenderRing;
417
Var
418
  i: Integer;
419
  rW, s0, c0, s, c: Single;
420
Begin
421
{$IFDEF GLS_OPENGL_DEBUG}
422
  If GL.GREMEDY_string_marker Then
423
    GL.StringMarkerGREMEDY(14, 'LensFlare.Ring');
424
{$ENDIF}
425
  rW := FCurrSize * (1 / 15); // Ring width
426
  GL.Begin_(GL_QUADS);
427
  s0 := 0;
428
  c0 := 0.6;
429
  For i := 0 To Resolution - 1 Do
430
  Begin
431
    s := s0;
432
    c := c0;
433
    s0 := FSinRes[i] * 0.6 * Squeeze;
434
    c0 := FCosRes[i] * 0.6;
435

436
    GL.Color4fv(GlowGradient.ToColor.AsAddress);
437
    GL.Vertex2f((FCurrSize - rW) * c, (FCurrSize - rW) * s);
438
    GL.Color4fv(RingGradient.FromColor.AsAddress);
439
    GL.Vertex2f(FCurrSize * c, Squeeze * FCurrSize * s);
440

441
    GL.Vertex2f(FCurrSize * c0, FCurrSize * s0);
442
    GL.Color4fv(GlowGradient.ToColor.AsAddress);
443
    GL.Vertex2f((FCurrSize - rW) * c0, (FCurrSize - rW) * s0);
444

445
    GL.Color4fv(RingGradient.FromColor.AsAddress);
446
    GL.Vertex2f(FCurrSize * c, FCurrSize * s);
447
    GL.Vertex2f(FCurrSize * c0, FCurrSize * s0);
448

449
    GL.Color4fv(GlowGradient.ToColor.AsAddress);
450
    GL.Vertex2f((FCurrSize + rW) * c0, (FCurrSize + rW) * s0);
451
    GL.Vertex2f((FCurrSize + rW) * c, (FCurrSize + rW) * s);
452
  End;
453
  GL.End_;
454
End;
455

456
Procedure TGLLensFlare.RenderSecondaries(Const posVector: TAffineVector);
457
Var
458
  i, j: Integer;
459
  rnd:  Single;
460
  v:    TAffineVector;
461
  grad: TGLFlareGradient;
462
Begin
463
{$IFDEF GLS_OPENGL_DEBUG}
464
  If GL.GREMEDY_string_marker Then
465
    GL.StringMarkerGREMEDY(21, 'LensFlare.Secondaries');
466
{$ENDIF}
467
  // Other secondaries (plain gradiented circles, like the glow):
468
  For j := 1 To NumSecs Do
469
  Begin
470
    rnd := 2 * FCustomRNG.Random - 1;
471
    // If rnd < 0 then the secondary glow will end up on the other side
472
    // of the origin. In this case, we can push it really far away from
473
    // the flare. If  the secondary is on the flare's side, we pull it
474
    // slightly towards the origin to avoid it winding up in the middle
475
    // of the flare.
476
    If rnd < 0 Then
477
      v := VectorScale(posVector, rnd)
478
    Else
479
      v := VectorScale(posVector, 0.8 * rnd);
480
    If j Mod 3 = 0 Then
481
      grad := GlowGradient
482
    Else
483
      grad := SecondariesGradient;
484
    rnd := (FCustomRNG.Random + 0.1) * FCurrSize * 0.25;
485

486
    GL.Begin_(GL_TRIANGLE_FAN);
487
    GL.Color4fv(grad.FromColor.AsAddress);
488
    GL.Vertex2f(v.V[0], v.V[1]);
489
    GL.Color4fv(grad.ToColor.AsAddress);
490
    For i := 0 To Resolution - 1 Do
491
      GL.Vertex2f(FCosRes[i] * rnd + v.V[0], FSinRes[i] * rnd + v.V[1]);
492
    GL.End_;
493
  End;
494
End;
495

496
// BuildList
497

498

499
Procedure TGLLensFlare.BuildList(Var rci: TGLRenderContextInfo);
500
Var
501
  i: Integer;
502
  depth, dist: Single;
503
  posVector, v, rv: TAffineVector;
504
  screenPos: TAffineVector;
505
  flareInViewPort, dynamicSize: Boolean;
506
  oldSeed: Longword;
507
  projMatrix: TMatrix;
508
  CurrentBuffer: TGLSceneBuffer;
509
Begin
510
  If (rci.drawState = dsPicking) Then
511
  Begin
512
    If Count <> 0 Then
513
      Self.RenderChildren(0, Count - 1, rci);
514
    Exit;
515
  End;
516
  CurrentBuffer := TGLSceneBuffer(rci.buffer);
517

518
  SetVector(v, AbsolutePosition);
519
  // are we looking towards the flare?
520
  rv := VectorSubtract(v, PAffineVector(@rci.cameraPosition)^);
521
  If VectorDotProduct(rci.cameraDirection, rv) > 0 Then
522
  Begin
523
    // find out where it is on the screen.
524
    screenPos := CurrentBuffer.WorldToScreen(v);
525
    flareInViewPort := (screenPos.V[0] < rci.viewPortSize.cx) And (screenPos.V[0] >= 0)
526
                        And (screenPos.V[1] < rci.viewPortSize.cy) And (screenPos.V[1] >= 0);
527
  End
528
  Else
529
    flareInViewPort := False;
530

531
  dynamicSize := FDynamic And Not (csDesigning In ComponentState);
532
  If dynamicSize Then
533
  Begin
534
    // make the glow appear/disappear progressively
535
    If flareInViewPort And FlareIsNotOccluded Then
536
    Begin
537
      FCurrSize := FCurrSize + FDeltaTime * 10 * Size;
538
      If FCurrSize > Size Then
539
        FCurrSize := Size;
540
    End
541
    Else
542
    Begin
543
      FCurrSize := FCurrSize - FDeltaTime * 10 * Size;
544
      If FCurrSize < 0 Then
545
        FCurrSize := 0;
546
    End;
547
  End
548
  Else
549
  Begin
550
    If flareInViewPort And FlareIsNotOccluded Then
551
      FCurrSize := Size
552
    Else
553
      FCurrSize := 0;
554
  End;
555

556
  // Prepare matrices
557
 // rci.PipelineTransformation.Push;
558
 // rci.PipelineTransformation.ProjectionMatrix:=CurrentBuffer.BaseProjectionMatrix;
559

560
  //.ModelMatrix := IdentityHmgMatrix;
561
  GL.PushMatrix;
562
  GL.LoadMatrixf(@CurrentBuffer.BaseProjectionMatrix);
563

564
 GL.MatrixMode(GL_PROJECTION);
565
  GL.PushMatrix;
566
 // rci.PipelineTransformation.Push;
567

568
  projMatrix := IdentityHmgMatrix;
569
  projMatrix.V[0].V[0] := 2 / rci.viewPortSize.cx;
570
  projMatrix.V[1].V[1] := 2 / rci.viewPortSize.cy;
571
  GL.LoadMatrixf(@projMatrix);
572
//  rci.PipelineTransformation.ProjectionMatrix := projMatrix;
573

574
  MakeVector(posVector,
575
    screenPos.V[0] - rci.viewPortSize.cx * 0.5,
576
    screenPos.V[1] - rci.viewPortSize.cy * 0.5,
577
    0);
578

579

580

581
  If AutoZTest Then
582
  Begin
583
    If dynamicSize And (GL.HP_occlusion_test Or TGLOcclusionQueryHandle.IsSupported) Then
584
    Begin
585
      // hardware-based occlusion test is possible
586
      FlareIsNotOccluded := True;
587

588
      rci.GLStates.SetColorMask([]);
589
      rci.GLStates.Disable(stAlphaTest);
590
      rci.GLStates.DepthWriteMask := False;
591
      rci.GLStates.Enable(stDepthTest);
592
      rci.GLStates.DepthFunc := cfLEqual;
593

594
      If TGLOcclusionQueryHandle.IsSupported Then
595
      Begin
596
        // preferred method, doesn't stall rendering too badly
597
        If Not Assigned(FOcclusionQuery) Then
598
          FOcclusionQuery := TGLOcclusionQueryHandle.Create;
599
        FOcclusionQuery.AllocateHandle;
600
        If FOcclusionQuery.IsDataNeedUpdate Then
601
          FOcclusionQuery.NotifyDataUpdated
602
        Else
603
          FlareIsNotOccluded := (FOcclusionQuery.PixelCount <> 0);
604
        FOcclusionQuery.BeginQuery;
605
      End
606
      Else
607
      Begin
608
        // occlusion_test, stalls rendering a bit
609
        GL.Enable(GL_OCCLUSION_TEST_HP);
610
      End;
611

612
      GL.Begin_(GL_QUADS);
613
      GL.Vertex3f(posVector.V[0] + 2, posVector.V[1], 1);
614
      GL.Vertex3f(posVector.V[0], posVector.V[1] + 2, 1);
615
      GL.Vertex3f(posVector.V[0] - 2, posVector.V[1], 1);
616
      GL.Vertex3f(posVector.V[0], posVector.V[1] - 2, 1);
617
      GL.End_;
618

619
      If TGLOcclusionQueryHandle.IsSupported Then
620
        FOcclusionQuery.EndQuery
621
      Else
622
      Begin
623
        GL.Disable(GL_OCCLUSION_TEST_HP);
624
        GL.GetBooleanv(GL_OCCLUSION_TEST_RESULT_HP, @FFlareIsNotOccluded);
625
      End;
626

627
      rci.GLStates.DepthFunc := cfLEqual;
628
      rci.GLStates.SetColorMask(cAllColorComponents);
629
    End
630
    Else
631
    Begin
632
      //Compares the distance to the lensflare, to the z-buffer depth.
633
      //This prevents the flare from being occluded by objects BEHIND the light.
634
      depth := CurrentBuffer.PixelToDistance(Round(ScreenPos.V[0]), Round(rci.viewPortSize.cy - ScreenPos.V[1]));
635
      dist := VectorDistance(rci.cameraPosition, self.AbsolutePosition);
636
      FlareIsNotOccluded := ((dist - depth) < 1);
637
    End;
638
  End;
639

640
  If FCurrSize >= 0 Then
641
  Begin
642

643
    // Random seed must be backed up, otherwise LensFlare rendering will be different at each frame)
644
      FCustomRNG.ResetSeed;
645
    //  oldSeed := RandSeed;
646
    //  RandSeed := Seed;
647

648
    SetupRenderingOptions(rci.GLStates);
649

650
    If [feGlow, feStreaks, feRays, feRing] * Elements <> [] Then
651
    Begin
652
      GL.Translatef(posVector.V[0], posVector.V[1], posVector.V[2]);
653

654
      // Glow (a circle with transparent edges):
655
      If feGlow In Elements Then
656
      Begin
657
        GL.Begin_(GL_TRIANGLE_FAN);
658
        GL.Color4fv(GlowGradient.FromColor.AsAddress);
659
        GL.Vertex2f(0, 0);
660
        GL.Color4fv(GlowGradient.ToColor.AsAddress);
661
        For i := 0 To Resolution - 1 Do
662
          GL.Vertex2f(FCurrSize * FCosRes[i],
663
            Squeeze * FCurrSize * FSinRes[i]);
664
        GL.End_;
665
      End;
666

667
      If feStreaks In Elements Then
668
        RenderStreaks(rci.GLStates);
669

670
      // Rays (GLTSRandom.Random-length lines from the origin):
671
      If feRays In Elements Then
672
      Begin
673
        If FTexRays.Handle <> 0 Then
674
        Begin
675
        {$IFDEF GLS_OPENGL_DEBUG}
676
          If GL.GREMEDY_string_marker Then
677
            GL.StringMarkerGREMEDY(19, 'LensFlare.RaysQuad');
678
        {$ENDIF}
679
          rci.GLStates.TextureBinding[0, ttTexture2D] := FTexRays.Handle;
680
          rci.GLStates.ActiveTextureEnabled[ttTexture2D] := True;
681
          GL.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
682

683
          GL.Begin_(GL_QUADS);
684
          GL.TexCoord2f(0, 0);
685
          GL.Vertex2f(-FCurrSize, -FCurrSize);
686
          GL.TexCoord2f(1, 0);
687
          GL.Vertex2f(FCurrSize, -FCurrSize);
688
          GL.TexCoord2f(1, 1);
689
          GL.Vertex2f(FCurrSize, FCurrSize);
690
          GL.TexCoord2f(0, 1);
691
          GL.Vertex2f(-FCurrSize, FCurrSize);
692
          GL.End_;
693

694
          rci.GLStates.ActiveTextureEnabled[ttTexture2D] := False;
695
        End
696
        Else
697
         RenderRays(rci.GLStates, FCurrSize);
698
      End;
699

700
      If feRing In Elements Then
701
        RenderRing;
702

703
      GL.LoadMatrixf(@projMatrix);
704
    End;
705

706
    If feSecondaries In Elements Then
707
      RenderSecondaries(posVector);
708

709
   // RandSeed := oldSeed;
710
  End;
711

712
  GL.PopMatrix;
713
 // rci.PipelineTransformation.Pop;
714

715
  GL.MatrixMode(GL_MODELVIEW);
716
  GL.PopMatrix;
717
//  rci.PipelineTransformation.Pop;
718

719
  If Count > 0 Then
720
    Self.RenderChildren(0, Count - 1, rci);
721
End;
722

723
// DoProgress
724

725

726
Procedure TGLLensFlare.DoProgress(Const progressTime: TProgressTimes);
727
Begin
728
  Inherited;
729
  FDeltaTime := progressTime.deltaTime;
730
End;
731

732
// PreRender
733

734

735
Procedure TGLLensFlare.PreRender(activeBuffer: TGLSceneBuffer);
736
Var
737
  i, texSize, maxSize: Integer;
738
  stateCache: TGLStateCache;
739
Begin
740
  If FTexRays.Handle <> 0 Then Exit;
741
  With activeBuffer.RenderingContext Do
742
  Begin
743
    stateCache := GLStates;
744
    PipelineTransformation.Push;
745
    PipelineTransformation.ProjectionMatrix := CreateOrthoMatrix(0, activeBuffer.Width, 0, activeBuffer.Height, -1, 1);
746
    PipelineTransformation.ViewMatrix := IdentityHmgMatrix;
747
  End;
748
  SetupRenderingOptions(stateCache);
749

750
  texSize := RoundUpToPowerOf2(Size);
751
  If texSize < Size * 1.5 Then
752
    texSize := texSize * 2;
753
  GL.GetIntegerv(GL_MAX_TEXTURE_SIZE, @maxSize);
754
  If texSize > maxSize Then
755
    texSize := maxSize;
756

757
  stateCache.Disable(stBlend);
758
  GL.Color4f(0, 0, 0, 0);
759
  GL.Begin_(GL_QUADS);
760
  GL.Vertex2f(0, 0);
761
  GL.Vertex2f(texSize + 4, 0);
762
  GL.Vertex2f(texSize + 4, texSize + 4);
763
  GL.Vertex2f(0, texSize + 4);
764
  GL.End_;
765
  stateCache.Enable(stBlend);
766

767
  GL.Translatef(texSize * 0.5 + 2, texSize * 0.5 + 2, 0);
768
  RenderRays(stateCache, texSize * 0.5);
769

770
  FTexRays.AllocateHandle;
771
  stateCache.TextureBinding[0, ttTexture2D] := FTexRays.Handle;
772
  If GL.EXT_texture_edge_clamp Then
773
    i := GL_CLAMP_TO_EDGE
774
  Else
775
    i := GL_CLAMP;
776
  GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, i);
777
  GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, i);
778
  GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
779
  GL.TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
780

781
  GL.CopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 2, 2, texSize, texSize, 0);
782

783
  activeBuffer.RenderingContext.PipelineTransformation.Pop;
784

785
  GL.CheckError;
786
End;
787

788
// SetGlowGradient
789

790

791
Procedure TGLLensFlare.SetGlowGradient(Const val: TGLFlareGradient);
792
Begin
793
  FGlowGradient.Assign(val);
794
  StructureChanged;
795
End;
796

797
// SetRingGradient
798

799

800
Procedure TGLLensFlare.SetRingGradient(Const val: TGLFlareGradient);
801
Begin
802
  FRingGradient.Assign(val);
803
  StructureChanged;
804
End;
805

806
// SetStreaksGradient
807

808

809
Procedure TGLLensFlare.SetStreaksGradient(Const val: TGLFlareGradient);
810
Begin
811
  FStreaksGradient.Assign(val);
812
  StructureChanged;
813
End;
814

815
// SetRaysGradient
816

817

818
Procedure TGLLensFlare.SetRaysGradient(Const val: TGLFlareGradient);
819
Begin
820
  FRaysGradient.Assign(val);
821
  StructureChanged;
822
End;
823

824
// SetSecondariesGradient
825

826

827
Procedure TGLLensFlare.SetSecondariesGradient(Const val: TGLFlareGradient);
828
Begin
829
  FSecondariesGradient.Assign(val);
830
  StructureChanged;
831
End;
832

833
// SetSize
834

835

836
Procedure TGLLensFlare.SetSize(aValue: Integer);
837
Begin
838
  FSize := aValue;
839
  StructureChanged;
840
End;
841

842
// SetSeed
843

844

845
Procedure TGLLensFlare.SetSeed(aValue: Integer);
846
Begin
847
  FSeed := aValue;
848
  StructureChanged;
849
End;
850

851
// SetSqueeze
852

853

854
Procedure TGLLensFlare.SetSqueeze(aValue: Single);
855
Begin
856
  FSqueeze := aValue;
857
  StructureChanged;
858
End;
859

860
// StoreSqueeze
861

862

863
Function TGLLensFlare.StoreSqueeze: Boolean;
864
Begin
865
  Result := (FSqueeze <> 1);
866
End;
867

868
// SetNumStreaks
869

870

871
Procedure TGLLensFlare.SetNumStreaks(aValue: Integer);
872
Begin
873
  FNumStreaks := aValue;
874
  StructureChanged;
875
End;
876

877
// SetStreakWidth
878

879

880
Procedure TGLLensFlare.SetStreakWidth(aValue: Single);
881
Begin
882
  FStreakWidth := aValue;
883
  StructureChanged;
884
End;
885

886
// StoreStreakWidth
887

888

889
Function TGLLensFlare.StoreStreakWidth: Boolean;
890
Begin
891
  Result := (FStreakWidth <> 2);
892
End;
893

894
// SetStreakAngle
895

896

897
Procedure TGLLensFlare.SetStreakAngle(aValue: Single);
898
Begin
899
  FStreakAngle := aValue;
900
  StructureChanged;
901
End;
902

903
// SetNumSecs
904

905

906
Procedure TGLLensFlare.SetNumSecs(aValue: Integer);
907
Begin
908
  FNumSecs := aValue;
909
  StructureChanged;
910
End;
911

912
// SetResolution
913

914

915
Procedure TGLLensFlare.SetResolution(aValue: Integer);
916
Begin
917
  If FResolution <> aValue Then
918
  Begin
919
    FResolution := aValue;
920
    StructureChanged;
921
    SetLength(FSin20Res, 20 * FResolution);
922
    SetLength(FCos20Res, 20 * FResolution);
923
    PrepareSinCosCache(FSin20Res, FCos20Res, 0, 360);
924
    SetLength(FSinRes, FResolution);
925
    SetLength(FCosRes, FResolution);
926
    PrepareSinCosCache(FSinRes, FCosRes, 0, 360);
927
  End;
928
End;
929

930
// SetAutoZTest
931

932

933
Procedure TGLLensFlare.SetAutoZTest(aValue: Boolean);
934
Begin
935
  If FAutoZTest <> aValue Then
936
  Begin
937
    FAutoZTest := aValue;
938
    StructureChanged;
939
  End;
940
End;
941

942
// SetElements
943

944

945
Procedure TGLLensFlare.SetElements(aValue: TFlareElements);
946
Begin
947
  If FElements <> aValue Then
948
  Begin
949
    FElements := aValue;
950
    StructureChanged;
951
  End;
952
End;
953

954
// SetDynamic
955

956

957
Procedure TGLLensFlare.SetDynamic(aValue: Boolean);
958
Begin
959
  If aValue <> FDynamic Then
960
  Begin
961
    FDynamic := aValue;
962
    NotifyChange(Self);
963
  End;
964
End;
965

966
// SetPreRenderPoint
967

968

969
Procedure TGLLensFlare.SetPreRenderPoint(Const val: TGLRenderPoint);
970
Begin
971
  If val <> FPreRenderPoint Then
972
  Begin
973
    If Assigned(FPreRenderPoint) Then
974
      FPreRenderPoint.UnRegisterCallBack(Self.PreRenderEvent);
975
    FPreRenderPoint := val;
976
    If Assigned(FPreRenderPoint) Then
977
      FPreRenderPoint.RegisterCallBack(Self.PreRenderEvent,
978
        Self.PreRenderPointFreed);
979
  End;
980
End;
981

982
// PreRenderEvent
983

984

985
Procedure TGLLensFlare.PreRenderEvent(Sender: TObject; Var rci: TGLRenderContextInfo);
986
Begin
987
  PreRender(rci.buffer As TGLSceneBuffer);
988
End;
989

990
// PreRenderPointFreed
991

992

993
Procedure TGLLensFlare.PreRenderPointFreed(Sender: TObject);
994
Begin
995
  FPreRenderPoint := nil;
996
End;
997

998
// ------------------------------------------------------------------
999
// ------------------------------------------------------------------
1000
// ------------------------------------------------------------------
1001
Initialization
1002
  // ------------------------------------------------------------------
1003
  // ------------------------------------------------------------------
1004
  // ------------------------------------------------------------------
1005

1006
  RegisterClasses([TGLLensFlare]);
1007

1008
End.
1009

1010

1011

1012

1013

1014

1015

1016

1017

1018

1019

1020

1021

1022

1023

1024

1025

1026

1027

1028