LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
 Applies a blur effect over the viewport.
6
}
7
unit GLBlur;
8

9
interface
10

11
{$I GLScene.inc}
12

13
uses
14
  Classes, SysUtils,  Graphics,
15
   
16
  GLScene, GLVectorGeometry, GLObjects, GLBitmapFont, GLTexture, GLMaterial,
17
  GLHudObjects, GLColor, GLGraphics, GLContext, OpenGLTokens,
18
  XOpenGL, GLState, GLTextureFormat, GLBaseClasses, GLRenderContextInfo;
19

20
type
21

22
  TGLBlurPreset = (pNone, pGlossy, pBeastView, pOceanDepth, pDream, pOverBlur, pAdvancedBlur);
23
  TGLBlurkind = (bNone, bSimple, bAdvanced);
24
  TRGBPixel = record
25
    R, G, B: TGLubyte;
26
  end;
27
  TRGBPixelBuffer = array of TRGBPixel;
28
  TGLAdvancedBlurImagePrepareEvent = procedure(Sender: TObject; BMP32: TGLBitmap32; var DoBlur: boolean) of object;
29

30
  EGLMotionBlurException = class(Exception);
31

32
  TGLBlur = class(TGLHUDSprite)
33
  private
34
    FViewer: TGLMemoryViewer;
35
    OldTime: Double;
36
    FDoingMemView: boolean;
37
    FBlurDeltaTime: Double;
38
    FBlurTop: Single;
39
    FBlurBottom: Single;
40
    FBlurLeft: Single;
41
    FBlurRight: Single;
42
    FRenderHeight: Integer;
43
    FRenderWidth: Integer;
44
    FPreset: TGLBlurPreset;
45
    FTargetObject: TGLbaseSceneObject;
46
    FOnAdvancedBlurImagePrepareEvent: TGLAdvancedBlurImagePrepareEvent;
47
    FBlur: TGLBlurKind;
48
    Pixelbuffer: TRGBPixelBuffer;
49
    FAdvancedBlurPasses: integer;
50
    FOnAfterTargetRender: TNotifyEvent;
51
    FOnBeforeTargetRender: TNotifyEvent;
52
    FAdvancedBlurAmp: single;
53
    FBlurSelf: boolean;
54
    FAdvancedBlurLowClamp: byte;
55
    FAdvancedBlurHiClamp: byte;
56
    FRenderBackgroundColor: TColor;
57
    procedure DoMemView(baseObject: TGLBaseSceneObject);
58
    procedure SetRenderHeight(const Value: Integer);
59
    procedure SetRenderWidth(const Value: Integer);
60
    procedure UpdateImageSettings;
61
    procedure SetPreset(const Value: TGLBlurPreset);
62

63
    function StoreBlurBottom: Boolean;
64
    function StoreBlurDeltaTime: Boolean;
65
    function StoreBlurRight: Boolean;
66
    function StoreBlurTop: Boolean;
67
    function StoreBlurLeft: Boolean;
68
    procedure SetTargetObject(const Value: TGLbaseSceneObject);
69
    procedure SetOnAdvancedBlurImagePrepareEvent(const Value: TGLAdvancedBlurImagePrepareEvent);
70
    procedure SetBlur(const Value: TGLBlurKind);
71
    procedure SetAdvancedBlurPasses(const Value: integer);
72
    procedure SetOnAfterTargetRender(const Value: TNotifyEvent);
73
    procedure SetOnBeforeTargetRender(const Value: TNotifyEvent);
74
    procedure SetAdvancedBlurAmp(const Value: single);
75
    procedure SetBlurSelf(const Value: boolean);
76
    procedure SetAdvancedBlurLowClamp(const Value: byte);
77
    procedure SetAdvancedBlurHiClamp(const Value: byte);
78
    procedure SetRenderBackgroundColor(const Value: TColor);
79
  public
80
    constructor Create(AOwner: TComponent); override;
81
    destructor Destroy; override;
82

83
    procedure DoProgress(const progressTime: TProgressTimes); override;
84
    procedure DoRender(var ARci: TGLRenderContextInfo;
85
      ARenderSelf, ARenderChildren: Boolean); override;
86
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
87
  published
88
    property Blur: TGLBlurKind read FBlur write SetBlur;
89
    property BlurDeltaTime: Double read FBlurDeltaTime write FBlurDeltaTime stored StoreBlurDeltaTime;
90
    property BlurLeft: Single read FBlurLeft write FBlurLeft stored StoreBlurLeft;
91
    property BlurTop: Single read FBlurTop write FBlurTop stored StoreBlurTop;
92
    property BlurRight: Single read FBlurRight write FBlurRight stored StoreBlurRight;
93
    property BlurBottom: Single read FBlurBottom write FBlurBottom stored StoreBlurBottom;
94
    property RenderWidth: Integer read FRenderWidth write SetRenderWidth default 256;
95
    property RenderHeight: Integer read FRenderHeight write SetRenderHeight default 256;
96
    property Preset: TGLBlurPreset read FPreset write SetPreset stored false;
97
    property TargetObject: TGLbaseSceneObject read FTargetObject write SetTargetObject;
98
    property AdvancedBlurPasses: integer read FAdvancedBlurPasses write SetAdvancedBlurPasses;
99
    property AdvancedBlurAmp: single read FAdvancedBlurAmp write SetAdvancedBlurAmp;
100
    property AdvancedBlurLowClamp: byte read FAdvancedBlurLowClamp write SetAdvancedBlurLowClamp;
101
    property AdvancedBlurHiClamp: byte read FAdvancedBlurHiClamp write SetAdvancedBlurHiClamp;
102
    property BlurSelf: boolean read FBlurSelf write SetBlurSelf;
103
    property RenderBackgroundColor: TColor read FRenderBackgroundColor write SetRenderBackgroundColor;
104
    property OnAdvancedBlurImagePrepareEvent: TGLAdvancedBlurImagePrepareEvent read FOnAdvancedBlurImagePrepareEvent write SetOnAdvancedBlurImagePrepareEvent;
105
    property OnBeforeTargetRender: TNotifyEvent read FOnBeforeTargetRender write SetOnBeforeTargetRender;
106
    property OnAfterTargetRender: TNotifyEvent read FOnAfterTargetRender write SetOnAfterTargetRender;
107
  end;
108

109
  {
110
    This component blurs everything thatis rendered BEFORE it. So if you want part
111
    of your scene blured, the other not blured, make sure that the other part is
112
    rendered after this component. It is fast and does not require shaders.
113

114
    Note: it is FPS-dependant. Also also can produce a "blury trail effect", which
115
    stays on the screen until something new is rendered over it. It can be overcome
116
    by changing the Material.FrontProperties.Diffuse property. This, however, also
117
    has a drawback - the picture becomes more blured altogether. For example, if
118
    your backgroud color is Black, set the Material.FrontProperties.Diffuse to White.
119
    If it is White, set Material.FrontProperties.Diffuse to Black. I haven't tried
120
    any others, but I hope you get the idea ;)
121

122
    I've seen this effect in different Bruring components, even in shaders, but if
123
    anyone knows another way to fix this issue - please post it on the glscene
124
    newsgroup.
125
  }
126
  TGLMotionBlur = class(TGLCustomSceneObject, IGLInitializable)
127
  private
128
    FIntensity: Single;
129
    function StoreIntensity: Boolean;
130
  protected
131
    procedure DoOnAddedToParent; override;
132
    procedure InitializeObject(ASender: TObject; const ARci: TGLRenderContextInfo); virtual;
133
  public
134
    { This function is only valid AFTER OpenGL has been initialized. }
135
    function SupportsRequiredExtensions: Boolean;
136
    procedure DoRender(var ARci: TGLRenderContextInfo; ARenderSelf, ARenderChildren: Boolean); override;
137
    constructor Create(aOwner: TComponent); override;
138
    procedure Assign(Source: TPersistent); override;
139
  published
140
    // The more the intensity, the more blur you have.
141
    property Intensity: Single read FIntensity write FIntensity stored StoreIntensity;
142

143
    // From TGLBaseSceneObject.
144
    property Visible;
145
    property OnProgress;
146
    property Behaviours;
147
    property Effects;
148
    property Hint;
149
  end;
150

151
implementation
152

153
const
154
  EPS = 0.001;
155

156
constructor TGLBlur.Create(AOwner: TComponent);
157
begin
158
  inherited;
159
  FBlurDeltaTime := 0.02;
160
  FBlurTop := 0.01;
161
  FBlurLeft := 0.01;
162
  FBlurRight := 0.01;
163
  FBlurBottom := 0.01;
164
  FRenderHeight := 256;
165
  FRenderWidth := 256;
166
  FViewer := TGLMemoryViewer.Create(Self);
167
  FPreset := pNone;
168
  Material.Texture.Disabled := False;
169
  FAdvancedBlurPasses := 1;
170
  FAdvancedBlurAmp := 1.1;
171
  FBlurSelf := true;
172
  FAdvancedBlurLowClamp := 0;
173
  FAdvancedBlurHiClamp := 255;
174
  FRenderBackgroundColor := ClBlack;
175
end;
176

177
destructor TGLBlur.Destroy;
178
begin
179
  FViewer.Free;
180
  inherited;
181
end;
182

183
procedure TGLBlur.UpdateImageSettings;
184
var
185
  B: TBitmap;
186
begin
187
  if Material.Texture.Image is TGLBlankImage then
188
    with TGLBlankImage(Material.Texture.Image) do
189
    begin
190
      Width := RenderWidth;
191
      Height := Renderheight;
192
    end
193
  else if Material.Texture.Image is TGLPersistentImage then
194
  begin
195
    B := TGLPersistentImage(Material.Texture.Image).Picture.Bitmap;
196
    B.Width := 0;
197
    B.Height := 0;
198
    B.Width := RenderWidth;
199
    B.Height := RenderHeight;
200
  end;
201

202
  with FViewer do
203
  begin
204
    Width := RenderWidth;
205
    Height := Renderheight;
206
  end;
207

208
  SetLength(Pixelbuffer, RenderWidth * RenderHeight);
209
end;
210

211
procedure TGLBlur.DoProgress(const progressTime: TProgressTimes);
212
begin
213
  inherited;
214
  if self.Visible and (progressTime.newTime - OldTime > FBlurDeltaTime) then
215
  begin
216
    OldTime := progressTime.newTime;
217
    if TargetObject <> nil then
218
      DoMemView(TargetObject);
219
  end;
220

221
end;
222

223
procedure TGLBlur.DoMemView(baseObject: TGLBaseSceneObject);
224
var
225
  OldFocalLength: single;
226
  refsiz: single;
227
  BMP: TGLBitmap32;
228
  x, y: integer;
229
  line: PGLPixel32Array;
230
  by: Integer;
231
  bp: Integer;
232
  DoBlur: Boolean;
233

234
  procedure ApplyBlur(const passes: integer);
235
  var
236
    t: integer;
237
    x, y: integer;
238
    lin, linu, lind, linuu, lindd: PGLPixel32Array;
239
    r, g, b: single;
240
    ir, ig, ib: Smallint;
241

242
    procedure ApplyBlurClampAndSetPixel;
243
    begin
244
      // 0.1111 = 1/7 (where 7 is the times each pixel is summed with neighbours or self)
245
      ir := round(r * FAdvancedBlurAmp * 0.1111);
246
      ig := round(g * FAdvancedBlurAmp * 0.1111);
247
      ib := round(b * FAdvancedBlurAmp * 0.1111);
248

249
      // Hi Clamp
250
      if ir > FAdvancedBlurHiClamp then
251
        ir := FAdvancedBlurHiClamp;
252
      if ig > FAdvancedBlurHiClamp then
253
        ig := FAdvancedBlurHiClamp;
254
      if ib > FAdvancedBlurHiClamp then
255
        ib := FAdvancedBlurHiClamp;
256

257
      lin^[x].r := ir;
258
      lin^[x].g := ig;
259
      lin^[x].b := ib;
260
    end;
261

262
  begin
263

264
    for t := 0 to passes do
265
    begin
266
      for y := 2 to BMP.Height - 3 do
267
      begin
268
        linuu := BMP.ScanLine[y - 2];
269
        linu := BMP.ScanLine[y - 1];
270
        lin := BMP.ScanLine[y];
271
        lind := BMP.ScanLine[y + 1];
272
        lindd := BMP.ScanLine[y + 2];
273
        by := y * BMP.Height;
274
        // X = 0 PART:
275
        x := 0;
276
        r := lin^[x].r + lin^[x + 1].r + lin^[x + 2].r + linu^[x].r + lind^[x].r + linuu^[x].r + lindd^[x].r;
277
        g := lin^[x].g + lin^[x + 1].g + lin^[x + 2].g + linu^[x].g + lind^[x].g + linuu^[x].g + lindd^[x].g;
278
        b := lin^[x].b + lin^[x + 1].b + lin^[x + 2].b + linu^[x].b + lind^[x].b + linuu^[x].b + lindd^[x].b;
279
        ApplyBlurClampAndSetPixel;
280
        // X = 1 PART:
281
        x := 1;
282
        r := lin^[x].r + lin^[x + 1].r + lin^[x - 1].r + lin^[x + 2].r + linu^[x].r + lind^[x].r + linuu^[x].r + lindd^[x].r;
283
        g := lin^[x].g + lin^[x + 1].g + lin^[x - 1].g + lin^[x + 2].g + linu^[x].g + lind^[x].g + linuu^[x].g + lindd^[x].g;
284
        b := lin^[x].b + lin^[x + 1].b + lin^[x - 1].b + lin^[x + 2].b + linu^[x].b + lind^[x].b + linuu^[x].b + lindd^[x].b;
285
        ApplyBlurClampAndSetPixel;
286
        // ALL X IN MIDDLE PART:
287
        for x := 2 to BMP.Width - 3 do
288
        begin
289
          r := lin^[x].r + lin^[x + 1].r + lin^[x - 1].r + lin^[x + 2].r + lin^[x - 2].r + linu^[x].r + lind^[x].r + linuu^[x].r + lindd^[x].r;
290
          g := lin^[x].g + lin^[x + 1].g + lin^[x - 1].g + lin^[x + 2].g + lin^[x - 2].g + linu^[x].g + lind^[x].g + linuu^[x].g + lindd^[x].g;
291
          b := lin^[x].b + lin^[x + 1].b + lin^[x - 1].b + lin^[x + 2].b + lin^[x - 2].b + linu^[x].b + lind^[x].b + linuu^[x].b + lindd^[x].b;
292
          ApplyBlurClampAndSetPixel;
293
        end;
294
        //X = NEXT TO LAST PART:
295
        x := BMP.Width - 2;
296
        r := lin^[x].r + lin^[x + 1].r + lin^[x - 1].r + lin^[x - 2].r + linu^[x].r + lind^[x].r + linuu^[x].r + lindd^[x].r;
297
        g := lin^[x].g + lin^[x + 1].g + lin^[x - 1].g + lin^[x - 2].g + linu^[x].g + lind^[x].g + linuu^[x].g + lindd^[x].g;
298
        b := lin^[x].b + lin^[x + 1].b + lin^[x - 1].b + lin^[x - 2].b + linu^[x].b + lind^[x].b + linuu^[x].b + lindd^[x].b;
299
        ApplyBlurClampAndSetPixel;
300
        //X = LAST PART:
301
        x := BMP.Width - 1;
302
        r := lin^[x].r + lin^[x - 1].r + lin^[x - 2].r + linu^[x].r + lind^[x].r + linuu^[x].r + lindd^[x].r;
303
        g := lin^[x].g + lin^[x - 1].g + lin^[x - 2].g + linu^[x].g + lind^[x].g + linuu^[x].g + lindd^[x].g;
304
        b := lin^[x].b + lin^[x - 1].b + lin^[x - 2].b + linu^[x].b + lind^[x].b + linuu^[x].b + lindd^[x].b;
305
        ApplyBlurClampAndSetPixel;
306
      end;
307
    end;
308
  end;
309

310
begin
311
  if FViewer.Camera <> Scene.CurrentGLCamera then
312
    FViewer.Camera := Scene.CurrentGLCamera;
313

314
  if FViewer.Camera <> nil then
315
  begin
316
    FDoingMemView := true;
317

318
    //Scene.RenderScene(FViewer.Buffer,FViewer.Width,FViewer.Height,dsRendering,baseObject);
319
    FViewer.Camera.BeginUpdate;
320

321
    OldFocalLength := FViewer.Camera.FocalLength;
322

323
    // CALCULATE SCALED FOCAL LENGTH FOR VIEWER
324
    if SCene.CurrentBuffer.Width > SCene.CurrentBuffer.height then
325
      refsiz := Scene.CurrentBuffer.Width
326
    else
327
      refsiz := Scene.CurrentBuffer.height;
328

329
    FViewer.Camera.FocalLength := FViewer.Camera.FocalLength * FViewer.Buffer.Width / refsiz;
330

331
    if FViewer.Buffer.BackgroundColor <> FRenderBackgroundColor then
332
      FViewer.Buffer.BackgroundColor := FRenderBackgroundColor;
333

334
    try
335
      case FBlur of
336
        bNone:
337
          begin
338
            // do nothing
339
          end;
340
        bSimple:
341
          begin
342
            if Assigned(FOnBeforeTargetRender) then
343
              FOnBeforeTargetRender(self);
344
            // RENDER
345
            FViewer.Render(baseObject);
346
            // Copy to texture (unfortunatelly, after this, the bitmap cannot be red back from the hardware.. i think)
347
            FViewer.CopyToTexture(Material.Texture);
348
            if Assigned(FOnAfterTargetRender) then
349
              FOnAfterTargetRender(self);
350
          end;
351
        bAdvanced:
352
          begin
353
            if Assigned(FOnBeforeTargetRender) then
354
              FOnBeforeTargetRender(self);
355

356
            // RENDER
357
            FViewer.Render(baseObject);
358
            // Read pixels from buffer. This is slow, but ok with reasonably small render size.
359
            FViewer.Buffer.RenderingContext.Activate;
360
            try
361
              GL.ReadPixels(0, 0, FViewer.Buffer.Width, FViewer.Buffer.Height, GL_RGB, GL_UNSIGNED_BYTE, Pixelbuffer);
362
            except
363
              FViewer.Buffer.RenderingContext.Deactivate;
364
            end;
365
            if Assigned(FOnAfterTargetRender) then
366
              FOnAfterTargetRender(self);
367

368
            BMP := Material.Texture.Image.GetBitmap32;
369
            BMP.Narrow;
370
            FViewer.Buffer.RenderingContext.Deactivate;
371
            // FILLS THE BITMAP with the pixelbuffer captured from the internal memoryViewer
372
            for y := 0 to RenderHeight - 1 do
373
            begin
374
              line := BMP.ScanLine[y];
375
              by := y * RenderHeight;
376
              for x := 0 to RenderWidth - 1 do
377
              begin
378
                bp := x + by;
379
                line^[x].r := Pixelbuffer[bp].R;
380
                line^[x].g := Pixelbuffer[bp].G;
381
                line^[x].b := Pixelbuffer[bp].B;
382

383
                // Low clamp
384
                if line^[x].r < FAdvancedBlurLowClamp then
385
                  line^[x].r := 0;
386
                if line^[x].g < FAdvancedBlurLowClamp then
387
                  line^[x].g := 0;
388
                if line^[x].b < FAdvancedBlurLowClamp then
389
                  line^[x].b := 0;
390
              end;
391
            end;
392

393
            DoBlur := true;
394
            if Assigned(FOnAdvancedBlurImagePrepareEvent) then
395
            begin
396
              FOnAdvancedBlurImagePrepareEvent(self, BMP, DoBlur);
397
            end;
398

399
            if DoBlur then
400
              ApplyBlur(FAdvancedBlurPasses);
401

402
            Material.Texture.Image.NotifyChange(self);
403

404
          end;
405
      end;
406
    finally
407
      FViewer.Camera.FocalLength := OldFocalLength;
408
      FViewer.Camera.EndUpdate;
409
      FDoingMemView := false;
410
    end;
411
  end;
412
end;
413

414
{$WARNINGS Off} //Suppress "unsafe" warning
415

416
procedure TGLBlur.DoRender(var ARci: TGLRenderContextInfo;
417
  ARenderSelf, ARenderChildren: Boolean);
418
var
419
  vx, vy, vx1, vy1, f: Single;
420
  offsx, offsy: single;
421
  MaxMeasure: integer;
422
begin
423
  if FDoingMemView and (FBlurSelf = false) then
424
    Exit;
425
  if (csDesigning in ComponentState) then
426
  begin
427
    if Count > 0 then
428
      Self.RenderChildren(0, Count - 1, ARci);
429
    exit;
430
  end;
431
  if ARci.ignoreMaterials then
432
    Exit;
433
  GL.CheckError;
434
  Material.Apply(ARci);
435
  GL.CheckError;
436
  repeat
437
    if AlphaChannel <> 1 then
438
      ARci.GLStates.SetGLMaterialAlphaChannel(GL_FRONT, AlphaChannel);
439
    // Prepare matrices
440
    GL.MatrixMode(GL_MODELVIEW);
441
    GL.PushMatrix;
442
    GL.LoadMatrixf(@TGLSceneBuffer(ARci.buffer).BaseProjectionMatrix);
443
    if ARci.renderDPI = 96 then
444
      f := 1
445
    else
446
      f := ARci.renderDPI / 96;
447
    GL.Scalef(2 / ARci.viewPortSize.cx, 2 / ARci.viewPortSize.cy, 1);
448

449
    // center of viewport:
450
    GL.Translatef(0, 0, Position.Z);
451

452
    if Rotation <> 0 then
453
      GL.Rotatef(Rotation, 0, 0, 1);
454
    GL.MatrixMode(GL_PROJECTION);
455
    GL.PushMatrix;
456
    GL.LoadIdentity;
457
    ARci.GLStates.Disable(stDepthTest);
458
    ARci.GLStates.DepthWriteMask := False;
459

460
    // calculate offsets in order to keep the quad a square centered in the view
461
    if ARci.viewPortSize.cx > ARci.viewPortSize.cy then
462
    begin
463
      offsx := 0;
464
      offsy := (ARci.viewPortSize.cx - ARci.viewPortSize.cy) * 0.5;
465
      MaxMeasure := ARci.viewPortSize.cx;
466
    end
467
    else
468
    begin
469
      offsx := (ARci.viewPortSize.cy - ARci.viewPortSize.cx) * 0.5;
470
      offsy := 0;
471
      MaxMeasure := ARci.viewPortSize.cy;
472
    end;
473

474
    // precalc coordinates
475
    vx := -ARci.viewPortSize.cx * 0.5 * f;
476
    vx1 := vx + ARci.viewPortSize.cx * f;
477
    vy := +ARci.viewPortSize.cy * 0.5 * f;
478
    vy1 := vy - ARci.viewPortSize.cy * f;
479

480
    vx := vx - offsx;
481
    vx1 := vx1 + offsx;
482
    vy := vy + offsy;
483
    vy1 := vy1 - offsy;
484

485
    // Cause the radial scaling
486
    if FDoingMemView then
487
    begin
488
      vx := vx - FBlurLeft * MaxMeasure;
489
      vx1 := vx1 + FBlurRight * MaxMeasure;
490
      vy := vy + FBlurTop * MaxMeasure;
491
      vy1 := vy1 - FBlurBottom * MaxMeasure;
492
    end;
493

494
    // issue quad
495
    GL.Begin_(GL_QUADS);
496
    GL.Normal3fv(@YVector);
497
    GL.TexCoord2f(0, 0);
498
    GL.Vertex2f(vx, vy1);
499
    GL.TexCoord2f(XTiles, 0);
500
    GL.Vertex2f(vx1, vy1);
501
    GL.TexCoord2f(XTiles, YTiles);
502
    GL.Vertex2f(vx1, vy);
503
    GL.TexCoord2f(0, YTiles);
504
    GL.Vertex2f(vx, vy);
505
    GL.End_;
506
    // restore state
507
    GL.PopMatrix;
508
    GL.MatrixMode(GL_MODELVIEW);
509
    GL.PopMatrix;
510
  until not Material.UnApply(ARci);
511
  if Count > 0 then
512
    Self.RenderChildren(0, Count - 1, ARci);
513
end;
514

515
procedure TGLBlur.Notification(AComponent: TComponent; Operation: TOperation);
516
begin
517
  inherited;
518
  if Operation = opRemove then
519
    if AComponent = FTargetObject then
520
      FTargetObject := nil;
521
  inherited;
522
end;
523

524
{$WARNINGS On}
525

526
procedure TGLBlur.SetRenderBackgroundColor(const Value: TColor);
527
begin
528
  FRenderBackgroundColor := Value;
529
end;
530

531
procedure TGLBlur.SetRenderHeight(const Value: integer);
532
begin
533
  FRenderHeight := Value;
534
  UpdateImageSettings;
535
end;
536

537
procedure TGLBlur.SetRenderWidth(const Value: integer);
538
begin
539
  FRenderWidth := Value;
540
  UpdateImageSettings;
541
end;
542

543
procedure TGLBlur.SetTargetObject(const Value: TGLbaseSceneObject);
544
begin
545
  FTargetObject := Value;
546
end;
547

548
procedure TGLBlur.SetAdvancedBlurAmp(const Value: single);
549
begin
550
  FAdvancedBlurAmp := Value;
551
end;
552

553
procedure TGLBlur.SetAdvancedBlurHiClamp(const Value: byte);
554
begin
555
  FAdvancedBlurHiClamp := Value;
556
end;
557

558
procedure TGLBlur.SetAdvancedBlurLowClamp(const Value: byte);
559
begin
560
  FAdvancedBlurLowClamp := Value;
561
end;
562

563
procedure TGLBlur.SetAdvancedBlurPasses(const Value: integer);
564
begin
565
  FAdvancedBlurPasses := Value;
566
end;
567

568
procedure TGLBlur.SetBlur(const Value: TGLBlurKind);
569
begin
570
  if FBlur <> Value then
571
  begin
572
    case Value of
573
      bnone:
574
        begin
575
          // do Nothing
576
        end;
577
      bSimple:
578
        begin
579
          Material.Texture.ImageClassName := TGLBlankImage.ClassName;
580
        end;
581
      bAdvanced:
582
        begin
583
          Material.Texture.ImageClassName := TGLPersistentImage.ClassName;
584
        end;
585
    end;
586
    UpdateImageSettings;
587
  end;
588
  FBlur := Value;
589
end;
590

591
procedure TGLBlur.SetBlurSelf(const Value: boolean);
592
begin
593
  FBlurSelf := Value;
594
end;
595

596
procedure TGLBlur.SetOnAdvancedBlurImagePrepareEvent(const Value: TGLAdvancedBlurImagePrepareEvent);
597
begin
598
  FOnAdvancedBlurImagePrepareEvent := Value;
599
end;
600

601
procedure TGLBlur.SetOnAfterTargetRender(const Value: TNotifyEvent);
602
begin
603
  FOnAfterTargetRender := Value;
604
end;
605

606
procedure TGLBlur.SetOnBeforeTargetRender(const Value: TNotifyEvent);
607
begin
608
  FOnBeforeTargetRender := Value;
609
end;
610

611
procedure TGLBlur.SetPreset(const Value: TGLBlurPreset);
612
begin
613
  FPreset := Value;
614

615
  case FPreset of
616
    pNone:
617
      begin
618
        // do nothing
619
      end;
620
    pAdvancedBlur:
621
      begin
622
        Blur := bAdvanced;
623
        Material.BlendingMode := bmAdditive;
624
        Material.FrontProperties.Diffuse.SetColor(1, 1, 1, 1);
625
        BlurTop := 0;
626
        BlurLeft := 0;
627
        BlurRight := 0;
628
        BlurBottom := 0;
629
        BlurDeltaTime := 0;
630
        BlurSelf := false;
631
        AdvancedBlurPasses := 1;
632
        AdvancedBlurAmp := 1.2;
633
        RenderWidth := 64;
634
        RenderHeight := 64;
635
      end;
636
    pGlossy:
637
      begin
638
        Material.BlendingMode := bmAdditive;
639
        Material.FrontProperties.Diffuse.SetColor(1, 1, 1, 0.7);
640
        BlurTop := 0.02;
641
        BlurLeft := 0.02;
642
        BlurRight := 0.02;
643
        BlurBottom := 0.02;
644
        BlurDeltaTime := 0.02;
645
        BlurSelf := true;
646
      end;
647
    pBeastView:
648
      begin
649
        Blur := bSimple;
650
        Material.BlendingMode := bmAdditive;
651
        Material.FrontProperties.Diffuse.SetColor(1, 0, 0, 0.8);
652
        BlurTop := 0.001;
653
        BlurLeft := 0.03;
654
        BlurRight := 0.03;
655
        BlurBottom := 0.001;
656
        BlurDeltaTime := 0.02;
657
        BlurSelf := true;
658
      end;
659
    pOceanDepth:
660
      begin
661
        Blur := bSimple;
662
        Material.BlendingMode := bmTransparency;
663
        Material.FrontProperties.Diffuse.SetColor(0.2, 0.2, 1, 0.99);
664
        BlurTop := 0.04;
665
        BlurLeft := 0.02;
666
        BlurRight := 0.02;
667
        BlurBottom := 0.04;
668
        BlurDeltaTime := 0.02;
669
        BlurSelf := true;
670
      end;
671
    pDream:
672
      begin
673
        Blur := bSimple;
674
        Material.BlendingMode := bmTransparency;
675
        Material.FrontProperties.Diffuse.SetColor(1, 1, 1, 0.992);
676
        BlurTop := 0.02;
677
        BlurLeft := 0.02;
678
        BlurRight := 0.02;
679
        BlurBottom := 0.02;
680
        BlurDeltaTime := 0.1;
681
        BlurSelf := true;
682
      end;
683
    pOverBlur:
684
      begin
685
        Blur := bSimple;
686
        Material.BlendingMode := bmAdditive;
687
        Material.FrontProperties.Diffuse.SetColor(0.95, 0.95, 0.95, 0.98);
688
        BlurTop := 0.01;
689
        BlurLeft := 0.01;
690
        BlurRight := 0.01;
691
        BlurBottom := 0.01;
692
        BlurDeltaTime := 0.02;
693
        BlurSelf := true;
694
      end;
695
  end;
696

697
end;
698

699
function TGLBlur.StoreBlurBottom: Boolean;
700
begin
701
  Result := Abs(FBlurBottom - 0.01) > EPS;
702
end;
703

704
function TGLBlur.StoreBlurDeltaTime: Boolean;
705
begin
706
  Result := Abs(FBlurDeltaTime - 0.02) > EPS;
707
end;
708

709
function TGLBlur.StoreBlurLeft: Boolean;
710
begin
711
  Result := Abs(FBlurLeft - 0.01) > EPS;
712
end;
713

714
function TGLBlur.StoreBlurRight: Boolean;
715
begin
716
  Result := Abs(FBlurRight - 0.01) > EPS;
717
end;
718

719
function TGLBlur.StoreBlurTop: Boolean;
720
begin
721
  Result := Abs(FBlurTop - 0.01) > EPS;
722
end;
723

724
{ TGLMotionBlur }
725

726
procedure TGLMotionBlur.Assign(Source: TPersistent);
727
begin
728
  inherited;
729
  if Source is TGLMotionBlur then
730
  begin
731
    FIntensity := TGLMotionBlur(Source).FIntensity;
732
  end;
733
end;
734

735
constructor TGLMotionBlur.Create(aOwner: TComponent);
736
begin
737
  inherited Create(aOwner);
738
  Material.FrontProperties.Diffuse.Initialize(clrBlack);
739
  Material.MaterialOptions := [moNoLighting, moIgnoreFog];
740
  Material.Texture.Disabled := False;
741
  Material.BlendingMode := bmTransparency;
742
  FIntensity := 0.975;
743
end;
744

745
procedure TGLMotionBlur.DoOnAddedToParent;
746
begin
747
  inherited;
748
  // Request to be initialized on next render.
749
  if Scene <> nil then
750
    Scene.InitializableObjects.Add(Self);
751
end;
752

753
procedure TGLMotionBlur.DoRender(var ARci: TGLRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
754
begin
755
  if not (ARci.ignoreMaterials or (csDesigning in ComponentState) or
756
    (ARci.drawState = dsPicking)) then
757
  with ARci.GLStates do
758
  begin
759
    ARci.ignoreDepthRequests := True;
760
    Material.Apply(ARci);
761
    ActiveTextureEnabled[ttTextureRect] := True;
762
    GL.MatrixMode(GL_PROJECTION);
763
    GL.PushMatrix;
764
    GL.LoadIdentity;
765
    GL.Ortho(0, ARci.viewPortSize.cx, ARci.viewPortSize.cy, 0, 0, 1);
766
    GL.MatrixMode(GL_MODELVIEW);
767
    GL.PushMatrix;
768
    GL.LoadIdentity;
769
    Disable(stDepthTest);
770
    DepthWriteMask := False;
771

772
    GL.Begin_(GL_QUADS);
773
    GL.TexCoord2f(0.0, ARci.viewPortSize.cy);
774
    GL.Vertex2f(0, 0);
775
    GL.TexCoord2f(0.0, 0.0);
776
    GL.Vertex2f(0, ARci.viewPortSize.cy);
777
    GL.TexCoord2f(ARci.viewPortSize.cx, 0.0);
778
    GL.Vertex2f(ARci.viewPortSize.cx, ARci.viewPortSize.cy);
779
    GL.TexCoord2f(ARci.viewPortSize.cx, ARci.viewPortSize.cy);
780
    GL.Vertex2f(ARci.viewPortSize.cx, 0);
781
    GL.End_;
782

783
    GL.PopMatrix;
784
    GL.MatrixMode(GL_PROJECTION);
785
    GL.PopMatrix;
786
    GL.MatrixMode(GL_MODELVIEW);
787
    ActiveTextureEnabled[ttTextureRect] := False;
788
    Material.UnApply(ARci);
789
    ARci.ignoreDepthRequests := False;
790

791
    GL.CopyTexImage2D(GL_TEXTURE_RECTANGLE, 0, GL_RGB, 0, 0, ARci.viewPortSize.cx, ARci.viewPortSize.cy, 0);
792

793
    Material.FrontProperties.Diffuse.Alpha := FIntensity;
794
  end;
795

796
  if Count <> 0 then
797
    Self.RenderChildren(0, Count - 1, ARci);
798
end;
799

800
procedure TGLMotionBlur.InitializeObject(ASender: TObject;
801
  const ARci: TGLRenderContextInfo);
802
begin
803
  // If extension is not supported, silently disable this component.
804
  if not (csDesigning in ComponentState) then
805
    if not SupportsRequiredExtensions then
806
      Visible := False;
807
end;
808

809
function TGLMotionBlur.StoreIntensity: Boolean;
810
begin
811
  Result := Abs(FIntensity - 0.975) > EPS;
812
end;
813

814
function TGLMotionBlur.SupportsRequiredExtensions: Boolean;
815
begin
816
  Result :=
817
    GL.ARB_texture_rectangle or GL.EXT_texture_rectangle or GL.NV_texture_rectangle;
818
end;
819

820
// ------------------------------------------------------------------
821
// ------------------------------------------------------------------
822
// ------------------------------------------------------------------
823
initialization
824
  // ------------------------------------------------------------------
825
  // ------------------------------------------------------------------
826
  // ------------------------------------------------------------------
827

828
     // class registrations
829
  RegisterClass(TGLBlur);
830
  RegisterClass(TGLMotionBlur);
831

832
end.
833

834