LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A TGLImmaterialSceneObject drawing 6 quads (plus another quad as "Cloud" plane)
6
   for use as a skybox always centered on the camera.
7

8
  History :  
9
       16/03/11 - Yar - Fixes after emergence of GLMaterialEx
10
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
11
       22/04/10 - Yar - Fixes after GLState revision
12
       05/03/10 - DanB - More state added to TGLStateCache
13
       26/03/09 - DanB - Skybox is now a TGLCameraInvariantObject
14
       10/10/08 - DanB - changed Skybox DoRender to use rci instead
15
                            of Scene.CurrentGLCamera
16
       30/03/07 - DaStr - Added $I GLScene.inc
17
       28/03/07 - DaStr - Renamed parameters in some methods
18
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
19
       21/01/07 - DaStr - Added IGLMaterialLibrarySupported support
20
       12/04/04 - EG - Added Style property, multipass support
21
       27/11/03 - EG - Cleanup and fixes
22
       09/11/03 - MRQZZZ - mandatory changes suggested by Eric.
23
       02/09/03 - MRQZZZ - Creation
24
    
25
}
26
unit GLSkyBox;
27

28
interface
29

30
{$I GLScene.inc}
31

32
uses
33
  Classes,
34
  GLScene,
35
  GLMaterial,
36
  GLVectorGeometry,
37
  OpenGLTokens,
38
  XOpenGL,
39
  GLRenderContextInfo
40
, GLVectorTypes;
41

42
type
43

44
  // TGLSkyBoxStyle
45
  //
46
  TGLSkyBoxStyle = (sbsFull, sbsTopHalf, sbsBottomHalf, sbTopTwoThirds,
47
    sbsTopHalfClamped);
48

49
  // TGLSkyBox
50
  //
51
  TGLSkyBox = class(TGLCameraInvariantObject, IGLMaterialLibrarySupported)
52
  private
53
     
54
    FMatNameTop: string;
55
    FMatNameRight: string;
56
    FMatNameFront: string;
57
    FMatNameLeft: string;
58
    FMatNameBack: string;
59
    FMatNameBottom: string;
60
    FMatNameClouds: string;
61
    FMaterialLibrary: TGLMaterialLibrary;
62
    FCloudsPlaneOffset: Single;
63
    FCloudsPlaneSize: Single;
64
    FStyle: TGLSkyBoxStyle;
65

66
    //implementing IGLMaterialLibrarySupported
67
    function GetMaterialLibrary: TGLAbstractMaterialLibrary;
68
  protected
69
     
70
    procedure SetMaterialLibrary(const Value: TGLMaterialLibrary);
71
    procedure SetMatNameBack(const Value: string);
72
    procedure SetMatNameBottom(const Value: string);
73
    procedure SetMatNameFront(const Value: string);
74
    procedure SetMatNameLeft(const Value: string);
75
    procedure SetMatNameRight(const Value: string);
76
    procedure SetMatNameTop(const Value: string);
77
    procedure SetMatNameClouds(const Value: string);
78
    procedure SetCloudsPlaneOffset(const Value: single);
79
    procedure SetCloudsPlaneSize(const Value: single);
80
    procedure SetStyle(const value: TGLSkyBoxStyle);
81

82
  public
83
     
84
    constructor Create(AOwner: TComponent); override;
85
    destructor Destroy; override;
86

87
    procedure DoRender(var ARci: TGLRenderContextInfo;
88
      ARenderSelf, ARenderChildren: Boolean); override;
89
    procedure BuildList(var ARci: TGLRenderContextInfo); override;
90
    procedure Notification(AComponent: TComponent; Operation: TOperation);
91
      override;
92

93
  published
94
     
95
    property MaterialLibrary: TGLMaterialLibrary read FMaterialLibrary write
96
      SetMaterialLibrary;
97
    property MatNameTop: TGLLibMaterialName read FMatNameTop write
98
      SetMatNameTop;
99
    property MatNameBottom: TGLLibMaterialName read FMatNameBottom write
100
      SetMatNameBottom;
101
    property MatNameLeft: TGLLibMaterialName read FMatNameLeft write
102
      SetMatNameLeft;
103
    property MatNameRight: TGLLibMaterialName read FMatNameRight write
104
      SetMatNameRight;
105
    property MatNameFront: TGLLibMaterialName read FMatNameFront write
106
      SetMatNameFront;
107
    property MatNameBack: TGLLibMaterialName read FMatNameBack write
108
      SetMatNameBack;
109
    property MatNameClouds: TGLLibMaterialName read FMatNameClouds write
110
      SetMatNameClouds;
111
    property CloudsPlaneOffset: Single read FCloudsPlaneOffset write
112
      SetCloudsPlaneOffset;
113
    property CloudsPlaneSize: Single read FCloudsPlaneSize write
114
      SetCloudsPlaneSize;
115
    property Style: TGLSkyBoxStyle read FStyle write FStyle default sbsFull;
116
  end;
117

118
  // ------------------------------------------------------------------
119
  // ------------------------------------------------------------------
120
  // ------------------------------------------------------------------
121
implementation
122
// ------------------------------------------------------------------
123
// ------------------------------------------------------------------
124
// ------------------------------------------------------------------
125

126
uses
127
  GLContext,
128
  GLState;
129

130
// ------------------
131
// ------------------ TGLSkyBox ------------------
132
// ------------------
133

134
// Create
135
//
136

137
constructor TGLSkyBox.Create(AOwner: TComponent);
138
begin
139
  inherited Create(AOwner);
140
  CamInvarianceMode := cimPosition;
141
  ObjectStyle := ObjectStyle + [osDirectDraw, osNoVisibilityCulling];
142
  FCloudsPlaneOffset := 0.2;
143
    // this should be set far enough to avoid near plane clipping
144
  FCloudsPlaneSize := 32;
145
    // the bigger, the more this extends the clouds cap to the horizon
146
end;
147

148
// Destroy
149
//
150

151
destructor TGLSkyBox.Destroy;
152
begin
153
  inherited;
154
end;
155

156
// GetMaterialLibrary
157
//
158

159
function TGLSkyBox.GetMaterialLibrary: TGLAbstractMaterialLibrary;
160
begin
161
  Result := FMaterialLibrary;
162
end;
163

164
// Notification
165
//
166

167
procedure TGLSkyBox.Notification(AComponent: TComponent; Operation: TOperation);
168
begin
169
  if (Operation = opRemove) and (AComponent = FMaterialLibrary) then
170
    MaterialLibrary := nil;
171
  inherited;
172
end;
173

174
// DoRender
175
//
176

177
procedure TGLSkyBox.DoRender(var ARci: TGLRenderContextInfo; ARenderSelf,
178
  ARenderChildren: Boolean);
179
begin
180
  // We want children of the sky box to appear far away too
181
  // (note: simply not writing to depth buffer may not make this not work,
182
  //  child objects may need the depth buffer to render themselves properly,
183
  //  this may require depth buffer cleared after that. - DanB)
184
  Arci.GLStates.DepthWriteMask := False;
185
  Arci.ignoreDepthRequests := true;
186
  inherited;
187
  Arci.ignoreDepthRequests := False;
188
end;
189
// DoRender
190
//
191

192
procedure TGLSkyBox.BuildList(var ARci: TGLRenderContextInfo);
193
var
194
  f, cps, cof1: Single;
195
  oldStates: TGLStates;
196
  libMat: TGLLibMaterial;
197
begin
198
  if FMaterialLibrary = nil then
199
    Exit;
200

201
  with ARci.GLStates do
202
  begin
203
    oldStates := States;
204
    Disable(stDepthTest);
205
    Disable(stLighting);
206
    Disable(stFog);
207
  end;
208

209
  GL.PushMatrix;
210
  f := ARci.rcci.farClippingDistance * 0.5;
211
  GL.Scalef(f, f, f);
212

213
  try
214
    case Style of
215
      sbsFull: ;
216
      sbsTopHalf, sbsTopHalfClamped:
217
        begin
218
          GL.Translatef(0, 0.5, 0);
219
          GL.Scalef(1, 0.5, 1);
220
        end;
221
      sbsBottomHalf:
222
        begin
223
          GL.Translatef(0, -0.5, 0);
224
          GL.Scalef(1, 0.5, 1);
225
        end;
226
      sbTopTwoThirds:
227
        begin
228
          GL.Translatef(0, 1 / 3, 0);
229
          GL.Scalef(1, 2 / 3, 1);
230
        end;
231
    end;
232

233
    // FRONT
234
    libMat := MaterialLibrary.LibMaterialByName(FMatNameFront);
235
    if libMat <> nil then
236
    begin
237
      libMat.Apply(ARci);
238
      repeat
239
        GL.Begin_(GL_QUADS);
240
        xgl.TexCoord2f(0.002, 0.998);
241
        GL.Vertex3f(-1, 1, -1);
242
        xgl.TexCoord2f(0.002, 0.002);
243
        GL.Vertex3f(-1, -1, -1);
244
        xgl.TexCoord2f(0.998, 0.002);
245
        GL.Vertex3f(1, -1, -1);
246
        xgl.TexCoord2f(0.998, 0.998);
247
        GL.Vertex3f(1, 1, -1);
248
        if Style = sbsTopHalfClamped then
249
        begin
250
          xgl.TexCoord2f(0.002, 0.002);
251
          GL.Vertex3f(-1, -1, -1);
252
          xgl.TexCoord2f(0.002, 0.002);
253
          GL.Vertex3f(-1, -3, -1);
254
          xgl.TexCoord2f(0.998, 0.002);
255
          GL.Vertex3f(1, -3, -1);
256
          xgl.TexCoord2f(0.998, 0.002);
257
          GL.Vertex3f(1, -1, -1);
258
        end;
259
        GL.End_;
260
      until not libMat.UnApply(ARci);
261
    end;
262
    // BACK
263
    libMat := MaterialLibrary.LibMaterialByName(FMatNameBack);
264
    if libMat <> nil then
265
    begin
266
      libMat.Apply(ARci);
267
      repeat
268
        GL.Begin_(GL_QUADS);
269
        xgl.TexCoord2f(0.002, 0.998);
270
        GL.Vertex3f(1, 1, 1);
271
        xgl.TexCoord2f(0.002, 0.002);
272
        GL.Vertex3f(1, -1, 1);
273
        xgl.TexCoord2f(0.998, 0.002);
274
        GL.Vertex3f(-1, -1, 1);
275
        xgl.TexCoord2f(0.998, 0.998);
276
        GL.Vertex3f(-1, 1, 1);
277
        if Style = sbsTopHalfClamped then
278
        begin
279
          xgl.TexCoord2f(0.002, 0.002);
280
          GL.Vertex3f(1, -1, 1);
281
          xgl.TexCoord2f(0.002, 0.002);
282
          GL.Vertex3f(1, -3, 1);
283
          xgl.TexCoord2f(0.998, 0.002);
284
          GL.Vertex3f(-1, -3, 1);
285
          xgl.TexCoord2f(0.998, 0.002);
286
          GL.Vertex3f(-1, -1, 1);
287
        end;
288
        GL.End_;
289
      until not libMat.UnApply(ARci);
290
    end;
291
    // TOP
292
    libMat := MaterialLibrary.LibMaterialByName(FMatNameTop);
293
    if libMat <> nil then
294
    begin
295
      libMat.Apply(ARci);
296
      repeat
297
        GL.Begin_(GL_QUADS);
298
        xgl.TexCoord2f(0.002, 0.998);
299
        GL.Vertex3f(-1, 1, 1);
300
        xgl.TexCoord2f(0.002, 0.002);
301
        GL.Vertex3f(-1, 1, -1);
302
        xgl.TexCoord2f(0.998, 0.002);
303
        GL.Vertex3f(1, 1, -1);
304
        xgl.TexCoord2f(0.998, 0.998);
305
        GL.Vertex3f(1, 1, 1);
306
        GL.End_;
307
      until not libMat.UnApply(ARci);
308
    end;
309
    // BOTTOM
310
    libMat := MaterialLibrary.LibMaterialByName(FMatNameBottom);
311
    if libMat <> nil then
312
    begin
313
      libMat.Apply(ARci);
314
      repeat
315
        GL.Begin_(GL_QUADS);
316
        xgl.TexCoord2f(0.002, 0.998);
317
        GL.Vertex3f(-1, -1, -1);
318
        xgl.TexCoord2f(0.002, 0.002);
319
        GL.Vertex3f(-1, -1, 1);
320
        xgl.TexCoord2f(0.998, 0.002);
321
        GL.Vertex3f(1, -1, 1);
322
        xgl.TexCoord2f(0.998, 0.998);
323
        GL.Vertex3f(1, -1, -1);
324
        GL.End_;
325
      until not libMat.UnApply(ARci);
326
    end;
327
    // LEFT
328
    libMat := MaterialLibrary.LibMaterialByName(FMatNameLeft);
329
    if libMat <> nil then
330
    begin
331
      libMat.Apply(ARci);
332
      repeat
333
        GL.Begin_(GL_QUADS);
334
        xgl.TexCoord2f(0.002, 0.998);
335
        GL.Vertex3f(-1, 1, 1);
336
        xgl.TexCoord2f(0.002, 0.002);
337
        GL.Vertex3f(-1, -1, 1);
338
        xgl.TexCoord2f(0.998, 0.002);
339
        GL.Vertex3f(-1, -1, -1);
340
        xgl.TexCoord2f(0.998, 0.998);
341
        GL.Vertex3f(-1, 1, -1);
342
        if Style = sbsTopHalfClamped then
343
        begin
344
          xgl.TexCoord2f(0.002, 0.002);
345
          GL.Vertex3f(-1, -1, 1);
346
          xgl.TexCoord2f(0.002, 0.002);
347
          GL.Vertex3f(-1, -3, 1);
348
          xgl.TexCoord2f(0.998, 0.002);
349
          GL.Vertex3f(-1, -3, -1);
350
          xgl.TexCoord2f(0.998, 0.002);
351
          GL.Vertex3f(-1, -1, -1);
352
        end;
353
        GL.End_;
354
      until not libMat.UnApply(ARci);
355
    end;
356
    // RIGHT
357
    libMat := MaterialLibrary.LibMaterialByName(FMatNameRight);
358
    if libMat <> nil then
359
    begin
360
      libMat.Apply(ARci);
361
      repeat
362
        GL.Begin_(GL_QUADS);
363
        xgl.TexCoord2f(0.002, 0.998);
364
        GL.Vertex3f(1, 1, -1);
365
        xgl.TexCoord2f(0.002, 0.002);
366
        GL.Vertex3f(1, -1, -1);
367
        xgl.TexCoord2f(0.998, 0.002);
368
        GL.Vertex3f(1, -1, 1);
369
        xgl.TexCoord2f(0.998, 0.998);
370
        GL.Vertex3f(1, 1, 1);
371
        if Style = sbsTopHalfClamped then
372
        begin
373
          xgl.TexCoord2f(0.002, 0.002);
374
          GL.Vertex3f(1, -1, -1);
375
          xgl.TexCoord2f(0.002, 0.002);
376
          GL.Vertex3f(1, -3, -1);
377
          xgl.TexCoord2f(0.998, 0.002);
378
          GL.Vertex3f(1, -3, 1);
379
          xgl.TexCoord2f(0.998, 0.002);
380
          GL.Vertex3f(1, -1, 1);
381
        end;
382
        GL.End_;
383
      until not libMat.UnApply(ARci);
384
    end;
385
    // CLOUDS CAP PLANE
386
    libMat := MaterialLibrary.LibMaterialByName(FMatNameClouds);
387
    if libMat <> nil then
388
    begin
389
      // pre-calculate possible values to speed up
390
      cps := FCloudsPlaneSize * 0.5;
391
      cof1 := FCloudsPlaneOffset;
392

393
      libMat.Apply(ARci);
394
      repeat
395
        GL.Begin_(GL_QUADS);
396
        xgl.TexCoord2f(0, 1);
397
        GL.Vertex3f(-cps, cof1, cps);
398
        xgl.TexCoord2f(0, 0);
399
        GL.Vertex3f(-cps, cof1, -cps);
400
        xgl.TexCoord2f(1, 0);
401
        GL.Vertex3f(cps, cof1, -cps);
402
        xgl.TexCoord2f(1, 1);
403
        GL.Vertex3f(cps, cof1, cps);
404
        GL.End_;
405
      until not libMat.UnApply(ARci);
406
    end;
407

408
    GL.PopMatrix;
409

410
    if stLighting in oldStates then
411
      ARci.GLStates.Enable(stLighting);
412
    if stFog in oldStates then
413
      ARci.GLStates.Enable(stFog);
414
    if stDepthTest in oldStates then
415
      ARci.GLStates.Enable(stDepthTest);
416

417
  finally
418
  end;
419
end;
420

421
procedure TGLSkyBox.SetCloudsPlaneOffset(const Value: single);
422
begin
423
  FCloudsPlaneOffset := Value;
424
  StructureChanged;
425
end;
426

427
procedure TGLSkyBox.SetCloudsPlaneSize(const Value: single);
428
begin
429
  FCloudsPlaneSize := Value;
430
  StructureChanged;
431
end;
432

433
// SetStyle
434
//
435

436
procedure TGLSkyBox.SetStyle(const value: TGLSkyBoxStyle);
437
begin
438
  FStyle := value;
439
  StructureChanged;
440
end;
441

442
// SetMaterialLibrary
443
//
444

445
procedure TGLSkyBox.SetMaterialLibrary(const value: TGLMaterialLibrary);
446
begin
447
  FMaterialLibrary := value;
448
  StructureChanged;
449
end;
450

451
procedure TGLSkyBox.SetMatNameBack(const Value: string);
452
begin
453
  FMatNameBack := Value;
454
  StructureChanged;
455
end;
456

457
procedure TGLSkyBox.SetMatNameBottom(const Value: string);
458
begin
459
  FMatNameBottom := Value;
460
  StructureChanged;
461
end;
462

463
procedure TGLSkyBox.SetMatNameClouds(const Value: string);
464
begin
465
  FMatNameClouds := Value;
466
  StructureChanged;
467
end;
468

469
procedure TGLSkyBox.SetMatNameFront(const Value: string);
470
begin
471
  FMatNameFront := Value;
472
  StructureChanged;
473
end;
474

475
procedure TGLSkyBox.SetMatNameLeft(const Value: string);
476
begin
477
  FMatNameLeft := Value;
478
  StructureChanged;
479
end;
480

481
procedure TGLSkyBox.SetMatNameRight(const Value: string);
482
begin
483
  FMatNameRight := Value;
484
  StructureChanged;
485
end;
486

487
procedure TGLSkyBox.SetMatNameTop(const Value: string);
488
begin
489
  FMatNameTop := Value;
490
  StructureChanged;
491
end;
492

493
// ------------------------------------------------------------------
494
// ------------------------------------------------------------------
495
// ------------------------------------------------------------------
496
initialization
497
  // ------------------------------------------------------------------
498
  // ------------------------------------------------------------------
499
  // ------------------------------------------------------------------
500

501
  RegisterClass(TGLSkyBox);
502

503
end.
504

505