LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Implements a basic shadow plane.
6

7
   It is strongly recommended to read and understand the explanations in the
8
   materials/mirror demo before using this component.
9

10
  History :  
11
       10/11/12 - PW - Added CPP compatibility: changed vector arrays to records
12
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
13
       22/06/10 - Yar - Fixes after GLState revision
14
       05/03/10 - DanB - More state added to TGLStateCache
15
       22/02/10 - Yar - Optimization of switching states
16
       12/03/09 - DanB - Bug-fix for scissor test on recent NVidia drivers
17
       06/06/07 - DaStr - Added GLColor to uses (BugtrackerID = 1732211)
18
       30/03/07 - DaStr - Added $I GLScene.inc
19
       28/03/07 - DaStr - Renamed parameters in some methods
20
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
21
       02/08/04 - LR, YHC - BCB corrections: use record instead array
22
       23/03/04 - EG - Added spoTransparent
23
       29/11/03 - EG - Scissors turned of if camera is withing bounding volume
24
       30/10/02 - EG - Added OnBegin/EndRenderingShadows
25
       25/10/02 - EG - Fixed Stencil cleanup and shadow projection bug
26
       02/10/02 - EG - Added spoScissor
27
       23/09/02 - EG - Creation (from GLMirror and Mattias FagerLund ShadowPlane.pas)
28
    
29
}
30
unit GLShadowPlane;
31

32
interface
33

34
{$I GLScene.inc}
35

36
uses
37
  Classes,
38
  GLScene,
39
  GLVectorGeometry,
40
  GLObjects,
41
  GLCrossPlatform,
42
  GLColor,
43
  GLRenderContextInfo,
44
  GLState,
45
  GLTextureFormat;
46

47
type
48

49
  // TShadowPlaneOptions
50
  //
51
  TShadowPlaneOption = (spoUseStencil, spoScissor, spoTransparent, spoIgnoreZ);
52
  TShadowPlaneOptions = set of TShadowPlaneOption;
53

54
const
55
  cDefaultShadowPlaneOptions = [spoUseStencil, spoScissor];
56

57
type
58

59
  // TGLShadowPlane
60
  //
61
  { A simple shadow plane.
62
     This mirror requires a stencil buffer for optimal rendering!
63
     The object is a mix between a plane and a proxy object, in that the plane
64
     defines where the shadows are cast, while the proxy part is used to reference
65
     the objects that should be shadowing (it is legal to self-shadow, but no
66
     self-shadow visuals will be rendered). 
67
     If stenciling isn't used, the shadow will 'paint' the ShadowColor instead
68
     of blending it transparently.
69
     You can have lower quality shadow geometry: add a dummycube, set it to
70
     invisible (so it won't be rendered in the "regular" pass), and under
71
     it place another visible dummycube under which you have all your
72
     low quality objects, use it as shadowing object. Apply the same movements
73
     to the low-quality objects that you apply to the visible, high-quality ones.
74
     }
75
  TGLShadowPlane = class(TGLPlane)
76
  private
77
     
78
    FRendering: Boolean;
79
    FShadowingObject: TGLBaseSceneObject;
80
    FShadowedLight: TGLLightSource;
81
    FShadowColor: TGLColor;
82
    FShadowOptions: TShadowPlaneOptions;
83
    FOnBeginRenderingShadows, FOnEndRenderingShadows: TNotifyEvent;
84

85
  protected
86
     
87
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
88
    procedure SetShadowingObject(const val: TGLBaseSceneObject);
89
    procedure SetShadowedLight(const val: TGLLightSource);
90
    procedure SetShadowColor(const val: TGLColor);
91
    procedure SetShadowOptions(const val: TShadowPlaneOptions);
92

93
  public
94
     
95
    constructor Create(AOwner: TComponent); override;
96
    destructor Destroy; override;
97

98
    procedure DoRender(var ARci: TGLRenderContextInfo;
99
      ARenderSelf, ARenderChildren: Boolean); override;
100

101
    procedure Assign(Source: TPersistent); override;
102

103
  published
104
     
105
          { Selects the object to mirror.
106
             If nil, the whole scene is mirrored. }
107
    property ShadowingObject: TGLBaseSceneObject read FShadowingObject write SetShadowingObject;
108
    { The light which casts shadows.
109
       The light must be enabled otherwise shadows won't be cast. }
110
    property ShadowedLight: TGLLightSource read FShadowedLight write SetShadowedLight;
111
    { The shadow's color.
112
       This color is transparently blended to make shadowed area darker. }
113
    property ShadowColor: TGLColor read FShadowColor write SetShadowColor;
114

115
    { Controls rendering options.
116
        
117
        spoUseStencil: plane area is stenciled, prevents shadowing
118
          objects to be visible on the sides of the mirror (stencil buffer
119
          must be active in the viewer too). It also allows shadows to
120
          be partial (blended).
121
        spoScissor: plane area is 'scissored', this should improve
122
          rendering speed by limiting rendering operations and fill rate,
123
          may have adverse effects on old hardware in rare cases
124
        spoTransparent: does not render the plane's material, may help
125
          improve performance if you're fillrate limited, are using the
126
          stencil, and your hardware has optimized stencil-only writes
127
        
128
    }
129
    property ShadowOptions: TShadowPlaneOptions read FShadowOptions write SetShadowOptions default cDefaultShadowPlaneOptions;
130

131
    { Fired before the shadows are rendered. }
132
    property OnBeginRenderingShadows: TNotifyEvent read FOnBeginRenderingShadows write FOnBeginRenderingShadows;
133
    { Fired after the shadows are rendered. }
134
    property OnEndRenderingShadows: TNotifyEvent read FOnEndRenderingShadows write FOnEndRenderingShadows;
135
  end;
136

137
  //-------------------------------------------------------------
138
  //-------------------------------------------------------------
139
  //-------------------------------------------------------------
140
implementation
141
//-------------------------------------------------------------
142
//-------------------------------------------------------------
143
//-------------------------------------------------------------
144
uses OpenGLTokens, GLContext;
145
// ------------------
146
// ------------------ TGLShadowPlane ------------------
147
// ------------------
148

149
// Create
150
//
151

152
constructor TGLShadowPlane.Create(AOwner: Tcomponent);
153
const
154
  cDefaultShadowColor: TColorVector = (X:0; Y:0; Z:0; W:0.5);
155
begin
156
  inherited Create(AOwner);
157
  FShadowOptions := cDefaultShadowPlaneOptions;
158
  ObjectStyle := ObjectStyle + [osDirectDraw];
159
  FShadowColor := TGLColor.CreateInitialized(Self, cDefaultShadowColor);
160
end;
161

162
// Destroy
163
//
164

165
destructor TGLShadowPlane.Destroy;
166
begin
167
  inherited;
168
  FShadowColor.Free;
169
end;
170

171
// DoRender
172
//
173

174
procedure TGLShadowPlane.DoRender(var ARci: TGLRenderContextInfo;
175
  ARenderSelf, ARenderChildren: Boolean);
176
var
177
  oldProxySubObject, oldIgnoreMaterials: Boolean;
178
  shadowMat: TMatrix;
179
  sr: TGLRect;
180
  CurrentBuffer: TGLSceneBuffer;
181
  ModelMat: TMatrix;
182
begin
183
  if FRendering then
184
    Exit;
185
  FRendering := True;
186
  try
187
    with ARci.GLStates do
188
    begin
189
      oldProxySubObject := ARci.proxySubObject;
190
      ARci.proxySubObject := True;
191
      CurrentBuffer := TGLSceneBuffer(ARci.buffer);
192

193
      if ARenderSelf and (VectorDotProduct(VectorSubtract(ARci.cameraPosition, AbsolutePosition), AbsoluteDirection) > 0) then
194
      begin
195

196
        if (spoScissor in ShadowOptions)
197
          and (PointDistance(ARci.cameraPosition) > BoundingSphereRadius) then
198
        begin
199
          sr := ScreenRect(CurrentBuffer);
200
          InflateGLRect(sr, 1, 1);
201
          IntersectGLRect(sr, GLRect(0, 0, ARci.viewPortSize.cx, ARci.viewPortSize.cy));
202
          GL.Scissor(sr.Left, sr.Top, sr.Right - sr.Left, sr.Bottom - sr.Top);
203
          Enable(stScissorTest);
204
        end;
205

206
        if (spoUseStencil in ShadowOptions) then
207
        begin
208
          StencilClearValue := 0;
209
          GL.Clear(GL_STENCIL_BUFFER_BIT);
210
          Enable(stStencilTest);
211
          SetStencilFunc(cfAlways, 1, 1);
212
          SetStencilOp(soReplace, soReplace, soReplace);
213
        end;
214

215
        // "Render"  plane and stencil mask
216
        if (spoTransparent in ShadowOptions) then
217
        begin
218
          SetGLColorWriting(False);
219
          DepthWriteMask := False;
220
          BuildList(ARci);
221
          SetGLColorWriting(True);
222
        end
223
        else
224
        begin
225
          Material.Apply(ARci);
226
          repeat
227
            BuildList(ARci);
228
          until not Material.UnApply(ARci);
229
        end;
230

231
        // Setup depth options
232
        if spoIgnoreZ in ShadowOptions then
233
          Disable(stDepthTest)
234
        else
235
          Enable(stDepthTest);
236
        DepthFunc := cfLEqual;
237

238
        if Assigned(FShadowedLight) then
239
        begin
240

241
          ARci.PipelineTransformation.Push;
242

243
          case ShadowedLight.LightStyle of
244
            lsParallel:
245
              begin
246
                shadowMat := MakeShadowMatrix(AbsolutePosition, AbsoluteDirection,
247
                  VectorScale(ShadowedLight.SpotDirection.AsVector, 1e10));
248
              end;
249
          else
250
            shadowMat := MakeShadowMatrix(AbsolutePosition, AbsoluteDirection,
251
              ShadowedLight.AbsolutePosition);
252
          end;
253

254
          ARci.PipelineTransformation.ViewMatrix := MatrixMultiply(
255
            shadowMat,
256
            ARci.PipelineTransformation.ViewMatrix);
257
          ARci.PipelineTransformation.ModelMatrix := IdentityHmgMatrix;
258

259
          Disable(stCullFace);
260
          Enable(stNormalize);
261
          SetPolygonOffset(-1, -1);
262
          Enable(stPolygonOffsetFill);
263

264
          oldIgnoreMaterials := ARci.ignoreMaterials;
265
          ARci.ignoreMaterials := True;
266
          ActiveTextureEnabled[ttTexture2D] := False;
267
          Disable(stLighting);
268
          Disable(stFog);
269

270
          GL.Color4fv(ShadowColor.AsAddress);
271

272
          if (spoUseStencil in ShadowOptions) then
273
          begin
274
            Enable(stBlend);
275
            Disable(stAlphaTest);
276
            SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
277
            SetStencilFunc(cfEqual, 1, 1);
278
            SetStencilOp(soKeep, soKeep, soZero);
279
          end
280
          else
281
            Disable(stBlend);
282

283
          if Assigned(FOnBeginRenderingShadows) then
284
            FOnBeginRenderingShadows(Self);
285
          if Assigned(FShadowingObject) then
286
          begin
287
            ModelMat := IdentityHmgMatrix;
288
            if FShadowingObject.Parent <> nil then
289
              MatrixMultiply(ModelMat, FShadowingObject.Parent.AbsoluteMatrix, ModelMat);
290
            MatrixMultiply(ModelMat, FShadowingObject.LocalMatrix^, ModelMat);
291
            ARci.PipelineTransformation.ModelMatrix := ModelMat;
292
            FShadowingObject.DoRender(ARci, True, (FShadowingObject.Count > 0));
293
          end
294
          else
295
          begin
296
            Scene.Objects.DoRender(ARci, True, True);
297
          end;
298
          if Assigned(FOnEndRenderingShadows) then
299
            FOnEndRenderingShadows(Self);
300

301
          ARci.ignoreMaterials := oldIgnoreMaterials;
302

303
          // Restore to "normal"
304
          ARci.PipelineTransformation.Pop;
305

306
        end;
307
        Disable(stStencilTest);
308
        Disable(stScissorTest);
309
        Disable(stPolygonOffsetFill);
310
      end;
311

312
      ARci.proxySubObject := oldProxySubObject;
313

314
      if ARenderChildren and (Count > 0) then
315
        Self.RenderChildren(0, Count - 1, ARci);
316
    end;
317
  finally
318
    FRendering := False;
319
  end;
320
end;
321

322
// Notification
323
//
324

325
procedure TGLShadowPlane.Notification(AComponent: TComponent; Operation: TOperation);
326
begin
327
  if Operation = opRemove then
328
  begin
329
    if AComponent = FShadowingObject then
330
      ShadowingObject := nil
331
    else if AComponent = FShadowedLight then
332
      ShadowedLight := nil;
333
  end;
334
  inherited;
335
end;
336

337
// SetShadowingObject
338
//
339

340
procedure TGLShadowPlane.SetShadowingObject(const val: TGLBaseSceneObject);
341
begin
342
  if FShadowingObject <> val then
343
  begin
344
    if Assigned(FShadowingObject) then
345
      FShadowingObject.RemoveFreeNotification(Self);
346
    FShadowingObject := val;
347
    if Assigned(FShadowingObject) then
348
      FShadowingObject.FreeNotification(Self);
349
    NotifyChange(Self);
350
  end;
351
end;
352

353
// SetShadowedLight
354
//
355

356
procedure TGLShadowPlane.SetShadowedLight(const val: TGLLightSource);
357
begin
358
  if FShadowedLight <> val then
359
  begin
360
    if Assigned(FShadowedLight) then
361
      FShadowedLight.RemoveFreeNotification(Self);
362
    FShadowedLight := val;
363
    if Assigned(FShadowedLight) then
364
      FShadowedLight.FreeNotification(Self);
365
    NotifyChange(Self);
366
  end;
367
end;
368

369
// SetShadowColor
370
//
371

372
procedure TGLShadowPlane.SetShadowColor(const val: TGLColor);
373
begin
374
  FShadowColor.Assign(val);
375
end;
376

377
 
378
//
379

380
procedure TGLShadowPlane.Assign(Source: TPersistent);
381
begin
382
  if Assigned(Source) and (Source is TGLShadowPlane) then
383
  begin
384
    FShadowOptions := TGLShadowPlane(Source).FShadowOptions;
385
    ShadowingObject := TGLShadowPlane(Source).ShadowingObject;
386
    ShadowedLight := TGLShadowPlane(Source).ShadowedLight;
387
    ShadowColor := TGLShadowPlane(Source).ShadowColor;
388
  end;
389
  inherited Assign(Source);
390
end;
391

392
// SetShadowOptions
393
//
394

395
procedure TGLShadowPlane.SetShadowOptions(const val: TShadowPlaneOptions);
396
begin
397
  if FShadowOptions <> val then
398
  begin
399
    FShadowOptions := val;
400
    NotifyChange(Self);
401
  end;
402
end;
403

404
//-------------------------------------------------------------
405
//-------------------------------------------------------------
406
//-------------------------------------------------------------
407
initialization
408
  //-------------------------------------------------------------
409
  //-------------------------------------------------------------
410
  //-------------------------------------------------------------
411

412
  RegisterClasses([TGLShadowPlane]);
413

414
end.
415

416