LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Implements projected textures through a GLScene object.
6

7
    History :  
8
       10/11/12 - PW - Added CPP compatibility: changed const cBase matrix
9
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
10
       22/04/10 - Yar - Fixes after GLState revision
11
       05/03/10 - DanB - More state added to TGLStateCache
12
       30/03/07 - DaStr - Added $I GLScene.inc
13
       28/03/07 - DaStr - Renamed parameters in some methods
14
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
15
       15/06/05 - Mathx - Added the Style property and inverse rendering
16
       07/05/05 - Mathx - Support for tmBlend textures (by Ruben Javier)
17
       01/10/04 - SG - Initial (by Matheus Degiovani)
18
    
19
}
20
unit GLProjectedTextures;
21

22
interface
23

24
{$I GLScene.inc}
25

26
uses
27
  Classes,
28
  GLScene,
29
  GLTexture,
30
  OpenGLTokens,
31
  GLVectorGeometry,
32
  XOpenGL,
33
  GLRenderContextInfo,
34
  GLState;
35

36
type
37
  { Possible styles of texture projection. Possible values: 
38
      ptsOriginal: Original projection method (first pass,
39
         is default scene render, second pass is texture
40
         projection).
41
      ptsInverse: Inverse projection method (first pass
42
         is texture projection, sencond pass is regular scene
43
         render). This method is useful if you want to simulate
44
         lighting only through projected textures (the textures
45
         of the scene are "masked" into the white areas of
46
         the projection textures).
47
       }
48
  TGLProjectedTexturesStyle = (ptsOriginal, ptsInverse);
49

50
  TGLProjectedTextures = class;
51

52
  // TGLTextureEmmiter
53
  //
54
  { A projected texture emmiter.
55
     It's material property will be used as the projected texture.
56
     Can be places anywhere in the scene. }
57
  TGLTextureEmitter = class(TGLSceneObject)
58
  private
59
     
60
    FFOVy: single;
61
    FAspect: single;
62

63
  protected
64
     
65
    { Sets up the base texture matrix for this emitter
66
       Should be called whenever a change on its properties is made.}
67
    procedure SetupTexMatrix(var ARci: TGLRenderContextInfo);
68

69
  public
70
     
71
    constructor Create(AOwner: TComponent); override;
72

73
  published
74
     
75
    { Indicates the field-of-view of the projection frustum.}
76
    property FOVy: single read FFOVy write FFOVy;
77

78
    { x/y ratio. For no distortion, this should be set to
79
       texture.width/texture.height.}
80
    property Aspect: single read FAspect write FAspect;
81
  end;
82

83
  // TGLTextureEmitterItem
84
  //
85
  { Specifies an item on the TGLTextureEmitters collection. }
86
  TGLTextureEmitterItem = class(TCollectionItem)
87
  private
88
     
89
    FEmitter: TGLTextureEmitter;
90

91
  protected
92
     
93
    procedure SetEmitter(const val: TGLTextureEmitter);
94
    procedure RemoveNotification(aComponent: TComponent);
95
    function GetDisplayName: string; override;
96

97
  public
98
     
99
    constructor Create(ACollection: TCollection); override;
100
    procedure Assign(Source: TPersistent); override;
101

102
  published
103
     
104
    property Emitter: TGLTextureEmitter read FEmitter write SetEmitter;
105

106
  end;
107

108
  // TGLTextureEmitters
109
  //
110
  { Collection of TGLTextureEmitter. }
111
  TGLTextureEmitters = class(TCollection)
112
  private
113
     
114
    FOwner: TGLProjectedTextures;
115

116
  protected
117
     
118
    function GetOwner: TPersistent; override;
119
    function GetItems(index: Integer): TGLTextureEmitterItem;
120
    procedure RemoveNotification(aComponent: TComponent);
121

122
  public
123
     
124
    procedure AddEmitter(texEmitter: TGLTextureEmitter);
125

126
    property Items[index: Integer]: TGLTextureEmitterItem read GetItems; default;
127

128
  end;
129

130
  // TGLProjectedTexture
131
  //
132
  { Projected Textures Manager.
133
     Specifies active texture Emitters (whose texture will be projected)
134
     and receivers (children of this object). }
135
  TGLProjectedTextures = class(TGLImmaterialSceneObject)
136
  private
137
     
138
    FEmitters: TGLTextureEmitters;
139
    FStyle: TGLProjectedTexturesStyle;
140

141
  public
142
     
143
    constructor Create(AOwner: TComponent); override;
144
    destructor Destroy; override;
145
    procedure DoRender(var ARci: TGLRenderContextInfo;
146
      ARenderSelf, ARenderChildren: Boolean); override;
147

148
  published
149
     
150

151
    { List of texture emitters. }
152
    property Emitters: TGLTextureEmitters read FEmitters write FEmitters;
153

154
    { Indicates the style of the projected textures. }
155
    property Style: TGLProjectedTexturesStyle read FStyle write FStyle;
156
  end;
157

158
  //-------------------------------------------------------------
159
  //-------------------------------------------------------------
160
  //-------------------------------------------------------------
161
implementation
162
//-------------------------------------------------------------
163
//-------------------------------------------------------------
164
//-------------------------------------------------------------
165
uses
166
  GLContext;
167
// ------------------
168
// ------------------ TGLTextureEmitter ------------------
169
// ------------------
170

171
// Create
172
//
173

174
constructor TGLTextureEmitter.Create(aOwner: TComponent);
175
begin
176
  inherited Create(aOwner);
177
  FFOVy := 90;
178
  FAspect := 1;
179
end;
180

181
// SetupTexMatrix
182
//
183

184
procedure TGLTextureEmitter.SetupTexMatrix(var ARci: TGLRenderContextInfo);
185
const
186
  cBaseMat: TMatrix =
187
  (V:((X:0.5; Y:0;   Z:0; W:0),
188
          (X:0;   Y:0.5; Z:0; W:0),
189
          (X:0;   Y:0; Z:1; W:0),
190
          (X:0.5; Y:0.5; Z:0; W:1)));
191

192
var
193
  PM: TMatrix;
194
begin
195
  // Set the projector's "perspective" (i.e. the "spotlight cone"):.
196
  PM := MatrixMultiply(CreatePerspectiveMatrix(FFOVy, FAspect, 0.1, 1), cBaseMat);
197
  PM := MatrixMultiply(invAbsoluteMatrix, PM);
198
  Arci.GLStates.SetGLTextureMatrix(PM);
199
end;
200

201
// ------------------
202
// ------------------ TGLTextureEmitterItem ------------------
203
// ------------------
204

205
// Create
206
//
207

208
constructor TGLTextureEmitterItem.Create(ACollection: TCollection);
209
begin
210
  inherited Create(ACollection);
211
end;
212

213
 
214
//
215

216
procedure TGLTextureEmitterItem.Assign(Source: TPersistent);
217
begin
218
  if Source is TGLTextureEmitterItem then
219
  begin
220
    FEmitter := TGLTextureEmitterItem(Source).FEmitter;
221
    TGLProjectedTextures(TGLTextureEmitters(Collection).GetOwner).StructureChanged;
222
  end;
223
  inherited;
224
end;
225

226
// SetCaster
227
//
228

229
procedure TGLTextureEmitterItem.SetEmitter(const val: TGLTextureEmitter);
230
begin
231
  if FEmitter <> val then
232
  begin
233
    FEmitter := val;
234
    TGLProjectedTextures(TGLTextureEmitters(Collection).GetOwner).StructureChanged;
235
  end;
236
end;
237

238
// RemoveNotification
239
//
240

241
procedure TGLTextureEmitterItem.RemoveNotification(aComponent: TComponent);
242
begin
243
  if aComponent = FEmitter then
244
    FEmitter := nil;
245
end;
246

247
// GetDisplayName
248
//
249

250
function TGLTextureEmitterItem.GetDisplayName: string;
251
begin
252
  if Assigned(FEmitter) then
253
  begin
254
    Result := '[TexEmitter] ' + FEmitter.Name;
255
  end
256
  else
257
    Result := 'nil';
258
end;
259

260
// ------------------
261
// ------------------ TGLTextureEmitters ------------------
262
// ------------------
263

264
// GetOwner
265
//
266

267
function TGLTextureEmitters.GetOwner: TPersistent;
268
begin
269
  Result := FOwner;
270
end;
271

272
// GetItems
273
//
274

275
function TGLTextureEmitters.GetItems(index: Integer): TGLTextureEmitterItem;
276
begin
277
  Result := TGLTextureEmitterItem(inherited Items[index]);
278
end;
279

280
// RemoveNotification
281
//
282

283
procedure TGLTextureEmitters.RemoveNotification(aComponent: TComponent);
284
var
285
  i: Integer;
286
begin
287
  for i := 0 to Count - 1 do
288
    Items[i].RemoveNotification(aComponent);
289
end;
290

291
// AddEmitter
292
//
293

294
procedure TGLTextureEmitters.AddEmitter(texEmitter: TGLTextureEmitter);
295
var
296
  item: TGLTextureEmitterItem;
297
begin
298
  item := TGLTextureEmitterItem(self.Add);
299
  item.Emitter := texEmitter;
300
end;
301

302
// ------------------
303
// ------------------ TGLProjectedTextures ------------------
304
// ------------------
305

306
// Create
307
//
308

309
constructor TGLProjectedTextures.Create(AOwner: TComponent);
310
begin
311
  inherited Create(aOWner);
312
  FEmitters := TGLTextureEmitters.Create(TGLTextureEmitterItem);
313
  FEmitters.FOwner := self;
314
end;
315

316
// Destroy
317
//
318

319
destructor TGLProjectedTextures.Destroy;
320
begin
321
  FEmitters.Free;
322
  inherited destroy;
323
end;
324

325
// DoRender
326
//
327

328
procedure TGLProjectedTextures.DoRender(var ARci: TGLRenderContextInfo;
329
  ARenderSelf, ARenderChildren: boolean);
330
const
331
  PS: array[0..3] of GLfloat = (1, 0, 0, 0);
332
  PT: array[0..3] of GLfloat = (0, 1, 0, 0);
333
  PR: array[0..3] of GLfloat = (0, 0, 1, 0);
334
  PQ: array[0..3] of GLfloat = (0, 0, 0, 1);
335
var
336
  i: integer;
337
  emitter: TGLTextureEmitter;
338
begin
339
  if not (ARenderSelf or ARenderChildren) then
340
    Exit;
341
  if (csDesigning in ComponentState) then
342
  begin
343
    inherited;
344
    Exit;
345
  end;
346

347
  //First pass of original style: render regular scene
348
  if Style = ptsOriginal then
349
    self.RenderChildren(0, Count - 1, ARci);
350

351
  //generate planes
352
  GL.TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
353
  GL.TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
354
  GL.TexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
355
  GL.TexGeni(GL_Q, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
356

357
  GL.TexGenfv(GL_S, GL_EYE_PLANE, @PS);
358
  GL.TexGenfv(GL_T, GL_EYE_PLANE, @PT);
359
  GL.TexGenfv(GL_R, GL_EYE_PLANE, @PR);
360
  GL.TexGenfv(GL_Q, GL_EYE_PLANE, @PQ);
361

362
  //options
363
  Arci.GLStates.Disable(stLighting);
364
  Arci.GLStates.DepthFunc := cfLEqual;
365
  Arci.GLStates.Enable(stBlend);
366
  GL.Enable(GL_TEXTURE_GEN_S);
367
  GL.Enable(GL_TEXTURE_GEN_T);
368
  GL.Enable(GL_TEXTURE_GEN_R);
369
  GL.Enable(GL_TEXTURE_GEN_Q);
370

371
  //second pass (original) first pass (inverse): for each emiter,
372
  //render projecting the texture summing all emitters
373
  for i := 0 to Emitters.Count - 1 do
374
  begin
375
    emitter := Emitters[i].Emitter;
376
    if not assigned(emitter) then
377
      continue;
378
    if not emitter.Visible then
379
      continue;
380

381
    emitter.Material.Apply(ARci);
382

383
    ARci.GLStates.Enable(stBlend);
384
    if Style = ptsOriginal then
385
    begin
386
      //on the original style, render blending the textures
387
      if emitter.Material.Texture.TextureMode <> tmBlend then
388
        ARci.GLStates.SetBlendFunc(bfDstColor, bfOne)
389
      else
390
        ARci.GLStates.SetBlendFunc(bfDstColor, bfZero);
391
    end
392
    else
393
    begin
394
      //on inverse style: the first texture projector should
395
      //be a regular rendering (i.e. no blending). All others
396
      //are "added" together creating an "illumination mask"
397
      if i = 0 then
398
        Arci.GLStates.SetBlendFunc(bfOne, bfZero)
399
      else
400
        ARci.GLStates.SetBlendFunc(bfOne, bfOne);
401
    end;
402

403
    //get this emitter's tex matrix
404
    emitter.SetupTexMatrix(ARci);
405
    repeat
406
      ARci.ignoreMaterials := true;
407
      Self.RenderChildren(0, Count - 1, ARci);
408
      ARci.ignoreMaterials := false;
409
    until not emitter.Material.UnApply(ARci);
410
  end;
411

412
  // LoseTexMatrix
413
  ARci.GLStates.SetBlendFunc(bfOne, bfZero);
414
  GL.Disable(GL_TEXTURE_GEN_S);
415
  GL.Disable(GL_TEXTURE_GEN_T);
416
  GL.Disable(GL_TEXTURE_GEN_R);
417
  GL.Disable(GL_TEXTURE_GEN_Q);
418

419
  GL.MatrixMode(GL_TEXTURE);
420
  GL.LoadIdentity;
421
  GL.MatrixMode(GL_MODELVIEW);
422

423
  ARci.GLStates.DepthFunc := cfLEqual;
424

425
  //second pass (inverse): render regular scene, blending it
426
  //with the "mask"
427
  if Style = ptsInverse then
428
  begin
429

430
    Arci.GLStates.Enable(stBlend);
431
    ARci.GLStates.SetBlendFunc(bfDstColor, bfSrcColor);
432

433
    //second pass: render everything, blending with what is
434
    //already there
435
    ARci.ignoreBlendingRequests := true;
436
    self.RenderChildren(0, Count - 1, ARci);
437
    ARci.ignoreBlendingRequests := false;
438

439
  end;
440
end;
441

442
initialization
443

444
  RegisterClasses([TGLTextureEmitter, TGLProjectedTextures]);
445

446
end.
447

448