LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Implements FBO support for GLScene.
6

7
   Original author of the unit is Riz.
8
   Modified by C4 and YarUnderoaker (hope, I didn't miss anybody).
9

10
    History :  
11
       16/10/11 - Yar - Fixes for depth-stencil texture
12
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
13
       16/05/10 - Yar - Added multisampling support (thanks C4)
14
       22/04/10 - Yar - Fixes after GLState revision
15
       15/04/10 - Yar   - Bugfix missing FBO state changing (thanks C4)
16
       23/01/10 - Yar   - Replaced TextureFormat to TextureFormatEx
17
       22/01/10 - Yar   - Adapted to Handles of GLContext,
18
                             texture target unification, level and layer control
19
       11/11/09 - DaStr - Added $I GLScene.inc
20
       09/11/09 - DaStr - Initial version (contributed to GLScene)
21
    
22
}
23
unit GLFBO;
24

25
interface
26

27
{$I GLScene.inc}
28

29
uses
30
  SysUtils,
31
  OpenGLTokens,
32
  GLScene,
33
  GLContext,
34
  GLState,
35
  GLTexture,
36
  GLColor,
37
  GLRenderContextInfo,
38
  GLMultisampleImage,
39
  GLGraphics,
40
  GLTextureFormat,
41
  GLVectorTypes,
42
  GLSLog;
43

44

45
const
46
  MaxColorAttachments = 32;
47

48
type
49
  TGLRenderbuffer = class
50
  private
51
    FRenderbufferHandle: TGLRenderbufferHandle;
52
    FWidth: Integer;
53
    FHeight: Integer;
54
    FStorageValid: Boolean;
55
    function GetHandle: TGLuint;
56
    procedure SetHeight(const Value: Integer);
57
    procedure SetWidth(const Value: Integer);
58
  protected
59

60
    function GetInternalFormat: cardinal; virtual; abstract;
61

62
    procedure InvalidateStorage;
63
  public
64
    constructor Create;
65
    destructor Destroy; override;
66

67
    procedure Bind;
68
    procedure Unbind;
69
    { Handle to the OpenGL render buffer object.
70
      If the handle hasn't already been allocated, it will be allocated
71
      by this call (ie. do not use if no OpenGL context is active!) }
72
    property Handle: TGLuint read GetHandle;
73
    property Width: Integer read FWidth write SetWidth;
74
    property Height: Integer read FHeight write SetHeight;
75
  end;
76

77
  TGLDepthRBO = class(TGLRenderbuffer)
78
  private
79
    FDepthPrecision: TGLDepthPrecision;
80
    procedure SetDepthPrecision(const Value: TGLDepthPrecision);
81
  protected
82
    function GetInternalFormat: cardinal; override;
83
  public
84
    constructor Create;
85

86
    property DepthPrecision: TGLDepthPrecision read FDepthPrecision write
87
      SetDepthPrecision;
88
  end;
89

90
  TGLStencilPrecision = (spDefault, sp1bit, sp4bits, sp8bits, sp16bits);
91

92
  TGLStencilRBO = class(TGLRenderbuffer)
93
  private
94
    FStencilPrecision: TGLStencilPrecision;
95
    procedure SetStencilPrecision(const Value: TGLStencilPrecision);
96
  protected
97
    function GetInternalFormat: cardinal; override;
98
  public
99
    constructor Create;
100

101
    property StencilPrecision: TGLStencilPrecision read FStencilPrecision write
102
      SetStencilPrecision;
103
  end;
104

105
  TGLFrameBuffer = class
106
  private
107
    FFrameBufferHandle: TGLFramebufferHandle;
108
    FTarget: TGLEnum;
109
    FWidth: Integer;
110
    FHeight: Integer;
111
    FLayer: Integer;
112
    FLevel: Integer;
113
    FTextureMipmap: cardinal;
114
    FAttachedTexture: array[0..MaxColorAttachments - 1] of TGLTexture;
115
    FDepthTexture: TGLTexture;
116
    FDRBO: TGLDepthRBO;
117
    FSRBO: TGLStencilRBO;
118

119
    function GetStatus: TGLFramebufferStatus;
120
    procedure SetHeight(const Value: Integer);
121
    procedure SetWidth(const Value: Integer);
122
    procedure SetLayer(const Value: Integer);
123
    procedure SetLevel(const Value: Integer);
124
  protected
125
    procedure AttachTexture(
126
      const attachment: TGLenum;
127
      const textarget: TGLenum;
128
      const texture: TGLuint;
129
      const level: TGLint;
130
      const layer: TGLint); overload;
131
    procedure ReattachTextures;
132
  public
133
    constructor Create;
134
    destructor Destroy; override;
135

136
    // attaches a depth rbo to the fbo
137
    // the depth buffer must have the same dimentions as the fbo
138
    procedure AttachDepthBuffer(DepthBuffer: TGLDepthRBO); overload;
139
    // detaches depth attachment from the fbo
140
    procedure DetachDepthBuffer;
141

142
    // attaches a stencil rbo to the fbo
143
    // the stencil buffer must have the same dimentions as the fbo
144
    procedure AttachStencilBuffer(StencilBuffer: TGLStencilRBO); overload;
145
    // detaches stencil attachment from the fbo
146
    procedure DetachStencilBuffer;
147

148
    // attaches a depth texture to the fbo
149
    // the depth texture must have the same dimentions as the fbo
150
    procedure AttachDepthTexture(Texture: TGLTexture); overload;
151
    procedure DetachDepthTexture;
152

153
    procedure AttachTexture(n: Cardinal; Texture: TGLTexture); overload;
154
    procedure DetachTexture(n: Cardinal);
155

156
    function GetStringStatus(out clarification: string): TGLFramebufferStatus;
157
    property Status: TGLFramebufferStatus read GetStatus;
158
    procedure Bind;
159
    procedure Unbind;
160

161
    procedure PreRender;
162
    procedure Render(var rci: TGLRenderContextInfo; baseObject:
163
      TGLBaseSceneObject);
164
    procedure PostRender(const PostGenerateMipmap: Boolean);
165

166
    property Handle: TGLFramebufferHandle read FFrameBufferHandle;
167
    property Width: Integer read FWidth write SetWidth;
168
    property Height: Integer read FHeight write SetHeight;
169
    property Layer: Integer read FLayer write SetLayer;
170
    property Level: Integer read FLevel write SetLevel;
171
  end;
172

173
implementation
174

175
{ TGLRenderbuffer }
176

177
constructor TGLRenderbuffer.Create;
178
begin
179
  inherited Create;
180
  FRenderbufferHandle := TGLRenderbufferHandle.Create;
181
  FWidth := 256;
182
  FHeight := 256;
183
end;
184

185
destructor TGLRenderbuffer.Destroy;
186
begin
187
  FRenderbufferHandle.DestroyHandle;
188
  FRenderbufferHandle.Free;
189
  inherited Destroy;
190
end;
191

192
function TGLRenderbuffer.GetHandle: GLuint;
193
begin
194
  if FRenderbufferHandle.Handle = 0 then
195
    FRenderbufferHandle.AllocateHandle;
196
  Result := FRenderbufferHandle.Handle;
197
end;
198

199
procedure TGLRenderbuffer.InvalidateStorage;
200
begin
201
  FStorageValid := False;
202
end;
203

204
procedure TGLRenderbuffer.SetHeight(const Value: Integer);
205
begin
206
  if FHeight <> Value then
207
  begin
208
    FHeight := Value;
209
    InvalidateStorage;
210
  end;
211
end;
212

213
procedure TGLRenderbuffer.SetWidth(const Value: Integer);
214
begin
215
  if FWidth <> Value then
216
  begin
217
    FWidth := Value;
218
    InvalidateStorage;
219
  end;
220
end;
221

222
procedure TGLRenderbuffer.Bind;
223
var
224
  internalFormat: cardinal;
225
begin
226
  FRenderbufferHandle.AllocateHandle;
227
  FRenderbufferHandle.Bind;
228
  if not FStorageValid then
229
  begin
230
    internalFormat := GetInternalFormat;
231
    FRenderbufferHandle.SetStorage(internalFormat, FWidth, FHeight);
232
  end;
233
end;
234

235
procedure TGLRenderbuffer.Unbind;
236
begin
237
  FRenderbufferHandle.UnBind;
238
end;
239

240
{ TGLDepthRBO }
241

242
constructor TGLDepthRBO.Create;
243
begin
244
  inherited Create;
245
  FDepthPrecision := dpDefault;
246
end;
247

248
function TGLDepthRBO.GetInternalFormat: cardinal;
249
begin
250
  case DepthPrecision of
251
    dp24bits: Result := GL_DEPTH_COMPONENT24;
252
    dp16bits: Result := GL_DEPTH_COMPONENT16;
253
    dp32bits: Result := GL_DEPTH_COMPONENT32;
254
  else
255
    // dpDefault
256
    Result := GL_DEPTH_COMPONENT24_ARB;
257
  end;
258
end;
259

260
procedure TGLDepthRBO.SetDepthPrecision(const Value: TGLDepthPrecision);
261
begin
262
  if FDepthPrecision <> Value then
263
  begin
264
    FDepthPrecision := Value;
265
    InvalidateStorage;
266
  end;
267
end;
268

269
{ TGLStencilRBO }
270

271
constructor TGLStencilRBO.Create;
272
begin
273
  inherited Create;
274
  FStencilPrecision := spDefault;
275
end;
276

277
function TGLStencilRBO.GetInternalFormat: cardinal;
278
begin
279
  case StencilPrecision of
280
    spDefault: Result := GL_STENCIL_INDEX;
281
    sp1bit: Result := GL_STENCIL_INDEX1_EXT;
282
    sp4bits: Result := GL_STENCIL_INDEX4_EXT;
283
    sp8bits: Result := GL_STENCIL_INDEX8_EXT;
284
    sp16bits: Result := GL_STENCIL_INDEX16_EXT;
285
  else
286
    // spDefault
287
    Result := GL_STENCIL_INDEX;
288
  end;
289
end;
290

291
procedure TGLStencilRBO.SetStencilPrecision(const Value: TGLStencilPrecision);
292
begin
293
  if FStencilPrecision <> Value then
294
  begin
295
    FStencilPrecision := Value;
296
    InvalidateStorage;
297
  end;
298
end;
299

300
{ TGLFrameBuffer }
301

302
constructor TGLFrameBuffer.Create;
303
begin
304
  inherited;
305
  FFrameBufferHandle := TGLFrameBufferHandle.Create;
306
  FWidth := 256;
307
  FHeight := 256;
308
  FLayer := 0;
309
  FLevel := 0;
310
  FTextureMipmap := 0;
311
  FTarget := GL_FRAMEBUFFER;
312
end;
313

314
destructor TGLFrameBuffer.Destroy;
315
begin
316
  FFrameBufferHandle.DestroyHandle;
317
  FFrameBufferHandle.Free;
318
  inherited Destroy;
319
end;
320

321
procedure TGLFrameBuffer.AttachTexture(n: Cardinal; Texture: TGLTexture);
322
var
323
  textarget: TGLTextureTarget;
324
begin
325
  Assert(n < MaxColorAttachments);
326
  Texture.Handle;
327
  FAttachedTexture[n] := Texture;
328
  textarget := Texture.Image.NativeTextureTarget;
329
  // Store mipmaping requires
330
  if not ((Texture.MinFilter in [miNearest, miLinear])
331
    or (textarget = ttTextureRect)) then
332
    FTextureMipmap := FTextureMipmap or (1 shl n);
333

334
  if Texture.Image is TGLMultiSampleImage then
335
    FTextureMipmap := 0;
336

337
  AttachTexture(
338
    GL_COLOR_ATTACHMENT0_EXT + n,
339
    DecodeGLTextureTarget(textarget),
340
    Texture.Handle,
341
    FLevel, FLayer);
342
end;
343

344
procedure TGLFrameBuffer.AttachDepthBuffer(DepthBuffer: TGLDepthRBO);
345

346
  procedure AttachDepthRB;
347
  begin
348
    // forces initialization
349
    DepthBuffer.Bind;
350
    DepthBuffer.Unbind;
351
    GL.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT_EXT,
352
      GL_RENDERBUFFER_EXT, DepthBuffer.Handle);
353
  end;
354

355
var
356
  dp: TGLDepthPrecision;
357
begin
358
  if Assigned(FDRBO) then
359
    DetachDepthBuffer;
360
  FDRBO := DepthBuffer;
361

362
  Bind;
363
  AttachDepthRB;
364

365
  // if default format didn't work, try something else
366
  // crude, but might work
367
  if (Status = fsUnsupported) and (DepthBuffer.DepthPrecision = dpDefault) then
368
  begin
369
    // try the other formats
370
    // best quality first
371
    for dp := high(dp) downto low(dp) do
372
    begin
373
      if dp = dpDefault then
374
        Continue;
375

376
      DepthBuffer.DepthPrecision := dp;
377

378
      AttachDepthRB;
379

380
      if not (Status = fsUnsupported) then
381
        Break;
382
    end;
383
  end;
384
  Status;
385
  Unbind;
386
end;
387

388
procedure TGLFrameBuffer.AttachDepthTexture(Texture: TGLTexture);
389
begin
390
  FDepthTexture := Texture;
391

392
  if FDepthTexture.Image is TGLMultisampleImage then
393
  begin
394
    if not IsDepthFormat(FDepthTexture.TextureFormatEx) then
395
    begin
396
      // Force texture properties to depth compatibility
397
      FDepthTexture.TextureFormatEx := tfDEPTH_COMPONENT24;
398
      TGLMultisampleImage(FDepthTexture.Image).Width := Width;
399
      TGLMultisampleImage(FDepthTexture.Image).Height := Height;
400
    end;
401
    FTextureMipmap := 0;
402
  end
403
  else
404
  begin
405
    if not IsDepthFormat(FDepthTexture.TextureFormatEx) then
406
    begin
407
      // Force texture properties to depth compatibility
408
      FDepthTexture.ImageClassName := TGLBlankImage.ClassName;
409
      FDepthTexture.TextureFormatEx := tfDEPTH_COMPONENT24;
410
      TGLBlankImage(FDepthTexture.Image).Width := Width;
411
      TGLBlankImage(FDepthTexture.Image).Height := Height;
412
    end;
413
    if FDepthTexture.TextureFormatEx = tfDEPTH24_STENCIL8 then
414
    begin
415
      TGLBlankImage(FDepthTexture.Image).GetBitmap32.SetColorFormatDataType(GL_DEPTH_STENCIL, GL_UNSIGNED_INT_24_8);
416
      TGLBlankImage(FDepthTexture.Image).ColorFormat := GL_DEPTH_STENCIL;
417
    end
418
    else
419
    begin
420
      TGLBlankImage(FDepthTexture.Image).GetBitmap32.SetColorFormatDataType(GL_DEPTH_COMPONENT, GL_UNSIGNED_BYTE);
421
      TGLBlankImage(FDepthTexture.Image).ColorFormat := GL_DEPTH_COMPONENT;
422
    end;
423
    // Depth texture mipmaping
424
    if not ((FDepthTexture.MinFilter in [miNearest, miLinear])) then
425
      FTextureMipmap := FTextureMipmap or Cardinal(1 shl MaxColorAttachments);
426
  end;
427

428
  AttachTexture(
429
    GL_DEPTH_ATTACHMENT,
430
    DecodeGLTextureTarget(FDepthTexture.Image.NativeTextureTarget),
431
    FDepthTexture.Handle,
432
    FLevel,
433
    FLayer);
434

435
  if FDepthTexture.TextureFormatEx = tfDEPTH24_STENCIL8 then
436
    AttachTexture(
437
      GL_STENCIL_ATTACHMENT,
438
      DecodeGLTextureTarget(FDepthTexture.Image.NativeTextureTarget),
439
      FDepthTexture.Handle,
440
      FLevel,
441
      FLayer);
442
end;
443

444
procedure TGLFrameBuffer.DetachDepthTexture;
445
begin
446
  if Assigned(FDepthTexture) then
447
  begin
448
    FTextureMipmap := FTextureMipmap and (not (1 shl MaxColorAttachments));
449
    AttachTexture(
450
      GL_DEPTH_ATTACHMENT,
451
      DecodeGLTextureTarget(FDepthTexture.Image.NativeTextureTarget),
452
      0, 0, 0);
453
    FDepthTexture := nil;
454
  end;
455
end;
456

457
procedure TGLFrameBuffer.AttachStencilBuffer(StencilBuffer: TGLStencilRBO);
458

459
  procedure AttachStencilRB;
460
  begin
461
    // forces initialization
462
    StencilBuffer.Bind;
463
    StencilBuffer.Unbind;
464
    GL.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
465
      GL_RENDERBUFFER_EXT, StencilBuffer.Handle);
466
  end;
467

468
var
469
  sp: TGLStencilPrecision;
470
begin
471
  if Assigned(FSRBO) then
472
    DetachStencilBuffer;
473
  FSRBO := StencilBuffer;
474

475
  Bind;
476
  AttachStencilRB;
477

478
  // if default format didn't work, try something else
479
  // crude, but might work
480
  if (Status = fsUnsupported)
481
    and (StencilBuffer.StencilPrecision = spDefault) then
482
  begin
483
    // try the other formats
484
    // best quality first
485
    for sp := high(sp) downto low(sp) do
486
    begin
487
      if sp = spDefault then
488
        Continue;
489

490
      StencilBuffer.StencilPrecision := sp;
491

492
      AttachStencilRB;
493

494
      if not (Status = fsUnsupported) then
495
        Break;
496
    end;
497
  end;
498
  Status;
499
  Unbind;
500
end;
501

502
procedure TGLFrameBuffer.AttachTexture(
503
  const attachment: TGLenum;
504
  const textarget: TGLenum;
505
  const texture: TGLuint;
506
  const level: TGLint;
507
  const layer: TGLint);
508
var
509
  storeDFB: TGLuint;
510
  RC: TGLContext;
511
begin
512
  RC := SafeCurrentGLContext;
513
  storeDFB := RC.GLStates.DrawFrameBuffer;
514
  if storeDFB <> FFrameBufferHandle.Handle then
515
    Bind;
516

517
  with FFrameBufferHandle do
518
    case textarget of
519
      GL_TEXTURE_1D:
520
        Attach1DTexture(FTarget, attachment, textarget, texture, level);
521

522
      GL_TEXTURE_2D:
523
        Attach2DTexture(FTarget, attachment, textarget, texture, level);
524

525
      GL_TEXTURE_RECTANGLE: // Rectangle texture can't be leveled
526
        Attach2DTexture(FTarget, attachment, textarget, texture, 0);
527

528
      GL_TEXTURE_3D:
529
        Attach3DTexture(FTarget, attachment, textarget, texture, level, layer);
530

531
      GL_TEXTURE_CUBE_MAP:
532
        Attach2DTexture(FTarget, attachment, GL_TEXTURE_CUBE_MAP_POSITIVE_X + layer, texture, level);
533

534
      GL_TEXTURE_CUBE_MAP_POSITIVE_X,
535
        GL_TEXTURE_CUBE_MAP_NEGATIVE_X,
536
        GL_TEXTURE_CUBE_MAP_POSITIVE_Y,
537
        GL_TEXTURE_CUBE_MAP_NEGATIVE_Y,
538
        GL_TEXTURE_CUBE_MAP_POSITIVE_Z,
539
        GL_TEXTURE_CUBE_MAP_NEGATIVE_Z:
540
          Attach2DTexture(FTarget, attachment, textarget, texture, level);
541

542
      GL_TEXTURE_CUBE_MAP_ARRAY,
543
        GL_TEXTURE_1D_ARRAY,
544
        GL_TEXTURE_2D_ARRAY:
545
        AttachLayer(FTarget, attachment, texture, level, layer);
546

547
      GL_TEXTURE_2D_MULTISAMPLE: // Multisample texture can't be leveled
548
        Attach2DTexture(FTarget, attachment, textarget, texture, 0);
549

550
      GL_TEXTURE_2D_MULTISAMPLE_ARRAY:
551
        AttachLayer(FTarget, attachment, texture, 0, layer);
552
    end;
553

554
  if storeDFB <> FFrameBufferHandle.Handle then
555
    RC.GLStates.SetFrameBuffer(storeDFB);
556
end;
557

558
procedure TGLFrameBuffer.Bind;
559
begin
560
  if Handle.IsDataNeedUpdate then
561
    ReattachTextures
562
  else
563
    Handle.Bind;
564
end;
565

566
procedure TGLFrameBuffer.Unbind;
567
begin
568
  FFrameBufferHandle.UnBind;
569
end;
570

571
procedure TGLFrameBuffer.DetachTexture(n: Cardinal);
572
begin
573
  // textarget ignored when binding 0
574
  if Assigned(FAttachedTexture[n]) then
575
  begin
576
    Bind;
577
    AttachTexture(
578
      GL_COLOR_ATTACHMENT0 + n,
579
      GL_TEXTURE_2D, // target does not matter
580
      0, 0, 0);
581

582
    FTextureMipmap := FTextureMipmap and (not (1 shl n));
583
    FAttachedTexture[n] := nil;
584
    Unbind;
585
  end;
586
end;
587

588
procedure TGLFrameBuffer.DetachDepthBuffer;
589
begin
590
  Bind;
591
  GL.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT,
592
    GL_RENDERBUFFER, 0);
593
  Unbind;
594
  FDRBO := nil;
595
end;
596

597
procedure TGLFrameBuffer.DetachStencilBuffer;
598
begin
599
  Bind;
600
  GL.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
601
    GL_RENDERBUFFER, 0);
602
  Unbind;
603
  FSRBO := nil;
604
end;
605

606
function TGLFrameBuffer.GetStatus: TGLFramebufferStatus;
607
var
608
  status: cardinal;
609
begin
610
  status := GL.CheckFramebufferStatus(FTarget);
611

612
  case status of
613
    GL_FRAMEBUFFER_COMPLETE_EXT: Result := fsComplete;
614
    GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT: Result := fsIncompleteAttachment;
615
    GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT: Result :=
616
      fsIncompleteMissingAttachment;
617
    GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT: Result :=
618
      fsIncompleteDuplicateAttachment;
619
    GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: Result := fsIncompleteDimensions;
620
    GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: Result := fsIncompleteFormats;
621
    GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT: Result := fsIncompleteDrawBuffer;
622
    GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT: Result := fsIncompleteReadBuffer;
623
    GL_FRAMEBUFFER_UNSUPPORTED_EXT: Result := fsUnsupported;
624
    GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE: Result := fsIncompleteMultisample;
625
  else
626
    Result := fsStatusError;
627
  end;
628
end;
629

630
function TGLFrameBuffer.GetStringStatus(out clarification: string):
631
  TGLFramebufferStatus;
632
const
633
  cFBOStatus: array[TGLFramebufferStatus] of string = (
634
    'Complete',
635
    'Incomplete attachment',
636
    'Incomplete missing attachment',
637
    'Incomplete duplicate attachment',
638
    'Incomplete dimensions',
639
    'Incomplete formats',
640
    'Incomplete draw buffer',
641
    'Incomplete read buffer',
642
    'Unsupported',
643
    'Incomplite multisample',
644
    'Status Error');
645
begin
646
  Result := GetStatus;
647
  clarification := cFBOStatus[Result];
648
end;
649

650
procedure TGLFrameBuffer.PostRender(const PostGenerateMipmap: Boolean);
651
var
652
  n: Integer;
653
  textarget: TGLTextureTarget;
654
begin
655
  if (FTextureMipmap > 0) and PostGenerateMipmap then
656
  begin
657
    for n := 0 to MaxColorAttachments - 1 do
658
      if Assigned(FAttachedTexture[n]) then
659
      begin
660
        if FTextureMipmap and (1 shl n) = 0 then
661
          Continue;
662
        textarget := FAttachedTexture[n].Image.NativeTextureTarget;
663
        with FFrameBufferHandle.RenderingContext.GLStates do
664
          TextureBinding[ActiveTexture, textarget] :=
665
            FAttachedTexture[n].Handle;
666
        GL.GenerateMipmap(DecodeGLTextureTarget(textarget));
667
      end;
668
  end;
669
end;
670

671
procedure TGLFrameBuffer.PreRender;
672
begin
673

674
end;
675

676
procedure TGLFrameBuffer.Render(var rci: TGLRenderContextInfo; baseObject:
677
  TGLBaseSceneObject);
678
var
679
  backColor: TColorVector;
680
  buffer: TGLSceneBuffer;
681
begin
682
  Bind;
683
  Assert(Status = fsComplete, 'Framebuffer not complete');
684

685
  buffer := TGLSceneBuffer(rci.buffer);
686

687
  backColor := ConvertWinColor(buffer.BackgroundColor);
688
  GL.ClearColor(backColor.V[0], backColor.V[1], backColor.V[2],
689
    buffer.BackgroundAlpha);
690
  rci.GLStates.SetColorMask(cAllColorComponents);
691
  rci.GLStates.DepthWriteMask := True;
692
  GL.Clear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
693

694
  baseObject.Render(rci);
695
  Unbind;
696
end;
697

698
procedure TGLFrameBuffer.SetHeight(const Value: Integer);
699
begin
700
  if FHeight <> Value then
701
  begin
702
    FHeight := Value;
703
  end;
704
end;
705

706
procedure TGLFrameBuffer.SetWidth(const Value: Integer);
707
begin
708
  if FWidth <> Value then
709
  begin
710
    FWidth := Value;
711
  end;
712
end;
713

714
procedure TGLFrameBuffer.ReattachTextures;
715
var
716
  n: Integer;
717
  bEmpty: Boolean;
718
  s: String;
719
begin
720
  Handle.AllocateHandle;
721
  Handle.Bind;
722
  // Reattach layered textures
723
  bEmpty := True;
724

725
  for n := 0 to MaxColorAttachments - 1 do
726
    if Assigned(FAttachedTexture[n]) then
727
    begin
728
      AttachTexture(
729
        GL_COLOR_ATTACHMENT0_EXT + n,
730
        DecodeGLTextureTarget(FAttachedTexture[n].Image.NativeTextureTarget),
731
        FAttachedTexture[n].Handle,
732
        FLevel,
733
        FLayer);
734
      bEmpty := False;
735
    end;
736

737
  if Assigned(FDepthTexture) then
738
  begin
739
    AttachTexture(
740
      GL_DEPTH_ATTACHMENT,
741
      DecodeGLTextureTarget(FDepthTexture.Image.NativeTextureTarget),
742
      FDepthTexture.Handle,
743
      FLevel,
744
      FLayer);
745
    bEmpty := False;
746
  end;
747

748
  if Assigned(FDRBO) then
749
  begin
750
    FDRBO.Bind;
751
    FDRBO.Unbind;
752
    GL.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT_EXT,
753
      GL_RENDERBUFFER_EXT, FDRBO.Handle);
754
    bEmpty := False;
755
  end;
756

757
  if Assigned(FSRBO) then
758
  begin
759
    FSRBO.Bind;
760
    FSRBO.Unbind;
761
    GL.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
762
      GL_RENDERBUFFER_EXT, FSRBO.Handle);
763
    bEmpty := False;
764
  end;
765

766
  if not bEmpty and (GetStringStatus(s) <> fsComplete) then
767
    GLSLogger.LogErrorFmt('Framebuffer error: %s. Deactivated', [s]);
768

769
  Handle.NotifyDataUpdated;
770
end;
771

772
procedure TGLFrameBuffer.SetLayer(const Value: Integer);
773
var
774
  RC: TGLContext;
775
begin
776
  if FLayer <> Value then
777
  begin
778
    FLayer := Value;
779
    RC := CurrentGLContext;
780
    if Assigned(RC) then
781
    begin
782
      if RC.GLStates.DrawFrameBuffer = FFrameBufferHandle.Handle then
783
        ReattachTextures;
784
    end;
785
  end;
786
end;
787

788
procedure TGLFrameBuffer.SetLevel(const Value: Integer);
789
var
790
  RC: TGLContext;
791
begin
792
  if FLevel <> Value then
793
  begin
794
    FLevel := Value;
795
    RC := CurrentGLContext;
796
    if Assigned(RC) then
797
    begin
798
      if RC.GLStates.DrawFrameBuffer = FFrameBufferHandle.Handle then
799
        ReattachTextures;
800
    end;
801
  end;
802
end;
803

804
end.
805