LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Post shaders that simulate shader visions for a mask or the entire scene.
6

7
    History :  
8
     04/11/15 - PW - Combined all post shaders into GLSLPostShaders unit
9
     01/11/15 - J.Delauney - Initial versions for
10
                                GLSLPostThermalVisionShader
11
                                GLSLPostDreamVisionShader
12
                                GLSLPostNightVisionShader
13
                                GLSLPostPixelateShader
14
                                GLSLPostPosterizeShader
15
                                GLSLPostFrostShader
16
                                GLSLPostTroubleShader
17
     05/04/07 - DaStr - Initial version for GLSLPostBlurShader
18
                           based on RenderMonkey demo
19
}
20
unit GLSLPostShaders;
21

22
interface
23

24
{$I GLScene.inc}
25

26
uses
27
  Classes,
28
   
29
  GLTexture, GLScene, GLVectorGeometry, GLContext, GLMaterial,
30
  GLSLShader, GLCustomShader, GLRenderContextInfo, GLTextureFormat,
31
  GLVectorTypes;
32

33
  //TGLCustomGLSLPostBlurShader
34
  //
35
  { Custom class for GLSLPostBlurShader.
36
   A shader that blurs the entire scene }
37
type
38
  TGLCustomGLSLPostBlurShader = class(TGLCustomGLSLShader, IGLPostShader)
39
  private
40
    FThreshold: Single;
41

42
    // Implementing IGLPostShader.
43
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;
44
      TextureTarget: TGLTextureTarget);
45
    function GetTextureTarget: TGLTextureTarget;
46
    function StoreThreshold: Boolean;
47
  protected
48
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
49
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
50
  public
51
    constructor Create(AOwner: TComponent); override;
52

53
    property Threshold: Single read FThreshold write FThreshold stored StoreThreshold;
54
  end;
55

56
  TGLSLPostBlurShader = class(TGLCustomGLSLPostBlurShader)
57
  published
58
    property Threshold;
59
  end;
60

61

62
  //TGLCustomGLSLPostThermalVisionShader
63
  //
64
  { Custom class for GLSLPostThermalVisionShader.
65
   A Shader that simulate a thermal vision of the entire scene }
66

67
type
68
  { A shader that simulate a Thermal Vision of the entire scene}
69
  TGLCustomGLSLPostThermalVisionShader = class(TGLCustomGLSLShader, IGLPostShader)
70
  private
71

72
    FThreshold : Single;
73
    Fintensity : Single;
74

75
    // Implementing IGLPostShader.
76
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
77
    function GetTextureTarget: TGLTextureTarget;
78

79
    function StoreThreshold: Boolean;
80
    function StoreIntensity: Boolean;
81

82
  protected
83
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
84
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
85
  public
86
    constructor Create(AOwner: TComponent); override;
87

88
     property Threshold: Single read FThreshold write FThreshold stored StoreThreshold;
89
     property Intensity: Single read FIntensity write FIntensity stored StoreIntensity;
90
  end;
91

92
  TGLSLPostThermalVisionShader = class(TGLCustomGLSLPostThermalVisionShader)
93
  published
94
    property Threshold;
95
    property Intensity;
96
  end;
97

98

99
  //TGLCustomGLSLPostDreamVisionShader
100
  //
101
  { Custom class for GLSLPostDreamVisionShader.
102
   A shader that simulate a grayscale threshold vision (aka dream) of the entire scene}
103
type
104
  TGLCustomGLSLPostDreamVisionShader = class(TGLCustomGLSLShader, IGLPostShader)
105
  private
106

107
    FThreshold : Single; // In percent 0..100;
108

109
    // Implementing IGLPostShader.
110
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
111
    function GetTextureTarget: TGLTextureTarget;
112

113
   function StoreThreshold: Boolean;
114

115
  protected
116
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
117
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
118
  public
119
    constructor Create(AOwner: TComponent); override;
120

121
     property Threshold: Single read FThreshold write FThreshold stored StoreThreshold;
122
  end;
123

124
  TGLSLPostDreamVisionShader = class(TGLCustomGLSLPostDreamVisionShader)
125
  published
126
    property Threshold;
127
  end;
128

129

130
  //TGLCustomGLSLPostNightVisionShader
131
  //
132
  { Custom class for GLSLPostNightVisionShader.
133
   A shader that simulate a Night Vision of the scene throw a mask if enabled,
134
   or of the entire scene}
135

136
type
137
  TGLCustomGLSLPostNightVisionShader = class(TGLCustomGLSLShader, IGLPostShader)
138
  private
139
    FMaterialLibrary: TGLAbstractMaterialLibrary;
140

141
    FLuminanceThreshold: Single;
142
    FColorAmplification:Single;
143
    FElapsedTime : Single;
144
    FUseMask : Integer;
145
    FNoiseTex : TGLTexture;
146
    FMaskTex : TGLTexture;
147
    FNoiseTexName  : TGLLibMaterialName;
148
    FMaskTexName        : TGLLibMaterialName;
149

150
    // Implementing IGLPostShader.
151
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
152
    function GetTextureTarget: TGLTextureTarget;
153

154
    function StoreLuminanceThreshold: Boolean;
155
    function StoreColorAmplification: Boolean;
156

157
    procedure SetMaskTexTexture(const Value: TGLTexture);
158
    procedure SetNoiseTexTexture(const Value: TGLTexture);
159

160
    function GetNoiseTexName: TGLLibMaterialName;
161
    procedure SetNoiseTexName(const Value: TGLLibMaterialName);
162
    function GetMaskTexName: TGLLibMaterialName;
163
    procedure SetMaskTexName(const Value: TGLLibMaterialName);
164

165
    function GetMaterialLibrary: TGLAbstractMaterialLibrary;
166

167
  protected
168
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
169
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
170

171
    procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual;
172
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
173

174
  public
175
    constructor Create(AOwner: TComponent); override;
176

177
    property LuminanceThreshold: Single read FLuminanceThreshold write FLuminanceThreshold stored StoreLuminanceThreshold;
178
    property ColorAmplification: Single read FColorAmplification write FColorAmplification stored StoreColorAmplification;
179
    property ElapsedTime: Single read FElapsedTime write FElapsedTime stored false;
180

181
    property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary;
182
    property NoiseTex: TGLTexture read FNoiseTex write SetNoiseTexTexture;
183
    property NoiseTexName: TGLLibMaterialName read GetNoiseTexName write SetNoiseTexName;
184
    property MaskTex: TGLTexture read FMaskTex write SetMaskTexTexture;
185
    property MaskTexName: TGLLibMaterialName read GetMaskTexName write SetMaskTexName;
186
    property UseMask : Integer read FUseMask write FUseMask;
187
  end;
188

189
  TGLSLPostNightVisionShader = class(TGLCustomGLSLPostNightVisionShader)
190
  published
191
    property LuminanceThreshold;
192
    property ColorAmplification;
193
    property ElapsedTime;
194
    property MaterialLibrary;
195
    property NoiseTexName;
196
    property MaskTexName;
197
    property UseMask;
198
  end;
199

200
  //TGLCustomGLSLPostPixelateShader
201
  //
202
  { Custom class for GLSLPostPixelateShader.
203
   A shader that pixelate of the entire scene}
204
type
205
  TGLCustomGLSLPostPixelateShader = class(TGLCustomGLSLShader, IGLPostShader)
206
  private
207

208
    FPixelWidth  : Single;
209
    FPixelHeight : Single;
210

211
    // Implementing IGLPostShader.
212
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
213
    function GetTextureTarget: TGLTextureTarget;
214

215
    function StorePixelWidth: Boolean;
216
    function StorePixelHeight: Boolean;
217

218
  protected
219
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
220
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
221
  public
222
    constructor Create(AOwner: TComponent); override;
223

224
     property PixelWidth: Single read FPixelWidth write FPixelWidth stored StorePixelWidth;
225
     property PixelHeight: Single read FPixelHeight write FPixelHeight stored StorePixelHeight;
226
  end;
227

228
  TGLSLPostPixelateShader = class(TGLCustomGLSLPostPixelateShader)
229
  published
230
    property PixelWidth;
231
    property PixelHeight;
232
  end;
233

234
  //TGLCustomGLSLPostPosterizeShader
235
  //
236
  { Custom class for GLSLPostPosterizeShader.
237
   A shader that posterize of the entire scene}
238
type
239
  TGLCustomGLSLPostPosterizeShader = class(TGLCustomGLSLShader, IGLPostShader)
240
  private
241

242
    FGamma  : Single;
243
    FNumColors : Single;
244

245
    // Implementing IGLPostShader.
246
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
247
    function GetTextureTarget: TGLTextureTarget;
248

249
    function StoreGamma: Boolean;
250
    function StoreNumColors: Boolean;
251

252
  protected
253
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
254
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
255
  public
256
    constructor Create(AOwner: TComponent); override;
257

258
     property Gamma: Single read FGamma write FGamma stored StoreGamma;
259
     property NumColors: Single read FNumColors write FNumColors stored StoreNumColors;
260
  end;
261

262
  TGLSLPostPosterizeShader = class(TGLCustomGLSLPostPosterizeShader)
263
  published
264
    property Gamma;
265
    property NumColors;
266
  end;
267

268
  //TGLCustomGLSLPostFrostShader
269
  //
270
  { Custom class for GLSLPostFrostShader.
271
   A shader that frost of the entire scene}
272
type
273
  TGLCustomGLSLPostFrostShader = class(TGLCustomGLSLShader, IGLPostShader)
274
  private
275

276
    FRandScale  : Single;
277
    FRandFactor : Single;
278

279
    // Implementing IGLPostShader.
280
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
281
    function GetTextureTarget: TGLTextureTarget;
282

283
    function StoreRandScale: Boolean;
284
    function StoreRandFactor: Boolean;
285

286
  protected
287
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
288
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
289
  public
290
    constructor Create(AOwner: TComponent); override;
291

292
     property RandScale: Single read FRandScale write FRandScale stored StoreRandScale;
293
     property RandFactor: Single read FRandFactor write FRandFactor stored StoreRandFactor;
294
  end;
295

296
  TGLSLPostFrostShader = class(TGLCustomGLSLPostFrostShader)
297
  published
298
    property RandScale;
299
    property RandFactor;
300
  end;
301

302
  //TGLCustomGLSLPostTroubleShader
303
  //
304
  { Custom class for GLSLPostTroubleShader.
305
   A shader that trouble of the entire scene. v2 
306
   This Shader is experimental it can do smooth the scene or double the scene and it's
307
   depends of PixelX, PixelY and Freq values if they are less than 1 or greater
308
   the effects will be very different}
309
type
310
  TGLCustomGLSLPostTroubleShader = class(TGLCustomGLSLShader, IGLPostShader)
311
  private
312

313
    FPixelX  : Single;
314
    FPixelY : Single;
315
    FFreq   : Single;
316

317
    FMaterialLibrary: TGLAbstractMaterialLibrary;
318
    FNoiseTex : TGLTexture;
319
    FNoiseTexName  : TGLLibMaterialName;
320

321
    // Implementing IGLPostShader.
322
    procedure DoUseTempTexture(const TempTexture: TGLTextureHandle;TextureTarget: TGLTextureTarget);
323
    function GetTextureTarget: TGLTextureTarget;
324

325
    procedure SetNoiseTexTexture(const Value: TGLTexture);
326

327
    function GetNoiseTexName: TGLLibMaterialName;
328
    procedure SetNoiseTexName(const Value: TGLLibMaterialName);
329

330

331
    function GetMaterialLibrary: TGLAbstractMaterialLibrary;
332

333
    function StorePixelX: Boolean;
334
    function StorePixelY: Boolean;
335
    function StoreFreq: Boolean;
336

337
  protected
338
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
339
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
340

341
    procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual;
342
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
343
  public
344
    constructor Create(AOwner: TComponent); override;
345

346
     property PixelX: Single read FPixelX write FPixelX stored StorePixelX;
347
     property PixelY: Single read FPixelY write FPixelY stored StorePixelY;
348
     property Freq: Single read FFreq write FFreq stored StoreFreq;
349

350
     property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary;
351
     property NoiseTex: TGLTexture read FNoiseTex write SetNoiseTexTexture;
352
     property NoiseTexName: TGLLibMaterialName read GetNoiseTexName write SetNoiseTexName;
353
  end;
354

355
  TGLSLPostTroubleShader = class(TGLCustomGLSLPostTroubleShader)
356
  published
357
    property PixelX;
358
    property PixelY;
359
    property Freq;
360
    property MaterialLibrary;
361
    property NoiseTexName;
362
  end;
363

364
//----------------------------------------------------------------------
365
//----------------------------------------------------------------------
366
//----------------------------------------------------------------------
367
implementation
368
//----------------------------------------------------------------------
369
//----------------------------------------------------------------------
370
//----------------------------------------------------------------------
371

372
{ TGLCustomGLSLPostBlurShader }
373

374
constructor TGLCustomGLSLPostBlurShader.Create(
375
  AOwner: TComponent);
376
begin
377
  inherited;
378
  with VertexProgram.Code do
379
  begin
380
    Add('varying vec2 vTexCoord; ');
381
    Add(' ');
382
    Add('void main(void) ');
383
    Add('{ '); 
384
    Add(' '); 
385
    Add('   // Clean up inaccuracies '); 
386
    Add('   vec2 Position; '); 
387
    Add('   Position.xy = sign(gl_Vertex.xy); '); 
388
    Add(' '); 
389
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); '); 
390
    Add('   vTexCoord = Position.xy *.5 + .5; '); 
391
    Add('    ');
392
    Add('} '); 
393
  end;
394

395
  with FragmentProgram.Code do
396
  begin
397
    Add('uniform float threshold; ');
398
    Add('uniform vec2 ScreenExtents; ');
399
    Add('uniform sampler2DRect Image; ');
400
    Add(' ');
401
    Add('varying vec2 vTexCoord; ');
402
    Add(' ');
403
    Add('void main() ');
404
    Add('{ ');
405
    Add('   ');
406
    Add('   vec2 samples[8]; ');
407
    Add('   vec2 vTexCoordScr = vTexCoord * ScreenExtents; ');
408
    Add('    ');
409
    Add('   samples[0]  = vTexCoordScr + vec2(-1.0, -1.0); ');
410
    Add('   samples[1]  = vTexCoordScr + vec2( 0.0, -1.0); ');
411
    Add('   samples[2]  = vTexCoordScr + vec2( 1.0, -1.0); ');
412
    Add('   samples[3]  = vTexCoordScr + vec2(-1.0,  0.0); ');
413
    Add('   samples[4]  = vTexCoordScr + vec2( 1.0,  0.0); ');
414
    Add('   samples[5]  = vTexCoordScr + vec2(-1.0,  1.0); ');
415
    Add('   samples[6]  = vTexCoordScr + vec2( 0.0,  1.0); ');
416
    Add('   samples[7]  = vTexCoordScr + vec2( 1.0,  1.0); ');
417
    Add(' ');
418
    Add('   vec4 sample = texture2DRect(Image, vTexCoordScr); ');
419
    Add(' ');
420
    Add('   // Neighborhood average ');
421
    Add('   vec4 avg = sample; ');
422
    Add('   for (int i = 0; i < 8; i++) ');
423
    Add('   { ');
424
    Add('      avg += texture2DRect(Image,  samples[i]); ');
425
    Add('   } ');
426
    Add('    ');
427
    Add(' ');
428
    Add('   avg /= 9.0; ');
429
    Add(' ');
430
    Add('   // If the difference between the average and the sample is ');
431
    Add('   // large, we''ll assume it''s noise. ');
432
    Add('   vec4  diff = abs(sample - avg); ');
433
    Add('   float sel  = float(dot(diff, vec4(0.25)) > threshold); ');
434
    Add(' ');
435
    Add('   gl_FragColor =  mix(sample, avg, sel); ');
436
    Add('} '); 
437
  end;
438
  FThreshold := 0.1;
439
end;
440

441
procedure TGLCustomGLSLPostBlurShader.DoApply(
442
  var rci: TGLRenderContextInfo; Sender: TObject);
443
begin
444
  GetGLSLProg.UseProgramObject;
445
  GetGLSLProg.Uniform1f['threshold'] := FThreshold;
446
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
447
end;
448

449
function TGLCustomGLSLPostBlurShader.DoUnApply(
450
  var rci: TGLRenderContextInfo): Boolean;
451
begin
452
  rci.GLStates.ActiveTexture := 0;
453
  GetGLSLProg.EndUseProgramObject;
454
  Result := False;
455
end;
456

457
procedure TGLCustomGLSLPostBlurShader.DoUseTempTexture(
458
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
459
begin
460
  Param['Image'].AsCustomTexture[2, TextureTarget] := TempTexture.Handle;
461
end;
462

463
function TGLCustomGLSLPostBlurShader.GetTextureTarget: TGLTextureTarget;
464
begin
465
  Result := ttTextureRect;
466
end;
467

468
function TGLCustomGLSLPostBlurShader.StoreThreshold: Boolean;
469
begin
470
  Result := Abs(FThreshold - 0.1) > 0.00001;
471
end;
472

473
{ TGLCustomGLSLPostThermalVisionShader }
474

475
constructor TGLCustomGLSLPostThermalVisionShader.Create(
476
  AOwner: TComponent);
477
begin
478
  inherited;
479
  with VertexProgram.Code do
480
  begin
481
    Add('varying vec2 vTexCoord; ');
482
    Add(' ');
483
    Add('void main(void) ');
484
    Add('{ ');
485
    Add(' ');
486
    Add('   // Clean up inaccuracies ');
487
    Add('   vec2 Position; ');
488
    Add('   Position.xy = sign(gl_Vertex.xy); ');
489
    Add(' ');
490
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
491
    Add('   vTexCoord = Position.xy *.5 + .5; ');
492
    Add('    ');
493
    Add('} ');
494
  end;
495

496
  with FragmentProgram.Code do
497
  begin
498
   Add('uniform float Threshold; ');
499
   Add('uniform float Intensity; ');
500
   Add('uniform vec2 ScreenExtents; ');
501
   Add('uniform sampler2DRect ScreenTex; ');
502
   Add(' ');
503
   Add('varying vec2 vTexCoord; ');
504
   Add(' ');
505
   Add('void main() ');
506
   Add('{ ');
507
   Add('   vec2 uv = vTexCoord * ScreenExtents; ');
508
   Add('   vec3 tc = vec3(1.0, 0.0, 0.0);');
509
   Add('   vec3 pixcol = texture2DRect(ScreenTex, uv).rgb; ');
510
   Add('   vec3 colors[3];');
511
   Add('   colors[0] = vec3(0.,0.,1.); ');
512
   Add('   colors[1] = vec3(1.,1.,0.); ');
513
   Add('   colors[2] = vec3(1.,0.,0.); ');
514
   Add('   float lum = dot(vec3(0.30, 0.59, 0.11), pixcol.rgb); ');
515
   Add('//   float lum = (pixcol.r+pixcol.g+pixcol.b)/3.;');
516
   Add('   tc = (lum < 0.5)?  mix(colors[0],colors[1],lum/Threshold): mix(colors[1],colors[2],(lum-Intensity)/Threshold); ');
517
   Add('   gl_FragColor = vec4(tc, 1); ');
518
   Add('} ');
519

520
  end;
521

522
  FThreshold  := 0.5;
523
  FIntensity  := 0.5;
524
end;
525

526
procedure TGLCustomGLSLPostThermalVisionShader.DoApply(
527
  var rci: TGLRenderContextInfo; Sender: TObject);
528
begin
529
  GetGLSLProg.UseProgramObject;
530
  GetGLSLProg.Uniform1f['Threshold'] := FThreshold;
531
  GetGLSLProg.Uniform1f['Intensity'] := FIntensity;
532
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
533

534
end;
535

536
function TGLCustomGLSLPostThermalVisionShader.DoUnApply(
537
  var rci: TGLRenderContextInfo): Boolean;
538
begin
539
  rci.GLStates.ActiveTexture := 0;
540
  GetGLSLProg.EndUseProgramObject;
541
  Result := False;
542
end;
543

544
procedure TGLCustomGLSLPostThermalVisionShader.DoUseTempTexture(
545
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
546
begin
547
  Param['ScreenTex'].AsCustomTexture[3, TextureTarget] := TempTexture.Handle;
548
end;
549

550
function TGLCustomGLSLPostThermalVisionShader.GetTextureTarget: TGLTextureTarget;
551
begin
552
  Result := ttTextureRect; //ttTexture2D;
553
end;
554

555
function TGLCustomGLSLPostThermalVisionShader.StoreThreshold: Boolean;
556
begin
557
  Result := (Abs(FThreshold) > 0) and (Abs(FThreshold) <= 1.0);
558
end;
559

560
function TGLCustomGLSLPostThermalVisionShader.StoreIntensity: Boolean;
561
begin
562
  Result := (Abs(FIntensity) >= 0) and (Abs(FIntensity) <= 2.0);
563
end;
564

565
{ TGLCustomGLSLPostThermalVisionShader }
566

567
constructor TGLCustomGLSLPostDreamVisionShader.Create(
568
  AOwner: TComponent);
569
begin
570
  inherited;
571
  with VertexProgram.Code do
572
  begin
573
    Add('varying vec2 vTexCoord; ');
574
    Add(' ');
575
    Add('void main(void) ');
576
    Add('{ ');
577
    Add(' ');
578
    Add('   // Clean up inaccuracies ');
579
    Add('   vec2 Position; ');
580
    Add('   Position.xy = sign(gl_Vertex.xy); ');
581
    Add(' ');
582
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
583
    Add('   vTexCoord = Position.xy *.5 + .5; ');
584
    Add('    ');
585
    Add('} ');
586
  end;
587

588
  with FragmentProgram.Code do
589
  begin
590
   Add('uniform float Threshold; ');
591
   Add('uniform vec2 ScreenExtents; ');
592
   Add('uniform sampler2DRect ScreenTex; ');
593
   Add(' ');
594
   Add('varying vec2 vTexCoord; ');
595
   Add(' ');
596
   Add('void main() ');
597
   Add('{ ');
598
   Add('   vec2 uv = vTexCoord * ScreenExtents; ');
599
   Add('   vec3 c = texture2DRect(ScreenTex, uv).rgb; ');
600
   Add('   c += texture2DRect(ScreenTex, uv+0.001).rgb; ');
601
   Add('   c += texture2DRect(ScreenTex, uv+0.003).rgb; ');
602
   Add('   c += texture2DRect(ScreenTex, uv+0.005).rgb; ');
603
   Add('   c += texture2DRect(ScreenTex, uv+0.007).rgb; ');
604
   Add('   c += texture2DRect(ScreenTex, uv+0.009).rgb; ');
605
   Add('   c += texture2DRect(ScreenTex, uv+0.011).rgb; ');
606
   Add(' ');
607
   Add('   c += texture2DRect(ScreenTex, uv-0.001).rgb; ');
608
   Add('   c += texture2DRect(ScreenTex, uv-0.003).rgb; ');
609
   Add('   c += texture2DRect(ScreenTex, uv-0.005).rgb; ');
610
   Add('   c += texture2DRect(ScreenTex, uv-0.007).rgb; ');
611
   Add('   c += texture2DRect(ScreenTex, uv-0.009).rgb; ');
612
   Add('   c += texture2DRect(ScreenTex, uv-0.011).rgb; ');
613
   Add(' ');
614
   Add('   c.rgb = vec3((c.r+c.g+c.b)/3.0); ');
615
   Add('   c = c / Threshold; ');
616
   Add('   gl_FragColor = vec4(c,1.0); ');
617
   Add('} ');
618

619
  end;
620

621
  FThreshold  := 5;
622
end;
623

624
procedure TGLCustomGLSLPostDreamVisionShader.DoApply(
625
  var rci: TGLRenderContextInfo; Sender: TObject);
626
begin
627
  GetGLSLProg.UseProgramObject;
628
  GetGLSLProg.Uniform1f['Threshold'] := (FThreshold*255)/100;
629
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
630

631
end;
632

633
function TGLCustomGLSLPostDreamVisionShader.DoUnApply(
634
  var rci: TGLRenderContextInfo): Boolean;
635
begin
636
  rci.GLStates.ActiveTexture := 0;
637
  GetGLSLProg.EndUseProgramObject;
638
  Result := False;
639
end;
640

641
procedure TGLCustomGLSLPostDreamVisionShader.DoUseTempTexture(
642
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
643
begin
644
  Param['ScreenTex'].AsCustomTexture[2, TextureTarget] := TempTexture.Handle;
645
end;
646

647
function TGLCustomGLSLPostDreamVisionShader.GetTextureTarget: TGLTextureTarget;
648
begin
649
  Result := ttTextureRect; //ttTexture2D;
650
end;
651

652
function TGLCustomGLSLPostDreamVisionShader.StoreThreshold: Boolean;
653
begin
654
  Result := (Abs(FThreshold) > 0) and (Abs(FThreshold) <= 100);
655
end;
656

657
{ TGLCustomGLSLPostThermalVisionShader }
658

659
constructor TGLCustomGLSLPostNightVisionShader.Create(
660
  AOwner: TComponent);
661
begin
662
  inherited;
663
  with VertexProgram.Code do
664
  begin
665
    Add('varying vec2 vTexCoord; ');
666
    Add(' ');
667
    Add('void main(void) ');
668
    Add('{ ');
669
    Add(' ');
670
    Add('   // Clean up inaccuracies ');
671
    Add('   vec2 Position; ');
672
    Add('   Position.xy = sign(gl_Vertex.xy); ');
673
    Add(' ');
674
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
675
    Add('   vTexCoord = Position.xy *.5 + .5; ');
676
    Add('    ');
677
    Add('} ');
678
  end;
679

680
  with FragmentProgram.Code do
681
  begin
682
   Add('uniform float luminanceThreshold; ');
683
   Add('uniform float colorAmplification; ');
684
   Add('uniform float elapsedTime; ');
685
   Add('uniform int useMask;');
686
   Add('uniform vec2 ScreenExtents; ');
687
   Add('uniform sampler2D noiseTex; ');
688
   Add('uniform sampler2D maskTex; ');
689
   Add('uniform sampler2DRect ScreenTex; ');
690
   Add(' ');
691
   Add('varying vec2 vTexCoord; ');
692
   Add(' ');
693
   Add('void main () ');
694
   Add('{ ');
695
   Add('  vec2 uv = vTexCoord * ScreenExtents; ');
696
   Add('  vec4 finalColor; ');
697
   Add('  vec2 uvv; ');
698
   Add('  uvv.x = 0.4*sin(elapsedTime*50.0); ');
699
   Add('  uvv.y = 0.4*cos(elapsedTime*50.0); ');
700
   Add('  float m = 1; ');
701
   Add('  if (useMask==1) { m = texture2D(maskTex, vTexCoord.st).r; } ');  // Problem Here I don't know how to solve ????
702
   Add('  vec3 n = texture2D(noiseTex,(uv.st*3.5) + uvv).rgb; ');
703
   Add('  vec3 c = texture2DRect(ScreenTex, uv.st+(n.xy*0.005)).rgb; ');
704
   Add('    float lum = dot(vec3(0.30, 0.59, 0.11), c); ');
705
   Add('    if (lum < luminanceThreshold) ');
706
   Add('        c *= colorAmplification; ');
707
   Add('  vec3 visionColor = vec3(0.1, 0.95, 0.2); ');
708
   Add('  finalColor.rgb = (c + (n*0.2)) * visionColor * m; ');
709
   Add(' ');
710
   Add('  gl_FragColor.rgb = finalColor.rgb; ');
711
   Add('  gl_FragColor.a = 1.0; ');
712
   Add('} ');
713

714
  end;
715

716
  FLuminanceThreshold := 0.2;
717
  FColorAmplification := 4.0;
718
  FElapsedTime:=0.1;
719
  FUseMask:=0; // Shader not working if we want to use mask
720

721
end;
722

723
procedure TGLCustomGLSLPostNightVisionShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject);
724
begin
725

726
  GetGLSLProg.UseProgramObject;
727
  param['luminanceThreshold'].AsVector1f := FLuminanceThreshold;
728
  param['colorAmplification'].AsVector1f := FColorAmplification;
729
  param['elapsedTime'].AsVector1f := FElapsedTime;
730
  param['useMask'].AsVector1i := FUseMask;
731
  param['ScreenExtents'].AsVector2f := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
732
  param['noiseTex'].AsTexture2D[1]:= FNoiseTex;
733
  param['maskTex'].AsTexture2D[2]:= FMaskTex;
734
end;
735

736
function TGLCustomGLSLPostNightVisionShader.DoUnApply(
737
  var rci: TGLRenderContextInfo): Boolean;
738
begin
739
  rci.GLStates.ActiveTexture := 0;
740
  GetGLSLProg.EndUseProgramObject;
741
  Result := False;
742
end;
743

744
procedure TGLCustomGLSLPostNightVisionShader.DoUseTempTexture(
745
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
746
begin
747
  Param['ScreenTex'].AsCustomTexture[7, TextureTarget] := TempTexture.Handle;
748
end;
749

750
function TGLCustomGLSLPostNightVisionShader.GetTextureTarget: TGLTextureTarget;
751
begin
752
  Result := ttTextureRect; //ttTexture2D;
753
end;
754

755

756
function TGLCustomGLSLPostNightVisionShader.StoreLuminanceThreshold: Boolean;
757
begin
758
  Result := Abs(FLuminanceThreshold - 0.1) > 0.00001;
759
end;
760

761
function TGLCustomGLSLPostNightVisionShader.StoreColorAmplification: Boolean;
762
begin
763
  Result := Abs(FColorAmplification - 0.1) > 0.00001;
764
end;
765

766

767
procedure TGLCustomGLSLPostNightVisionShader.SetMaskTexTexture(const Value: TGLTexture);
768
begin
769
  if FMaskTex = Value then Exit;
770
  MaskTex := Value;
771
  NotifyChange(Self)
772
end;
773

774
procedure TGLCustomGLSLPostNightVisionShader.SetNoiseTexTexture(const Value: TGLTexture);
775
begin
776
  if FNoiseTex = Value then Exit;
777
  NoiseTex := Value;
778
  NotifyChange(Self);
779
end;
780

781
function TGLCustomGLSLPostNightVisionShader.GetNoiseTexName: TGLLibMaterialName;
782
begin
783
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FNoiseTex);
784
  if Result = '' then Result := FNoiseTexName;
785
end;
786

787
procedure TGLCustomGLSLPostNightVisionShader.SetNoiseTexName(const Value: TGLLibMaterialName);
788
begin
789
  //Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before');
790
  if FNoiseTexName = Value then Exit;
791
  FNoiseTexName  := Value;
792
  FNoiseTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FNoiseTexName);
793
  NotifyChange(Self);
794
end;
795

796
function TGLCustomGLSLPostNightVisionShader.GetMaskTexName: TGLLibMaterialName;
797
begin
798
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMaskTex);
799
  if Result = '' then Result := FMaskTexName;
800
end;
801

802
procedure TGLCustomGLSLPostNightVisionShader.SetMaskTexName(const Value: TGLLibMaterialName);
803
begin
804
 // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before');
805
  if FMaskTexName = Value then Exit;
806
  FMaskTexName  := Value;
807

808
  FMaskTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FMaskTexName);
809
  NotifyChange(Self);
810
end;
811

812
function TGLCustomGLSLPostNightVisionShader.GetMaterialLibrary: TGLAbstractMaterialLibrary;
813
begin
814
  Result := FMaterialLibrary;
815
end;
816

817
procedure TGLCustomGLSLPostNightVisionShader.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
818
begin
819
  if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self);
820
  FMaterialLibrary := Value;
821
  if (FMaterialLibrary <> nil)
822
    and (FMaterialLibrary is TGLAbstractMaterialLibrary) then
823
      FMaterialLibrary.FreeNotification(Self);
824
end;
825

826
procedure TGLCustomGLSLPostNightVisionShader.Notification(AComponent: TComponent; Operation: TOperation);
827
var
828
  Index: Integer;
829
begin
830
  inherited;
831
  if Operation = opRemove then
832
    if AComponent = FMaterialLibrary then
833
      if FMaterialLibrary <> nil then
834
      begin
835
        // Need to nil the textures that were owned by it
836
        if FNoiseTex <> nil then
837
        begin
838
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FNoiseTex);
839
          if Index <> -1 then
840
            SetNoiseTexTexture(nil);
841
        end;
842

843
        if FMaskTex <> nil then
844
        begin
845
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FMaskTex);
846
          if Index <> -1 then
847
            SetMaskTexTexture(nil);
848
        end;
849

850
        FMaterialLibrary := nil;
851
      end;
852
end;
853

854
{ TGLCustomGLSLPostPixelateShader }
855

856
constructor TGLCustomGLSLPostPixelateShader.Create(
857
  AOwner: TComponent);
858
begin
859
  inherited;
860
  with VertexProgram.Code do
861
  begin
862
    Add('varying vec2 vTexCoord; ');
863
    Add(' ');
864
    Add('void main(void) ');
865
    Add('{ ');
866
    Add(' ');
867
    Add('   // Clean up inaccuracies ');
868
    Add('   vec2 Position; ');
869
    Add('   Position.xy = sign(gl_Vertex.xy); ');
870
    Add(' ');
871
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
872
    Add('   vTexCoord = Position.xy *.5 + .5; ');
873
    Add('    ');
874
    Add('} ');
875
  end;
876

877
  with FragmentProgram.Code do
878
  begin
879
   Add('uniform float pixel_w; // 8.0 ');
880
   Add('uniform float pixel_h; // 8.0 ');
881
   Add('uniform vec2 ScreenExtents; ');
882
   Add('uniform sampler2DRect ScreenTex; ');
883
   Add(' ');
884
   Add('varying vec2 vTexCoord; ');
885
   Add(' ');
886
   Add('void main() ');
887
   Add('{ ');
888
   Add('   vec2 uv = vTexCoord * ScreenExtents; ');
889
   Add('   vec3 tc = vec3(1.0, 0.0, 0.0); ');
890
   Add('   vec2 coord = vec2(pixel_w*floor(uv.x/pixel_w),pixel_h*floor(uv.y/pixel_h)); ');
891
   Add('   tc = texture2DRect(ScreenTex, coord).rgb; ');
892
   Add('   gl_FragColor = vec4(tc, 1); ');
893
   Add('} ');
894

895
  end;
896

897
  FPixelWidth  := 8;
898
  FPixelHeight := 12;
899
end;
900

901
procedure TGLCustomGLSLPostPixelateShader.DoApply(
902
  var rci: TGLRenderContextInfo; Sender: TObject);
903
begin
904
  GetGLSLProg.UseProgramObject;
905
  GetGLSLProg.Uniform1f['pixel_w'] := FPixelWidth;
906
  GetGLSLProg.Uniform1f['pixel_h'] := FPixelHeight;
907
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
908

909
end;
910

911
function TGLCustomGLSLPostPixelateShader.DoUnApply(
912
  var rci: TGLRenderContextInfo): Boolean;
913
begin
914
  rci.GLStates.ActiveTexture := 0;
915
  GetGLSLProg.EndUseProgramObject;
916
  Result := False;
917
end;
918

919
procedure TGLCustomGLSLPostPixelateShader.DoUseTempTexture(
920
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
921
begin
922
  Param['ScreenTex'].AsCustomTexture[3, TextureTarget] := TempTexture.Handle;
923
end;
924

925
function TGLCustomGLSLPostPixelateShader.GetTextureTarget: TGLTextureTarget;
926
begin
927
  Result := ttTextureRect; //ttTexture2D;
928
end;
929

930
function TGLCustomGLSLPostPixelateShader.StorePixelWidth: Boolean;
931
begin
932
  Result := (Abs(FPixelWidth) > 0) and (Abs(FPixelWidth) <= 64);
933
end;
934

935
function TGLCustomGLSLPostPixelateShader.StorePixelHeight: Boolean;
936
begin
937
  Result := (Abs(FPixelHeight) > 0) and (Abs(FPixelHeight) <= 64);
938
end;
939

940
{ TGLCustomGLSLPostPosterizeShader }
941

942
constructor TGLCustomGLSLPostPosterizeShader.Create(
943
  AOwner: TComponent);
944
begin
945
  inherited;
946
  with VertexProgram.Code do
947
  begin
948
    Add('varying vec2 vTexCoord; ');
949
    Add(' ');
950
    Add('void main(void) ');
951
    Add('{ ');
952
    Add(' ');
953
    Add('   // Clean up inaccuracies ');
954
    Add('   vec2 Position; ');
955
    Add('   Position.xy = sign(gl_Vertex.xy); ');
956
    Add(' ');
957
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
958
    Add('   vTexCoord = Position.xy *.5 + .5; ');
959
    Add('    ');
960
    Add('} ');
961
  end;
962

963
  with FragmentProgram.Code do
964
  begin
965
   Add('uniform float gamma; // 8.0 ');
966
   Add('uniform float numColors; // 8.0 ');
967
   Add('uniform vec2 ScreenExtents; ');
968
   Add('uniform sampler2DRect ScreenTex; ');
969
   Add(' ');
970
   Add('varying vec2 vTexCoord; ');
971
   Add(' ');
972
   Add('void main() ');
973
   Add('{ ');
974
   Add('   vec2 uv = vTexCoord * ScreenExtents; ');
975
   Add('   vec3 c = texture2DRect(ScreenTex, uv.xy).rgb; ');
976
   Add('   c = pow(c, vec3(gamma, gamma, gamma)); ');
977
   Add('   c = c * numColors; ');
978
   Add('   c = floor(c); ');
979
   Add('   c = c / numColors; ');
980
   Add('   c = pow(c, vec3(1.0/gamma)); ');
981
   Add('   gl_FragColor = vec4(c, 1.0); ');
982
   Add('} ');
983

984
  end;
985

986
  FGamma  := 0.6;
987
  FNumColors := 8;
988
end;
989

990
procedure TGLCustomGLSLPostPosterizeShader.DoApply(
991
  var rci: TGLRenderContextInfo; Sender: TObject);
992
begin
993
  GetGLSLProg.UseProgramObject;
994
  GetGLSLProg.Uniform1f['gamma'] := FGamma;
995
  GetGLSLProg.Uniform1f['numColors'] := FNumColors;
996
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
997

998
end;
999

1000
function TGLCustomGLSLPostPosterizeShader.DoUnApply(
1001
  var rci: TGLRenderContextInfo): Boolean;
1002
begin
1003
  rci.GLStates.ActiveTexture := 0;
1004
  GetGLSLProg.EndUseProgramObject;
1005
  Result := False;
1006
end;
1007

1008
procedure TGLCustomGLSLPostPosterizeShader.DoUseTempTexture(
1009
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
1010
begin
1011
  Param['ScreenTex'].AsCustomTexture[3, TextureTarget] := TempTexture.Handle;
1012
end;
1013

1014
function TGLCustomGLSLPostPosterizeShader.GetTextureTarget: TGLTextureTarget;
1015
begin
1016
  Result := ttTextureRect; //ttTexture2D;
1017
end;
1018

1019
function TGLCustomGLSLPostPosterizeShader.StoreGamma: Boolean;
1020
begin
1021
  Result := (Abs(FGamma) > 0) and (Abs(FGamma) <= 3.0);
1022
end;
1023

1024
function TGLCustomGLSLPostPosterizeShader.StoreNumColors: Boolean;
1025
begin
1026
  Result := (Abs(FNumColors) > 0) and (Abs(FNumColors) <= 255);
1027
end;
1028

1029
{ TGLCustomGLSLPostFrostShader }
1030

1031
constructor TGLCustomGLSLPostFrostShader.Create(
1032
  AOwner: TComponent);
1033
begin
1034
  inherited;
1035
  with VertexProgram.Code do
1036
  begin
1037
    Add('varying vec2 vTexCoord; ');
1038
    Add(' ');
1039
    Add('void main(void) ');
1040
    Add('{ ');
1041
    Add(' ');
1042
    Add('   // Clean up inaccuracies ');
1043
    Add('   vec2 Position; ');
1044
    Add('   Position.xy = sign(gl_Vertex.xy); ');
1045
    Add(' ');
1046
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
1047
    Add('   vTexCoord = Position.xy *.5 + .5; ');
1048
    Add('    ');
1049
    Add('} ');
1050
  end;
1051

1052
  with FragmentProgram.Code do
1053
  begin
1054
   Add('uniform float rnd_scale; // 250 ');
1055
   Add('uniform float rnd_factor; // 50 ');
1056
//   Add('uniform vec2 v1; ');
1057
//   Add('uniform vec2 v2; ');
1058
   Add('uniform vec2 ScreenExtents; ');
1059
   Add('uniform sampler2DRect ScreenTex; ');
1060
   Add(' ');
1061
   Add('varying vec2 vTexCoord; ');
1062
   Add(' ');
1063
   Add('float rand(vec2 co) ');
1064
   Add('{ ');
1065
   Add('  vec2 v1 = vec2(92.,80.); ');
1066
   Add('  vec2 v2 = vec2(41.,62.); ');
1067
   Add('  return fract(sin(dot(co.xy ,v1)) + cos(dot(co.xy ,v2)) * rnd_scale); ');
1068
   Add('} ');
1069
   Add(' ');
1070
   Add('void main() ');
1071
   Add('{ ');
1072
   Add('  vec2 uv = vTexCoord * ScreenExtents; ');
1073
   Add('  vec3 tc = vec3(1.0, 0.0, 0.0); ');
1074
   Add('  vec2 rnd = vec2(rand(uv.xy),rand(uv.yx)); ');
1075
   Add('  tc = texture2DRect(ScreenTex, uv+rnd*rnd_factor).rgb; ');
1076
   Add('  gl_FragColor = vec4(tc, 1.0); ');
1077
   Add('} ');
1078

1079
  end;
1080

1081
  FRandScale  := 50;
1082
  FRandFactor := 50;
1083
end;
1084

1085
procedure TGLCustomGLSLPostFrostShader.DoApply(
1086
  var rci: TGLRenderContextInfo; Sender: TObject);
1087
begin
1088
  GetGLSLProg.UseProgramObject;
1089
  GetGLSLProg.Uniform1f['rnd_scale'] := FRandScale;
1090
  GetGLSLProg.Uniform1f['rnd_factor'] := FRandFactor;
1091
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
1092

1093
end;
1094

1095
function TGLCustomGLSLPostFrostShader.DoUnApply(
1096
  var rci: TGLRenderContextInfo): Boolean;
1097
begin
1098
  rci.GLStates.ActiveTexture := 0;
1099
  GetGLSLProg.EndUseProgramObject;
1100
  Result := False;
1101
end;
1102

1103
procedure TGLCustomGLSLPostFrostShader.DoUseTempTexture(
1104
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
1105
begin
1106
  Param['ScreenTex'].AsCustomTexture[3, TextureTarget] := TempTexture.Handle;
1107
end;
1108

1109
function TGLCustomGLSLPostFrostShader.GetTextureTarget: TGLTextureTarget;
1110
begin
1111
  Result := ttTextureRect; //ttTexture2D;
1112
end;
1113

1114
function TGLCustomGLSLPostFrostShader.StoreRandScale: Boolean;
1115
begin
1116
  Result := (Abs(FRandScale) > 0) and (Abs(FRandScale) <= 1000);
1117
end;
1118

1119
function TGLCustomGLSLPostFrostShader.StoreRandFactor: Boolean;
1120
begin
1121
  Result := (Abs(FRandFactor) > 0) and (Abs(FRandFactor) <= 1000);
1122
end;
1123

1124
{ TGLCustomGLSLPostTroubleShader }
1125

1126
constructor TGLCustomGLSLPostTroubleShader.Create( AOwner: TComponent);
1127
begin
1128
  inherited;
1129
  with VertexProgram.Code do
1130
  begin
1131
    Add('varying vec2 vTexCoord; ');
1132
    Add(' ');
1133
    Add('void main(void) ');
1134
    Add('{ ');
1135
    Add(' ');
1136
    Add('   // Clean up inaccuracies ');
1137
    Add('   vec2 Position; ');
1138
    Add('   Position.xy = sign(gl_Vertex.xy); ');
1139
    Add(' ');
1140
    Add('   gl_Position = vec4(Position.xy, 0.0, 1.0); ');
1141
    Add('   vTexCoord = Position.xy *.5 + .5; ');
1142
    Add('    ');
1143
    Add('} ');
1144
  end;
1145

1146
  with FragmentProgram.Code do
1147
  begin
1148
   Add('uniform float PixelX; // = 2.0; ');
1149
   Add('uniform float PixelY; // = 2.0; ');
1150
   Add('uniform float Freq; // = 0.115; ');
1151
   Add('uniform vec2 ScreenExtents; ');
1152
   Add('uniform sampler2D noiseTex; '); // 1
1153
   Add('uniform sampler2DRect ScreenTex; ');
1154
   Add(' ');
1155
   Add('varying vec2 vTexCoord; ');
1156
   Add(' ');
1157
   Add('vec4 spline(float x, vec4 c1, vec4 c2, vec4 c3, vec4 c4, vec4 c5, vec4 c6, vec4 c7, vec4 c8, vec4 c9) ');
1158
   Add('{ ');
1159
   Add('  float w1, w2, w3, w4, w5, w6, w7, w8, w9; ');
1160
   Add('  w1 = 0.0; ');
1161
   Add('  w2 = 0.0; ');
1162
   Add('  w3 = 0.0; ');
1163
   Add('  w4 = 0.0; ');
1164
   Add('  w5 = 0.0; ');
1165
   Add('  w6 = 0.0; ');
1166
   Add('  w7 = 0.0; ');
1167
   Add('  w8 = 0.0; ');
1168
   Add('  w9 = 0.0; ');
1169
   Add('  float tmp = x * 8.0; ');
1170
   Add('  if (tmp<=1.0) { ');
1171
   Add('    w1 = 1.0 - tmp; ');
1172
   Add('    w2 = tmp; ');
1173
   Add('  } ');
1174
   Add('  else if (tmp<=2.0) { ');
1175
   Add('    tmp = tmp - 1.0; ');
1176
   Add('    w2 = 1.0 - tmp; ');
1177
   Add('    w3 = tmp; ');
1178
   Add('  } ');
1179
   Add('  else if (tmp<=3.0) { ');
1180
   Add('    tmp = tmp - 2.0; ');
1181
   Add('    w3 = 1.0-tmp; ');
1182
   Add('    w4 = tmp; ');
1183
   Add('  } ');
1184
   Add('  else if (tmp<=4.0) { ');
1185
   Add('    tmp = tmp - 3.0; ');
1186
   Add('    w4 = 1.0-tmp; ');
1187
   Add('    w5 = tmp; ');
1188
   Add('  } ');
1189
   Add('  else if (tmp<=5.0) { ');
1190
   Add('    tmp = tmp - 4.0; ');
1191
   Add('    w5 = 1.0-tmp; ');
1192
   Add('    w6 = tmp; ');
1193
   Add('  } ');
1194
   Add('  else if (tmp<=6.0) { ');
1195
   Add('    tmp = tmp - 5.0; ');
1196
   Add('    w6 = 1.0-tmp; ');
1197
   Add('    w7 = tmp; ');
1198
   Add('  } ');
1199
   Add('  else if (tmp<=7.0) { ');
1200
   Add('    tmp = tmp - 6.0; ');
1201
   Add('    w7 = 1.0 - tmp; ');
1202
   Add('    w8 = tmp; ');
1203
   Add('  } ');
1204
   Add('  else  ');
1205
   Add('  { ');
1206
   Add('    //tmp = saturate(tmp - 7.0); ');
1207
    // http://www.ozone3d.net/blogs/lab/20080709/saturate-function-in-glsl/
1208
   Add('    tmp = clamp(tmp - 7.0, 0.0, 1.0); ');
1209
   Add('    w8 = 1.0-tmp; ');
1210
   Add('    w9 = tmp; ');
1211
   Add('  } ');
1212
   Add('  return w1*c1 + w2*c2 + w3*c3 + w4*c4 + w5*c5 + w6*c6 + w7*c7 + w8*c8 + w9*c9; ');
1213
   Add('} ');
1214
   Add(' ');
1215
   Add('vec3 NOISE2D(vec2 p) ');
1216
   Add('  { return texture2D(noiseTex,p).xyz; } ');
1217
   Add(' ');
1218
   Add('void main() ');
1219
   Add('{ ');
1220
   Add('  vec2 uv = vTexCoord * ScreenExtents; ');
1221
   Add('  vec3 tc = vec3(1.0, 0.0, 0.0); ');
1222
   Add('  float DeltaX = PixelX; ');
1223
   Add('  float DeltaY = PixelY; ');
1224
   Add('  vec2 ox = vec2(DeltaX,0.0); ');
1225
   Add('  vec2 oy = vec2(0.0,DeltaY); ');
1226
   Add('  vec2 PP = uv - oy; ');
1227
   Add('  vec4 C00 = texture2DRect(ScreenTex,PP - ox); ');
1228
   Add('  vec4 C01 = texture2DRect(ScreenTex,PP); ');
1229
   Add('  vec4 C02 = texture2DRect(ScreenTex,PP + ox); ');
1230
   Add('  PP = uv; ');
1231
   Add('  vec4 C10 = texture2DRect(ScreenTex,PP - ox); ');
1232
   Add('  vec4 C11 = texture2DRect(ScreenTex,PP); ');
1233
   Add('  vec4 C12 = texture2DRect(ScreenTex,PP + ox); ');
1234
   Add('  PP = uv + oy; ');
1235
   Add('  vec4 C20 = texture2DRect(ScreenTex,PP - ox); ');
1236
   Add('  vec4 C21 = texture2DRect(ScreenTex,PP); ');
1237
   Add('  vec4 C22 = texture2DRect(ScreenTex,PP + ox); ');
1238
   Add('  float n = NOISE2D(Freq*uv).x; ');
1239
   Add('  n = mod(n, 0.111111)/0.111111; ');
1240
   Add('  vec4 result = spline(n,C00,C01,C02,C10,C11,C12,C20,C21,C22); ');
1241
   Add('  tc = result.rgb; ');
1242
   Add('  gl_FragColor = vec4(tc, 1.0); ');
1243
   Add('} ');
1244

1245
  end;
1246

1247
  FPixelX  := 0.5;
1248
  FPixelY := 0.5;
1249
  FFreq:= 2.115;
1250
end;
1251

1252
procedure TGLCustomGLSLPostTroubleShader.DoApply(
1253
  var rci: TGLRenderContextInfo; Sender: TObject);
1254
begin
1255
  GetGLSLProg.UseProgramObject;
1256
  GetGLSLProg.Uniform1f['PixelX'] := FPixelX;
1257
  GetGLSLProg.Uniform1f['PixelY'] := FPixelY;
1258
  GetGLSLProg.Uniform1f['Freq'] := FFreq;
1259
  GetGLSLProg.Uniform2f['ScreenExtents'] := Vector2fMake(rci.viewPortSize.cx, rci.viewPortSize.cy);
1260

1261
  param['noiseTex'].AsTexture2D[1]:= FNoiseTex;
1262

1263
end;
1264

1265
function TGLCustomGLSLPostTroubleShader.DoUnApply(
1266
  var rci: TGLRenderContextInfo): Boolean;
1267
begin
1268
  rci.GLStates.ActiveTexture := 0;
1269
  GetGLSLProg.EndUseProgramObject;
1270
  Result := False;
1271
end;
1272

1273
procedure TGLCustomGLSLPostTroubleShader.DoUseTempTexture(
1274
  const TempTexture: TGLTextureHandle; TextureTarget: TGLTextureTarget);
1275
begin
1276
  Param['ScreenTex'].AsCustomTexture[5, TextureTarget] := TempTexture.Handle;
1277
end;
1278

1279
function TGLCustomGLSLPostTroubleShader.GetTextureTarget: TGLTextureTarget;
1280
begin
1281
  Result := ttTextureRect; //ttTexture2D;
1282
end;
1283

1284
function TGLCustomGLSLPostTroubleShader.StorePixelX: Boolean;
1285
begin
1286
  Result := (Abs(FPixelX) > 0) and (Abs(FPixelX) <= 1000);
1287
end;
1288

1289
function TGLCustomGLSLPostTroubleShader.StorePixelY: Boolean;
1290
begin
1291
  Result := (Abs(FPixelY) > 0) and (Abs(FPixelY) <= 1000);
1292
end;
1293

1294
function TGLCustomGLSLPostTroubleShader.StoreFreq: Boolean;
1295
begin
1296
  Result := (Abs(FPixelY) > 0) and (Abs(FPixelY) <= 5.0);
1297
end;
1298

1299
procedure TGLCustomGLSLPostTroubleShader.SetNoiseTexTexture(const Value: TGLTexture);
1300
begin
1301
  if FNoiseTex = Value then Exit;
1302
  NoiseTex := Value;
1303
  NotifyChange(Self);
1304
end;
1305

1306
function TGLCustomGLSLPostTroubleShader.GetNoiseTexName: TGLLibMaterialName;
1307
begin
1308
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FNoiseTex);
1309
  if Result = '' then Result := FNoiseTexName;
1310
end;
1311

1312
procedure TGLCustomGLSLPostTroubleShader.SetNoiseTexName(const Value: TGLLibMaterialName);
1313
begin
1314
  //Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before');
1315
  if FNoiseTexName = Value then Exit;
1316
  FNoiseTexName  := Value;
1317
  FNoiseTex := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FNoiseTexName);
1318
  NotifyChange(Self);
1319
end;
1320

1321
function TGLCustomGLSLPostTroubleShader.GetMaterialLibrary: TGLAbstractMaterialLibrary;
1322
begin
1323
  Result := FMaterialLibrary;
1324
end;
1325

1326
procedure TGLCustomGLSLPostTroubleShader.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
1327
begin
1328
  if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self);
1329
  FMaterialLibrary := Value;
1330
  if (FMaterialLibrary <> nil)
1331
    and (FMaterialLibrary is TGLAbstractMaterialLibrary) then
1332
      FMaterialLibrary.FreeNotification(Self);
1333
end;
1334

1335
procedure TGLCustomGLSLPostTroubleShader.Notification(AComponent: TComponent; Operation: TOperation);
1336
var
1337
  Index: Integer;
1338
begin
1339
  inherited;
1340
  if Operation = opRemove then
1341
    if AComponent = FMaterialLibrary then
1342
      if FMaterialLibrary <> nil then
1343
      begin
1344
        // Need to nil the textures that were owned by it
1345
        if FNoiseTex <> nil then
1346
        begin
1347
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FNoiseTex);
1348
          if Index <> -1 then
1349
            SetNoiseTexTexture(nil);
1350
        end;
1351

1352
        FMaterialLibrary := nil;
1353
      end;
1354
end;
1355

1356
end.
1357

1358