LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Just a good looking shader. And my first one;) 
6

7
    History : 
8
       22/04/10 - Yar - Fixes after GLState revision
9
       24/07/09 - DaStr - TGLShader.DoInitialize() now passes rci
10
                              (BugTracker ID = 2826217)   
11
       14/03/07 - DaStr - Bugfixed TGLCustomCGBombShader.DoInitialize
12
                             (Shader is disabled if GradientTexture is not assigned)
13
       14/03/07 - DaStr - Bugfixed TGLCustomCGBombShader.SetMaterialLibrary
14
                             Alpha is not stored now
15
                             Added design-time checks
16
       22/02/07 - DaStr - Initial version (contributed to GLScene)
17

18

19

20
    Previous version history:
21
     v1.0   08 March     '2006  Creation (based on NVIdia's FXComposer demo shader)
22
     v1.1   04 April     '2006  I found a way to use the Current Texture!
23
                                  See the TextureSource property for details...
24
     v1.2   14 August    '2006  TGLCgBombShader became child of
25
                                  TGLCgShader to support IShaderSuppoted
26
                                TShaderTextureSource added
27
     v1.3   19 August    '2006  TGLCustomCGBombShader added
28
                                GLS_OPTIMIZATIONS support added
29
                                TGLCustomCGBombShader.Set[Main/Gradient]Texture() updated
30
                                Cadencer stuff abstracted into TCadencableCustomCgShader
31

32
}
33

34
unit GLCgBombShader;
35

36
interface
37

38
{$I GLScene.inc}
39

40
uses
41
  // VCL
42
  Classes, SysUtils,
43

44
   cene
45
  GLTexture, GLCadencer, GLContext, OpenGLTokens, GLStrings, GLMaterial,
46
  GLRenderContextInfo, GLTextureFormat,
47

48
  // CG Shaders
49
  CgGL, GLCgShader;
50

51
type
52
  EGLCgBombShaderException = class(EGLCGShaderException);
53

54
  TGLCgBombShaderTextureSource = (stsPrimaryTexture, stsSecondadyTexture,
55
                                  stsThirdTexture, stsUserSelectedTexture);
56

57
  { Just a good-looking shader. }
58
  TGLCustomCGBombShader = class(TCadencableCustomCgShader, IGLMaterialLibrarySupported)
59
  private
60
    FMaterialLibrary: TGLAbstractMaterialLibrary;
61

62
    FGradientTexture: TGLTexture;
63
    FMainTexture:     TGLTexture;
64
    FMainTextureName:     TGLLibMaterialName;
65
    FGradientTextureName: TGLLibMaterialName;
66

67
    FSharpness:  Single;
68
    FColorRange: Single;
69
    FSpeed:      Single;
70
    FDisplacement: Single;
71
    FAlpha:      Single;
72
    FTurbDensity: Single;
73
    FColorSharpness: Single;
74
    FGradientTextureShare: Single;
75
    FMainTextureShare: Single;
76

77
{$IFNDEF GLS_OPTIMIZATIONS}
78
    FMainTextureSource: TGLCgBombShaderTextureSource;
79
{$ENDIF}
80
    procedure SetGradientTexture(const Value: TGLTexture);
81
    procedure SetMainTexture(const Value: TGLTexture);
82

83
    function GetMainTextureName: TGLLibMaterialName;
84
    procedure SetMainTextureName(const Value: TGLLibMaterialName);
85
    function GetGradientTextureName: TGLLibMaterialName;
86
    procedure SetGradientTextureName(const Value: TGLLibMaterialName);
87

88
    function StoreColorRange: Boolean;
89
    function StoreColorSharpness: Boolean;
90
    function StoreDisplacement: Boolean;
91
    function StoreGradientTextureShare: Boolean;
92
    function StoreSharpness: Boolean;
93
    function StoreSpeed: Boolean;
94
    function StoreTurbDensity: Boolean;
95
    function StoreMainTextureShare: Boolean;
96

97
    // Implementing IGLMaterialLibrarySupported.
98
    function GetMaterialLibrary: TGLAbstractMaterialLibrary;
99

100
  protected
101
    procedure DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject); override;
102
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
103
    procedure OnApplyVP(CgProgram: TCgProgram; Sender: TObject); virtual;
104
    procedure OnApplyFP(CgProgram: TCgProgram; Sender: TObject); virtual;
105
    procedure OnUnApplyFP(CgProgram: TCgProgram); virtual;
106

107
    procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual;
108
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
109
  public
110
    constructor Create(AOwner: TComponent); override;
111

112
    property MainTexture: TGLTexture read FMainTexture write SetMainTexture;
113
    property MainTextureName: TGLLibMaterialName read GetMainTextureName write SetMainTextureName;
114

115
    property GradientTexture: TGLTexture read FGradientTexture write SetGradientTexture;
116
    property GradientTextureName: TGLLibMaterialName read GetGradientTextureName write SetGradientTextureName;
117

118
    property GradientTextureShare: Single read FGradientTextureShare write FGradientTextureShare stored StoreGradientTextureShare;
119
    property MainTextureShare: Single read FMainTextureShare write FMainTextureShare stored StoreMainTextureShare;
120

121
    property Alpha: Single read FAlpha write FAlpha;
122
    property Displacement: Single read FDisplacement write FDisplacement stored StoreDisplacement;
123
    property Sharpness: Single read FSharpness write FSharpness stored StoreSharpness;
124
    property ColorSharpness: Single read FColorSharpness write FColorSharpness stored StoreColorSharpness;
125
    property Speed: Single read FSpeed write FSpeed stored StoreSpeed;
126
    property TurbDensity: Single read FTurbDensity write FTurbDensity stored StoreTurbDensity;
127
    property ColorRange: Single read FColorRange write FColorRange stored StoreColorRange;
128
{$IFNDEF GLS_OPTIMIZATIONS}
129
    property MainTextureSource: TGLCgBombShaderTextureSource read FMainTextureSource write FMainTextureSource;
130
{$ENDIF}
131
    property MaterialLibrary: TGLAbstractMaterialLibrary read FMaterialLibrary write SetMaterialLibrary;
132
  end;
133

134
  TGLCgBombShader = class(TGLCustomCGBombShader)
135
  protected
136
    procedure DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject); override;
137
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
138
    procedure OnApplyVP(CgProgram: TCgProgram; Sender: TObject); override;
139
    procedure OnApplyFP(CgProgram: TCgProgram; Sender: TObject); override;
140
    procedure OnUnApplyFP(CgProgram: TCgProgram); override;
141
  published
142
    property MainTextureShare;
143
    property MainTextureName;
144

145
    property GradientTextureShare;
146
    property GradientTextureName;
147

148
    property Alpha;
149
    property Cadencer;
150
    property Displacement;
151
    property Sharpness;
152
    property ColorSharpness;
153
    property Speed;
154
    property TurbDensity;
155
    property ColorRange;
156
    property MaterialLibrary;
157
    property DesignEnable;
158
  end;
159

160
implementation
161

162
const
163
  EPS = 0.001;
164

165
{ TGLCustomCGBombShader }
166

167
constructor TGLCustomCGBombShader.Create(AOwner: TComponent);
168
begin
169
  inherited;
170
  VertexProgram.OnApply := OnApplyVP;
171
  VertexProgram.ManualNotification := True;
172
  FragmentProgram.OnApply := OnApplyFP;
173
  FragmentProgram.OnUnApply := OnUnApplyFP;
174
  FragmentProgram.ManualNotification := True;
175

176
  FAlpha := 0.7;
177
  FDisplacement := 0.3;
178
  FSharpness := 3;
179
  FColorSharpness := 1;
180
  FSpeed := 0.3;
181
  FTurbDensity := 1;
182
  FColorRange := 0.24;
183
  FGradientTextureShare := 0.7;
184
  FMainTextureShare := 0.7;
185
{$IFNDEF GLS_OPTIMIZATIONS}
186
  FMainTextureSource := stsUserSelectedTexture;
187
{$ENDIF}
188
end;
189

190

191
procedure TGLCustomCGBombShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject);
192
begin
193
  VertexProgram.Apply(rci, Sender);
194
  FragmentProgram.Apply(rci, Sender);
195
{$IFDEF GLS_OPTIMIZATIONS}
196
  if FMainTexture <> nil then
197
    FragmentProgram.ParamByName('MainTextureSampler').SetAsTexture2D(FMainTexture.Handle);
198
{$ELSE}
199
  case FMainTextureSource of
200
    stsPrimaryTexture: FragmentProgram.ParamByName('MainTextureSampler').SetAsTexture2D(rci.GLStates.TextureBinding[0, ttTexture2D]);
201
    stsSecondadyTexture: FragmentProgram.ParamByName('MainTextureSampler').SetAsTexture2D(rci.GLStates.TextureBinding[1, ttTexture2D]);
202
    stsThirdTexture: FragmentProgram.ParamByName('MainTextureSampler').SetAsTexture2D(rci.GLStates.TextureBinding[2, ttTexture2D]);
203
    stsUserSelectedTexture:
204
      begin
205
        if FMainTexture <> nil then
206
          FragmentProgram.ParamByName('MainTextureSampler').SetAsTexture2D(FMainTexture.Handle);
207
      end;
208
  end;
209
{$ENDIF}
210
end;
211

212

213
procedure TGLCustomCGBombShader.DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject);
214
begin
215
  if FGradientTexture = nil then
216
  try
217
    FGradientTexture := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FGradientTextureName);
218
  except
219
    Enabled := False;
220
    raise;
221
  end;
222
  if FMainTexture = nil then
223
  try
224
    FMainTexture := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FMainTextureName);
225
  except end;
226

227
  with VertexProgram.Code do
228
  begin
229
    Clear;
230
    Add(' ');
231
    Add('//in ');
232
    Add('struct appData ');
233
    Add('{ ');
234
    Add('    float4 Position     : POSITION; ');
235
    Add('    float4 Normal       : NORMAL; ');
236
    Add('    float4 TexCoord0    : TEXCOORD0; ');
237
    Add('}; ');
238
    Add(' ');
239
    Add('// out ');
240
    Add('struct vertexOutData ');
241
    Add('{ ');
242
    Add('    float4 HPosition	: POSITION; ');
243
    Add('    float4 Color0	: COLOR0; ');
244
    Add('    float4 TexCoord0    : TEXCOORD0; ');
245
    Add('}; ');
246
    Add(' ');
247
    Add(' ');
248
    Add(' ');
249
    Add('vertexOutData main( ');
250
    Add('					appData IN, ');
251
    Add('                    uniform float4x4 WorldViewProj, ');
252
    Add('                    const float4x4 NoiseMatrix, ');
253
    Add('                    uniform float Timer, ');
254
    Add('                    uniform float Displacement, ');
255
    Add('                    uniform float Sharpness, ');
256
    Add('                    uniform float ColorSharpness , ');
257
    Add('                    uniform float Speed, ');
258
    Add('                    uniform float TurbDensity, ');
259
    Add('                    uniform float ColorRange ');
260
    Add('                   ) ');
261
    Add('{ ');
262
    Add('    vertexOutData OUT; ');
263
    Add('    OUT.TexCoord0 = IN.TexCoord0; ');
264
    Add('    float4 noisePos = TurbDensity * mul(IN.Position + (Speed * Timer), NoiseMatrix); ');
265
    Add('    float i = sin(noisePos.x + noisePos.y + noisePos.z + tan(noisePos.x + noisePos.y + noisePos.z)/100000 ); ');
266
    Add('    float cr = 0.5 + ColorRange * i; ');
267
    Add('    cr = pow(cr,ColorSharpness); ');
268
    Add('    OUT.Color0 = float4((cr).xxx, 1.0f); ');
269
    Add('    // Displacement along normal ');
270
    Add('    float ni = pow(abs(i), Sharpness); ');
271
    Add('    float4 Nn = float4(normalize(IN.Position).xyz,0); ');
272
    Add('    float4 NewPos = IN.Position - (Nn * (ni - 0.5) * Displacement) * 10; ');
273
    Add('     OUT.HPosition = mul(WorldViewProj, NewPos); ');
274
    Add('    return OUT; ');
275
    Add('} ');
276
  end;
277

278

279
  with FragmentProgram.Code do
280
  begin
281
    Clear;
282
    Add('struct vertexOutData ');
283
    Add('{ ');
284
    Add('    float4 Color0	: COLOR0; ');
285
    Add('    float4 TexCoord0    : TEXCOORD0; ');
286
    Add('}; ');
287
    Add(' ');
288
    Add('float4 main( ');
289
    Add('            vertexOutData IN, ');
290
    Add('            uniform sampler2D GradeSampler, ');
291
    Add('            uniform float GradientTextureShare, ');
292
    if FMainTexture <> nil then
293
    begin
294
      Add('            uniform sampler2D MainTextureSampler, ');
295
      Add('            uniform float MainTextureShare, ');
296
    end;
297
    Add('            uniform float Alpha ');
298
    Add('            ): COLOR ');
299
    Add('{ ');
300
    Add('	   float4 GradeColor = tex2D(GradeSampler, float2(IN.Color0.x, IN.Color0.y)); ');
301
    if FMainTexture <> nil then
302
      Add('    float4 TextureColor = tex2D(MainTextureSampler, IN.TexCoord0.xy); ');
303
    Add('    ');
304
    if FMainTexture <> nil then
305
      Add('    TextureColor = TextureColor * MainTextureShare + GradeColor * GradientTextureShare; ')
306
    else
307
      Add('    float4 TextureColor = GradeColor * GradientTextureShare; ');
308
    Add('    TextureColor.w = Alpha; ');
309
    Add('	   return TextureColor;');
310
    Add('} ');
311
  end;
312

313
  inherited DoInitialize(rci, Sender);
314

315
  // May be there was an error and shader disabled itself.
316
  if Enabled then
317
  begin
318
    Assert(FGradientTexture <> nil);
319
    VertexProgram.ParamByName('NoiseMatrix').SetAsStateMatrix(CG_GL_TEXTURE_MATRIX, CG_GL_MATRIX_IDENTITY);
320
    FragmentProgram.ParamByName('GradeSampler').SetAsTexture2D(FGradientTexture.Handle);
321
  end;
322
end;
323

324

325
function TGLCustomCGBombShader.GetGradientTextureName: TGLLibMaterialName;
326
begin
327
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FGradientTexture);
328
  if Result = '' then Result := FGradientTextureName;
329
end;
330

331
function TGLCustomCGBombShader.GetMainTextureName: TGLLibMaterialName;
332
begin
333
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTexture);
334
  if Result = '' then Result := FMainTextureName;
335
end;
336

337
function TGLCustomCGBombShader.GetMaterialLibrary: TGLAbstractMaterialLibrary;
338
begin
339
  Result := FMaterialLibrary;
340
end;
341

342
procedure TGLCustomCGBombShader.Notification(AComponent: TComponent;
343
  Operation: TOperation);
344
var
345
  Index: Integer;
346
begin
347
  inherited;
348
  if Operation = opRemove then
349
    if AComponent = FMaterialLibrary then
350
      if FMaterialLibrary <> nil then
351
      begin
352
        // Need to nil the textures that were owned by it
353
        if FMainTexture <> nil then
354
        begin
355
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FMainTexture);
356
          if Index <> -1 then
357
            SetMainTexture(nil);
358
        end;
359

360
        if FGradientTexture <> nil then
361
        begin
362
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FGradientTexture);
363
          if Index <> -1 then
364
            SetGradientTexture(nil);
365
        end;
366

367
        FMaterialLibrary := nil;
368
      end;
369
end;
370

371
procedure TGLCustomCGBombShader.OnApplyFP(CgProgram: TCgProgram; Sender: TObject);
372
begin
373
  CgProgram.ParamByName('Alpha').SetAsScalar(FAlpha);
374
  CgProgram.ParamByName('GradientTextureShare').SetAsScalar(FGradientTextureShare);
375
  CgProgram.ParamByName('GradeSampler').EnableTexture;
376
  if FMainTexture <> nil then
377
  begin
378
    CgProgram.ParamByName('MainTextureShare').SetAsScalar(FMainTextureShare);
379
    CgProgram.ParamByName('MainTextureSampler').EnableTexture;
380
  end;
381
end;
382

383

384
procedure TGLCustomCGBombShader.OnApplyVP(CgProgram: TCgProgram; Sender: TObject);
385
begin
386
  CgProgram.ParamByName('WorldViewProj').SetAsStateMatrix(CG_GL_MODELVIEW_PROJECTION_MATRIX, CG_GL_MATRIX_IDENTITY);
387
  CgProgram.ParamByName('Timer').SetAsScalar(Cadencer.CurrentTime);
388
  CgProgram.ParamByName('Displacement').SetAsScalar(FDisplacement);
389
  CgProgram.ParamByName('Sharpness').SetAsScalar(FSharpness);
390
  CgProgram.ParamByName('ColorSharpness').SetAsScalar(FColorSharpness);
391
  CgProgram.ParamByName('Speed').SetAsScalar(FSpeed);
392
  CgProgram.ParamByName('TurbDensity').SetAsScalar(FTurbDensity);
393
  CgProgram.ParamByName('ColorRange').SetAsScalar(FColorRange);
394
end;
395

396

397
procedure TGLCustomCGBombShader.OnUnApplyFP(CgProgram: TCgProgram);
398
begin
399
  CgProgram.ParamByName('GradeSampler').DisableTexture;
400
  if FMainTexture <> nil then
401
    CgProgram.ParamByName('MainTextureSampler').DisableTexture;
402
end;
403

404
procedure TGLCustomCGBombShader.SetGradientTexture(const Value: TGLTexture);
405
begin
406
  if FGradientTexture = Value then Exit;
407
  FGradientTexture := Value;
408
  NotifyChange(Self);
409
end;
410

411
procedure TGLCustomCGBombShader.SetGradientTextureName(
412
  const Value: TGLLibMaterialName);
413
begin
414
  FGradientTextureName := Value;
415
  if ShaderInitialized then
416
    NotifyChange(Self);
417
end;
418

419
procedure TGLCustomCGBombShader.SetMainTexture(
420
  const Value: TGLTexture);
421
begin
422
  if FMainTexture = Value then Exit;
423
  FMainTexture := Value;
424
  NotifyChange(Self);
425
end;
426

427
procedure TGLCustomCGBombShader.SetMainTextureName(
428
  const Value: TGLLibMaterialName);
429
begin
430
  FMainTextureName := Value;
431
  if ShaderInitialized then
432
    NotifyChange(Self);
433
end;
434

435
procedure TGLCustomCGBombShader.SetMaterialLibrary(
436
  const Value: TGLAbstractMaterialLibrary);
437
begin
438
  if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self);
439
  FMaterialLibrary := Value;
440
  if (FMaterialLibrary <> nil)
441
    and (FMaterialLibrary is TGLAbstractMaterialLibrary) then
442
      FMaterialLibrary.FreeNotification(Self);
443
end;
444

445
function TGLCustomCGBombShader.StoreColorRange: Boolean;
446
begin
447
  Result := Abs(FColorRange - 0.24) > EPS;
448
end;
449

450
function TGLCustomCGBombShader.StoreColorSharpness: Boolean;
451
begin
452
  Result := Abs(FColorSharpness - 1) > EPS;
453
end;
454

455
function TGLCustomCGBombShader.StoreDisplacement: Boolean;
456
begin
457
  Result := Abs(FDisplacement - 0.3) > EPS;
458
end;
459

460
function TGLCustomCGBombShader.StoreGradientTextureShare: Boolean;
461
begin
462
  Result := Abs(FGradientTextureShare - 0.7) > EPS;
463
end;
464

465
function TGLCustomCGBombShader.StoreMainTextureShare: Boolean;
466
begin
467
  Result := Abs(FMainTextureShare - 0.7) > EPS;
468
end;
469

470
function TGLCustomCGBombShader.StoreSharpness: Boolean;
471
begin
472
  Result := Abs(FSharpness - 3) > EPS;
473
end;
474

475
function TGLCustomCGBombShader.StoreSpeed: Boolean;
476
begin
477
  Result := Abs(FSpeed - 0.3) > EPS;
478
end;
479

480
function TGLCustomCGBombShader.StoreTurbDensity: Boolean;
481
begin
482
  Result := Abs(FTurbDensity - 1) > EPS;
483
end;
484

485
{ TGLCgBombShader }
486

487
procedure TGLCgBombShader.DoApply(var rci: TGLRenderContextInfo;
488
  Sender: TObject);
489
begin
490
{$IFNDEF GLS_OPTIMIZATIONS}
491
  if (not (csDesigning in ComponentState)) or DesignEnable then
492
    inherited;
493
{$ENDIF}
494
end;
495

496
procedure TGLCgBombShader.DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject);
497
begin
498
{$IFNDEF GLS_OPTIMIZATIONS}
499
  if (not (csDesigning in ComponentState)) or DesignEnable then
500
    inherited;
501
{$ENDIF}
502
end;
503

504
procedure TGLCgBombShader.OnApplyFP(CgProgram: TCgProgram;
505
  Sender: TObject);
506
begin
507
{$IFNDEF GLS_OPTIMIZATIONS}
508
  if (not (csDesigning in ComponentState)) or DesignEnable then
509
    inherited;
510
{$ENDIF}
511
end;
512

513
procedure TGLCgBombShader.OnApplyVP(CgProgram: TCgProgram;
514
  Sender: TObject);
515
begin
516
{$IFNDEF GLS_OPTIMIZATIONS}
517
  if (not (csDesigning in ComponentState)) or DesignEnable then
518
    inherited;
519
{$ENDIF}
520
end;
521

522
procedure TGLCgBombShader.OnUnApplyFP(CgProgram: TCgProgram);
523
begin
524
{$IFNDEF GLS_OPTIMIZATIONS}
525
  if (not (csDesigning in ComponentState)) or DesignEnable then
526
    inherited;
527
{$ENDIF}
528
end;
529

530
initialization
531
  RegisterClasses([TGLCustomCGBombShader, TGLCgBombShader]);
532

533
end.
534

535