LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Lattice shader that simulate Lattice.
6
   At this time only one light source is supported
7

8
    History :  
9
     08/12/15 - J.Delauney - Made compatible with the latest SVN version of GLScene
10
     02/11/06 - Da Stranger - Creation
11
}
12

13

14
unit GLSLLatticeShader;
15

16
interface
17

18
{$I GLScene.inc}
19

20
uses
21
  Classes,
22
   
23
  GLScene, GLCrossPlatform, GLBaseClasses, GLState, OpenGLTokens, OpenGL1x, GLContext, GLRenderContextInfo,
24
  GLVectorGeometry, GLCoordinates,
25
  GLTextureFormat,GLColor, GLTexture, GLMaterial,
26
  GLSLShader, GLCustomShader;
27

28
//TGLCustomGLSLSimpleLatticeShader
29
//
30
{ Custom class for GLSLSimpleLatticeShader.
31
 A shader that simulate Lattice }
32
type
33
  TGLCustomGLSLSimpleLatticeShader = class(TGLCustomGLSLShader)
34
  private
35
    FLatticeScale: TGLCoordinates2;
36
    FLatticeThreshold: TGLCoordinates2;
37
    procedure SetLatticeScale(const Value: TGLCoordinates2);
38
    procedure SetLatticeThreshold(const Value: TGLCoordinates2);
39
  protected
40
    procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override;
41
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
42
  public
43
    constructor Create(AOwner : TComponent); override;
44
    destructor Destroy; override;
45
    property LatticeScale: TGLCoordinates2 read FLatticeScale write SetLatticeScale;
46
    property LatticeThreshold: TGLCoordinates2 read FLatticeThreshold write SetLatticeThreshold;
47
  end;
48

49

50
//TGLCustomGLSLLatticeShader
51
//
52
{ Custom class for GLSLLatticeShader.
53
 A shader that simulate Lattice with Diffuse/Specular and support Texture }
54
  TGLCustomGLSLLatticeShader = class(TGLCustomGLSLSimpleLatticeShader)
55
  private
56
    FAmbientColor: TGLColor;
57
    FDiffuseColor: TGLColor;
58
    FSpecularColor: TGLColor;
59

60
    FMaterialLibrary: TGLAbstractMaterialLibrary;
61
    FMainTexture: TGLTexture;
62
    FMainTexName   : TGLLibMaterialName;
63

64
    FSpecularPower: Single;
65
    FLightPower: Single;
66

67
    function GetMaterialLibrary: TGLAbstractMaterialLibrary;
68

69
    procedure SetMainTexTexture(const Value: TGLTexture);
70
    function GetMainTexName: TGLLibMaterialName;
71
    procedure SetMainTexName(const Value: TGLLibMaterialName);
72

73
    procedure SetDiffuseColor(AValue: TGLColor);
74
    procedure SetAmbientColor(AValue: TGLColor);
75
    procedure SetSpecularColor(AValue: TGLColor);
76

77
  protected
78
    procedure DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject); override;
79
    procedure DoApply(var rci : TGLRenderContextInfo; Sender : TObject); override;
80

81
    procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary); virtual;
82
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
83
  public
84
    constructor Create(AOwner : TComponent); override;
85
    destructor Destroy; override;
86

87
    property DiffuseColor : TGLColor read FDiffuseColor Write setDiffuseColor;
88
    property SpecularColor : TGLColor Read FSpecularColor Write setSpecularColor;
89
    property AmbientColor : TGLColor Read FAmbientColor Write setAmbientColor;
90

91
    property MaterialLibrary: TGLAbstractMaterialLibrary read getMaterialLibrary write SetMaterialLibrary;
92
    property MainTexture: TGLTexture read FMainTexture write SetMainTexTexture;
93
    property MainTextureName: TGLLibMaterialName read GetMainTexName write SetMainTexName;
94

95
    property SpecularPower: Single read FSpecularPower write FSpecularPower;
96
    property LightPower: Single read FLightPower write FLightPower;
97

98
  end;
99

100
  TGLSLSimpleLatticeShader = class(TGLCustomGLSLSimpleLatticeShader)
101
  published
102
    property LatticeScale;
103
    property LatticeThreshold;
104
  end;
105

106
  TGLSLLatticeShader = class(TGLCustomGLSLLatticeShader)
107
  published
108
    property LatticeScale;
109
    property LatticeThreshold;
110

111
    property AmbientColor;
112
    property DiffuseColor;
113
    property SpecularColor;
114

115
    property MainTexture;
116

117
    property SpecularPower;
118
    property LightPower;
119
  end;
120

121
implementation
122

123
{ TGLCustomGLSLSimpleLatticeShader }
124

125
constructor TGLCustomGLSLSimpleLatticeShader.Create(AOwner: TComponent);
126
begin
127
  inherited;
128
  with FragmentProgram.Code do
129
  begin
130
    Clear;
131
    Add('  uniform vec2  Scale; ');
132
    Add('  uniform vec2  Threshold; ');
133
    Add(' ');
134
    Add('  void main (void) ');
135
    Add('{ ');
136
    Add('    float ss = fract(gl_TexCoord[0].s * Scale.s); ');
137
    Add('    float tt = fract(gl_TexCoord[0].t * Scale.t); ');
138
    Add(' ');
139
    Add('    if ((ss > Threshold.s) && (tt > Threshold.t)) discard; ');
140
    Add('    gl_FragColor = gl_Color;');
141
    Add('} ');
142
  end;
143

144
  // Initial stuff.
145
  FLatticeScale := TGLCoordinates2.Create(Self);
146
  FLatticeThreshold := TGLCoordinates2.Create(Self);
147

148
  FLatticeScale.SetPoint2D(10, 40);
149
  FLatticeThreshold.SetPoint2D(0.15, 0.3);
150
end;
151

152
destructor TGLCustomGLSLSimpleLatticeShader.Destroy;
153
begin
154
  FLatticeScale.Destroy;
155
  FLatticeThreshold.Destroy;
156
  inherited;
157
end;
158

159
procedure TGLCustomGLSLSimpleLatticeShader.DoApply(var rci: TGLRenderContextInfo;Sender: TObject);
160
begin
161
  GetGLSLProg.UseProgramObject;
162
  Param['Scale'].AsVector2f := FLatticeScale.AsPoint2D;
163
  Param['Threshold'].AsVector2f := FLatticeThreshold.AsPoint2D;
164
end;
165

166
function TGLCustomGLSLSimpleLatticeShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
167
begin
168
  Result := False;
169
  //gl.ActiveTexture(GL_TEXTURE0_ARB);
170
  GetGLSLProg.EndUseProgramObject;
171
end;
172

173
procedure TGLCustomGLSLSimpleLatticeShader.SetLatticeScale(
174
  const Value: TGLCoordinates2);
175
begin
176
  FLatticeScale.Assign(Value);
177
end;
178

179
procedure TGLCustomGLSLSimpleLatticeShader.SetLatticeThreshold(
180
  const Value: TGLCoordinates2);
181
begin
182
  FLatticeThreshold.Assign(Value);
183
end;
184

185
{ TGLCustomGLSLLatticeShader }
186

187
constructor TGLCustomGLSLLatticeShader.Create(
188
  AOwner: TComponent);
189
begin
190
  inherited;
191
  FAmbientColor := TGLColor.Create(Self);
192
  FDiffuseColor := TGLColor.Create(Self);
193
  FSpecularColor := TGLColor.Create(Self);
194

195
  //setup initial parameters
196
  FAmbientColor.SetColor(0.15, 0.15, 0.15, 1);
197
  FDiffuseColor.SetColor(1, 1, 1, 1);
198
  FSpecularColor.SetColor(1, 1, 1, 1);
199

200
  FSpecularPower  := 8;  //6
201
  FLightPower     := 1;
202
end;
203

204
destructor TGLCustomGLSLLatticeShader.Destroy;
205
begin
206
  FAmbientColor.Destroy;
207
  FDiffuseColor.Destroy;
208
  FSpecularColor.Destroy;
209

210
  inherited;
211
end;
212

213
procedure TGLCustomGLSLLatticeShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject);
214
begin
215

216
  inherited;
217

218
  Param['AmbientColor'].AsVector4f := FAmbientColor.Color;
219
  Param['DiffuseColor'].AsVector4f := FDiffuseColor.Color;
220
  Param['SpecularColor'].AsVector4f := FSpecularColor.Color;
221

222
  Param['SpecPower'].AsVector1f := FSpecularPower;
223
  Param['LightIntensity'].AsVector1f := FLightPower;
224

225
  Param['MainTexture'].AsTexture2D[0] := FMainTexture;
226

227
end;
228

229
procedure TGLCustomGLSLLatticeShader.DoInitialize(var rci : TGLRenderContextInfo; Sender : TObject);
230
begin
231
  with VertexProgram.Code do
232
  begin
233
    Clear;
234
    Add('varying vec3 Normal; ');
235
    Add('varying vec3 LightVector; ');
236
    Add('varying vec3 CameraVector; ');
237
    Add('varying vec2 Texcoord; ');
238
    Add(' ');
239
    Add(' ');
240
    Add('void main(void) ');
241
    Add('{ ');
242
    Add('  gl_Position = ftransform(); ');
243
    Add('  Texcoord = gl_MultiTexCoord0.xy; ');
244
    Add('  Normal = normalize(gl_NormalMatrix * gl_Normal); ');
245
    Add('  vec3 p = (gl_ModelViewMatrix * gl_Vertex).xyz; ');
246
    Add('  LightVector = normalize(gl_LightSource[0].position.xyz - p); ');
247
    Add('  CameraVector = normalize(p); ');
248
    Add('} ');
249
  end;
250

251
  with FragmentProgram.Code do
252
  begin
253
    Clear;
254
    Add('  uniform vec2  Scale; ');
255
    Add('  uniform vec2  Threshold; ');
256
    Add(' ');
257
    Add('uniform vec4 AmbientColor; ');
258
    Add('uniform vec4 DiffuseColor; ');
259
    Add('uniform vec4 SpecularColor; ');
260
    Add(' ');
261
    Add('uniform float LightIntensity; ');
262
    Add('uniform float SpecPower; ');
263
    Add('uniform sampler2D MainTexture; ');
264
    Add(' ');
265
    Add('varying vec3 Normal; ');
266
    Add('varying vec3 LightVector; ');
267
    Add('varying vec3 CameraVector; ');
268
    Add('varying vec2 Texcoord; ');
269
    Add(' ');
270
    Add('void main(void) ');
271
    Add('{ ');
272
    Add('    float ss = fract(Texcoord[0] * Scale.s); ');
273
    Add('    float tt = fract(Texcoord[1] * Scale.t); ');
274
    Add(' ');
275
    Add('    if ((ss > Threshold.s) && (tt > Threshold.t)) discard; ');
276
    Add(' ');
277
    Add('  vec4 TextureContrib = texture2D(MainTexture, Texcoord); ');
278
    Add('  vec4 DiffuseContrib = clamp(DiffuseColor * dot(LightVector, Normal), 0.0, 1.0); ');
279
    Add(' ');
280
    Add('  vec3 reflect_vec = reflect(CameraVector, -Normal); ');
281
    Add('  float Temp = dot(reflect_vec, LightVector); ');
282
    Add('  vec4 SpecContrib = SpecularColor * clamp(pow(Temp, SpecPower), 0.0, 0.95); ');
283
    Add(' ');
284
    Add('  gl_FragColor = TextureContrib * LightIntensity * (AmbientColor + DiffuseContrib) + LightIntensity * SpecContrib; ');
285
    Add('} ');
286
  end;
287
  inherited;
288
end;
289

290

291
function TGLCustomGLSLLatticeShader.GetMaterialLibrary: TGLAbstractMaterialLibrary;
292
begin
293
  Result := FMaterialLibrary;
294
end;
295

296
procedure TGLCustomGLSLLatticeShader.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
297
begin
298
  if FMaterialLibrary <> nil then FMaterialLibrary.RemoveFreeNotification(Self);
299
  FMaterialLibrary := Value;
300
  if (FMaterialLibrary <> nil)
301
    and (FMaterialLibrary is TGLAbstractMaterialLibrary) then
302
      FMaterialLibrary.FreeNotification(Self);
303
end;
304

305
procedure TGLCustomGLSLLatticeShader.SetMainTexTexture(const Value: TGLTexture);
306
begin
307
  if FMainTexture = Value then Exit;
308
  FMainTexture := Value;
309
  NotifyChange(Self)
310
end;
311

312
function TGLCustomGLSLLatticeShader.GetMainTexName: TGLLibMaterialName;
313
begin
314
  Result := TGLMaterialLibrary(FMaterialLibrary).GetNameOfTexture(FMainTexture);
315
  if Result = '' then Result := FMainTexName;
316
end;
317

318
procedure TGLCustomGLSLLatticeShader.SetMainTexName(const Value: TGLLibMaterialName);
319
begin
320
 // Assert(not(assigned(FMaterialLibrary)),'You must set Material Library Before');
321
  if FMainTexName = Value then Exit;
322
  FMainTexName  := Value;
323

324
  FMainTexture := TGLMaterialLibrary(FMaterialLibrary).TextureByName(FMainTexName);
325
  NotifyChange(Self);
326
end;
327

328

329
procedure TGLCustomGLSLLatticeShader.SetDiffuseColor(AValue: TGLColor);
330
begin
331
  FDiffuseColor.DirectColor := AValue.Color;
332
end;
333

334
procedure TGLCustomGLSLLatticeShader.SetAmbientColor(AValue: TGLColor);
335
begin
336
  FAmbientColor.DirectColor := AValue.Color;
337
end;
338

339
procedure TGLCustomGLSLLatticeShader.SetSpecularColor(AValue: TGLColor);
340
begin
341
  FSpecularColor.DirectColor := AValue.Color;
342
end;
343

344
procedure TGLCustomGLSLLatticeShader.Notification(AComponent: TComponent; Operation: TOperation);
345
var
346
  Index: Integer;
347
begin
348
  inherited;
349
  if Operation = opRemove then
350
    if AComponent = FMaterialLibrary then
351
      if FMaterialLibrary <> nil then
352
      begin
353

354
        if FMainTexture <> nil then
355
        begin
356
          Index := TGLMaterialLibrary(FMaterialLibrary).Materials.GetTextureIndex(FMainTexture);
357
          if Index <> -1 then
358
            SetMainTexTexture(nil);
359
        end;
360

361
        FMaterialLibrary := nil;
362
      end;
363
end;
364

365
end.
366

367