unit FrameBuffers;

interface

uses
  GL, GLu, GLext, WGLext, GLtools,
  Textures, Texture3D, TextureCubeMap, TextureRectangle, DepthTexture,
  Windows, SysUtils;

const
  RBO_RGB                   = GL_RGB;
  RBO_RGBA                  = GL_RGBA;
  RBO_DEPTH                 = GL_DEPTH_COMPONENT;
  RBO_DEPTH16               = GL_DEPTH_COMPONENT16;
  RBO_DEPTH24               = GL_DEPTH_COMPONENT24;
  RBO_DEPTH32               = GL_DEPTH_COMPONENT32;
  RBO_STENCIL               = GL_STENCIL_INDEX;
  RBO_STENCIL1              = GL_STENCIL_INDEX1_EXT;
  RBO_STENCIL4              = GL_STENCIL_INDEX4_EXT;
  RBO_STENCIL8              = GL_STENCIL_INDEX8_EXT;
  RBO_STENCIL16             = GL_STENCIL_INDEX16_EXT;

  FBO_COLOR                 = GL_COLOR_ATTACHMENT0_EXT;
  FBO_COLOR0                = GL_COLOR_ATTACHMENT0_EXT;
  FBO_COLOR1                = GL_COLOR_ATTACHMENT1_EXT;
  FBO_COLOR2                = GL_COLOR_ATTACHMENT2_EXT;
  FBO_COLOR3                = GL_COLOR_ATTACHMENT3_EXT;
  FBO_DEPTH                 = GL_DEPTH_ATTACHMENT_EXT;
  FBO_STENCIL               = GL_STENCIL_ATTACHMENT_EXT;

type
  TRenderBuffer = class
  protected
    RBO               : cardinal;
    RBFormat          : cardinal;
    RBWidth           : integer;
    RBHeight          : integer;
  public
    constructor Create; virtual;
    destructor Destroy; virtual;
    procedure Bind; virtual;
    procedure Storage(format: cardinal; width, height: integer);
  end;

  TFrameBuffer = class
  protected
    FBO               : cardinal;
    OldViewPort       : array[0..3] of GLint;
    width, height     : integer;
    function GetStatus: cardinal;
  public
    constructor Create; virtual;
    destructor Destroy; virtual;
    procedure Bind; virtual;
    procedure Unbind; virtual;
    procedure Enable; virtual;
    procedure Disable; virtual;
    procedure Attach(target: cardinal; RBO: TRenderBuffer); overload; virtual;
    procedure Attach(target: cardinal; tex: TTexture); overload; virtual;
    procedure Attach(target: cardinal; tex: TTextureCubeMap; face: cardinal); overload; virtual;
    procedure Attach(target: cardinal; tex: TTexture3D; zoffset: integer); overload; virtual;
    procedure AttachMipmap(target: cardinal; tex: TTexture; level: integer); overload; virtual;
    procedure AttachMipmap(target: cardinal; tex: TTextureCubeMap; level: integer; face: cardinal); overload; virtual;
    procedure AttachMipmap(target: cardinal; tex: TTexture3D; level: integer; zoffset: integer); overload; virtual;
    property Status: cardinal read GetStatus;
    procedure GenerateMipmap(tex: TTexture); virtual;
  end;

implementation

var
  FBO_loaded: boolean = false;

procedure LoadFBO;
begin
  if FBO_loaded then exit;

  if not glext_ExtensionSupported('GL_EXT_framebuffer_object') then
    raise Exception.Create('GL_EXT_framebuffer_object required!');

  Load_GL_EXT_framebuffer_object;

  FBO_loaded := true;
end;

constructor TRenderBuffer.Create;
begin
  inherited Create;

  LoadFBO;

  glGenRenderBuffersEXT(1, @RBO);
end;

destructor TRenderBuffer.Destroy;
begin
  glDeleteRenderBuffersEXT(1, @RBO);

  inherited Destroy;
end;

procedure TRenderBuffer.Bind;
begin
  glBindRenderBufferEXT(GL_RENDERBUFFER_EXT, RBO);
end;

procedure TRenderBuffer.Storage;
begin
  Bind;
  glRenderBufferStorageEXT(GL_RENDERBUFFER_EXT, format, width, height);

  RBFormat := format;
  RBWidth  := width;
  RBHeight := height;
end;

constructor TFrameBuffer.Create;
begin
  inherited Create;

  LoadFBO;

  glGenFrameBuffersEXT(1, @FBO);

  width := 0; height := 0;
end;

destructor TFrameBuffer.Destroy;
begin
  glDeleteFrameBuffersEXT(1, @FBO);

  inherited Destroy;
end;

procedure TFrameBuffer.Bind;
begin
  glBindFrameBufferEXT(GL_FRAMEBUFFER_EXT, FBO);
end;

procedure TFrameBuffer.Unbind;
begin
  glBindFrameBufferEXT(GL_FRAMEBUFFER_EXT, 0);
end;

procedure TFrameBuffer.Attach(target: cardinal; RBO: TRenderBuffer);
begin
  Bind;
  glFrameBufferRenderBufferEXT(GL_FRAMEBUFFER_EXT, target, GL_RENDERBUFFER_EXT, RBO.RBO);
  if ((width = 0) or (width = RBO.RBWidth)) and
     ((height = 0) or (height = RBO.RBHeight)) then
  begin
    width := RBO.RBWidth;
    height := RBO.RBHeight;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid render buffer size');
end;

procedure TFrameBuffer.Attach(target: cardinal; tex: TTexture);
begin
  Bind;
  case tex.Target of
    GL_TEXTURE_1D:
      glFrameBufferTexture1DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_1D, tex.Texture, 0);
    GL_TEXTURE_2D:
      glFrameBufferTexture2DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_2D, tex.Texture, 0);
    GL_TEXTURE_RECTANGLE_ARB:
      glFrameBufferTexture2DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_RECTANGLE_ARB, tex.Texture, 0);
  end;
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

procedure TFrameBuffer.Attach(target: cardinal; tex: TTextureCubeMap; face: cardinal);
begin
  Bind;
  glFrameBufferTexture2DEXT(GL_FRAMEBUFFER_EXT, target, face, tex.Texture, 0);
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

procedure TFrameBuffer.Attach(target: cardinal; tex: TTexture3D; zoffset: integer);
begin
  Bind;
  glFrameBufferTexture3DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_3D, tex.Texture, 0, zoffset);
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

procedure TFrameBuffer.AttachMipmap(target: cardinal; tex: TTexture; level: integer);
begin
  Bind;
  case tex.Target of
    GL_TEXTURE_1D:
      glFrameBufferTexture1DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_1D, tex.Texture, level);
    GL_TEXTURE_2D:
      glFrameBufferTexture2DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_2D, tex.Texture, level);
  end;
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

procedure TFrameBuffer.AttachMipmap(target: cardinal; tex: TTextureCubeMap; level: integer; face: cardinal);
begin
  Bind;
  glFrameBufferTexture2DEXT(GL_FRAMEBUFFER_EXT, target, face, tex.Texture, level);
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

procedure TFrameBuffer.AttachMipmap(target: cardinal; tex: TTexture3D; level: integer; zoffset: integer);
begin
  Bind;
  glFrameBufferTexture3DEXT(GL_FRAMEBUFFER_EXT, target, GL_TEXTURE_3D, tex.Texture, level, zoffset);
  if ((width = 0) or (width = tex.Width)) and
     ((height = 0) or (height = tex.Height)) then
  begin
    width := tex.Width;
    height := tex.Height;
  end else
    raise Exception.Create('TFrameBuffer.Attach: Invalid texture size');
end;

function TFrameBuffer.GetStatus;
begin
  result := glCheckFrameBufferStatusEXT(GL_FRAMEBUFFER_EXT);
end;

procedure TFrameBuffer.GenerateMipmap;
begin
  tex.Bind;
  glGenerateMipmapEXT(tex.Target);
end;

procedure TFrameBuffer.Enable;
begin
  glGetIntegerv(GL_VIEWPORT, @OldViewPort);
  Bind;
  glViewPort(0, 0, width, height);
end;

procedure TFrameBuffer.Disable;
begin
  glViewPort(OldViewPort[0], OldViewPort[1], OldViewPort[2], OldViewPort[3]);
  Unbind;
end;

end.
