unit uglcFrameBufferObject; { Package: OpenGLCore Prefix: glc - OpenGL Core Beschreibung: diese Unit enthält eine Klassen-Kapselung der OpenGL FrameBufferObjekte } {$mode objfpc}{$H+} interface uses Classes, SysUtils, fgl, dglOpenGl, uglcTypes; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TglcBufferType = (btRenderBuffer, btTextureBuffer); TglcBuffer = class(TObject) private fBufferType: TglcBufferType; fWidth: Integer; fHeight: Integer; procedure SetWidth(const aValue: Integer); procedure SetHeight(const aValue: Integer); public property Width : Integer read fWidth write SetWidth; property Height: Integer read fHeight write SetHeight; property BufferType: TglcBufferType read fBufferType; procedure SetSize(const aWidth, aHeight: Integer); virtual; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// EglcRenderBuffer = class(Exception); TglcRenderBuffer = class(TglcBuffer) private fID: gluInt; fFormat: TglcInternalFormat; procedure UpdateRenderBufferStorage; procedure SetFormat(const aValue: TglcInternalFormat); public property ID: gluInt read fID; property Format: TglcInternalFormat read fFormat write SetFormat; procedure SetSize(const aWidth, aHeight: Integer); override; procedure Bind; procedure Unbind; constructor Create(const aFormat: TglcInternalFormat); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// EglcTextureBuffer = class(exception); TglcTextureBuffer = class(TglcBuffer) private fID: GLuint; fFormat: TglcFormat; fInternalFormat: TglcInternalFormat; fBorder: Boolean; procedure UpdateTexImage; procedure SetFormat(const aValue: TglcFormat); procedure SetInternalFormat(const aValue: TglcInternalFormat); procedure SetBorder(const aValue: Boolean); public property ID : GLuint read fID; property Border : Boolean read fBorder write SetBorder; property Format : TglcFormat read fFormat write SetFormat; property InternalFormat: TglcInternalFormat read fInternalFormat write SetInternalFormat; procedure SetSize(const aWidth, aHeight: Integer); override; procedure Bind(const aEnableTextureUnit: Boolean = true); procedure Unbind(const aDisableTextureUnit: Boolean = true); constructor Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// EglcFrameBufferObject = class(Exception); TglcFrameBufferObject = class(TObject) private type TglcAttachmentContainer = class(TObject) Buffer: TglcBuffer; Attachment: TglcAttachment; OwnsObject: Boolean; constructor Create(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsObject: Boolean = true); destructor Destroy; override; end; TglcAttachmentContainerList = specialize TFPGObjectList; private fID: GLuint; fOwnsObjects: Boolean; fWidth: Integer; fHeight: Integer; fBuffers: TglcAttachmentContainerList; function GetBuffer(const aIndex: Integer): TglcBuffer; procedure SetBuffer(const aIndex: Integer; const aValue: TglcBuffer); function GetAttachment(const aIndex: Integer): TglcAttachment; procedure SetAttachment(const aIndex: Integer; const aValue: TglcAttachment); function GetBufferCount: Integer; procedure Attach(const aIndex: Integer); procedure Detach(const aIndex: Integer); procedure SetWidth(const aValue: Integer); procedure SetHeight(const aValue: Integer); procedure CheckFrameBufferStatus; procedure UpdateAndCheckFBO; public property ID : GLuint read fID; property Count : Integer read GetBufferCount; property OwnsObjects: Boolean read fOwnsObjects; property Width : Integer read fWidth write SetWidth; property Height : Integer read fHeight write SetHeight; property Attachments[const aIndex: Integer]: TglcAttachment read GetAttachment write SetAttachment; property Buffers [const aIndex: Integer]: TglcBuffer read GetBuffer write SetBuffer; procedure AddBuffer(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean = true); procedure DelBuffer(const aIndex: Integer); function RemBuffer(const aBuffer: TglcBuffer): Integer; function IndexOfBuffer(const aBuffer: TglcBuffer): Integer; procedure SetSize(const aWidth, aHeight: Integer); function CheckAttachment(const aAttachment: TglcAttachment): Boolean; procedure Bind(const aSetViewport: Boolean = true); procedure Unbind(const aResetViewport: Boolean = true); constructor Create(const aOwnBuffers: Boolean = true); destructor Destroy; override; end; implementation //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglcBuffer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcBuffer.SetWidth(const aValue: Integer); begin SetSize(aValue, fHeight); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcBuffer.SetHeight(const aValue: Integer); begin SetSize(fWidth, aValue); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcBuffer.SetSize(const aWidth, aHeight: Integer); begin fWidth := aWidth; fHeight := aHeight; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglcRenderBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcRenderBuffer.UpdateRenderBufferStorage; begin glGetError; //clear Erroros Bind; glRenderbufferStorage(GL_RENDERBUFFER, GLenum(fFormat), fWidth, fHeight); Unbind; glcCheckAndRaiseError; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcRenderBuffer.SetFormat(const aValue: TglcInternalFormat); begin fFormat := aValue; UpdateRenderBufferStorage; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcRenderBuffer.SetSize(const aWidth, aHeight: Integer); begin if (aWidth <= 0) or (aHeight <= 0) then raise EglcRenderBuffer.Create('invalid width or height'); if (aWidth <> fWidth) or (aHeight <> fHeight) then begin inherited SetSize(aWidth, aHeight); UpdateRenderBufferStorage; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcRenderBuffer.Bind; begin glBindRenderbuffer(GL_RENDERBUFFER, fID); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcRenderBuffer.Unbind; begin glBindRenderbuffer(GL_RENDERBUFFER, 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglcRenderBuffer.Create(const aFormat: TglcInternalFormat); begin inherited Create; fBufferType := btRenderBuffer; glGenRenderbuffers(1, @fID); fFormat := aFormat; SetSize(64, 64); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TglcRenderBuffer.Destroy; begin glDeleteRenderbuffers(1, @fID); inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglcTextureBuffer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.UpdateTexImage; begin glGetError; //clear errors Bind(false); glTexImage2D(GL_TEXTURE_2D, 0, GLenum(fInternalFormat), fWidth, fHeight, GLint(Byte(fBorder) and Byte(1)), GLenum(fFormat), GL_UNSIGNED_BYTE, nil); Unbind(false); glcCheckAndRaiseError; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.SetFormat(const aValue: TglcFormat); begin if (fFormat <> aValue) then begin fFormat := aValue; UpdateTexImage; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.SetInternalFormat(const aValue: TglcInternalFormat); begin if (fInternalFormat <> aValue) then begin fInternalFormat := aValue; UpdateTexImage; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.SetBorder(const aValue: Boolean); begin if (fBorder <> aValue) then begin fBorder := aValue; UpdateTexImage; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.SetSize(const aWidth, aHeight: Integer); begin if (aWidth <= 0) or (aHeight <= 0) then raise EglcTextureBuffer.Create('invalid width or height'); if (aWidth <> fWidth) or (aHeight <> fHeight) then begin inherited SetSize(aWidth, aHeight); UpdateTexImage; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.Bind(const aEnableTextureUnit: Boolean = true); begin if aEnableTextureUnit then glEnable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, fID); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcTextureBuffer.Unbind(const aDisableTextureUnit: Boolean = true); begin if aDisableTextureUnit then glDisable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglcTextureBuffer.Create(const aFormat: TglcFormat; const aInternalFormat: TglcInternalFormat); begin inherited Create; fBufferType := btTextureBuffer; glGenTextures(1, @fID); Bind(false); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); Unbind(false); fFormat := aFormat; fInternalFormat := aInternalFormat; SetSize(64, 64); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TglcTextureBuffer.Destroy; begin glDeleteTextures(1, @fID); inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglcAttachment//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TglcFrameBufferObject.TglcAttachmentContainer.Create(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsObject: Boolean); begin inherited Create; Buffer := aBuffer; Attachment := aAttachment; OwnsObject := aOwnsObject; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TglcFrameBufferObject.TglcAttachmentContainer.Destroy; begin if OwnsObject then Buffer.Free; inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TglcFrameBufferObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.GetBuffer(const aIndex: Integer): TglcBuffer; begin if (aIndex >= 0) and (aIndex < fBuffers.Count) then result := fBuffers[aIndex].Buffer else raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.SetBuffer(const aIndex: Integer; const aValue: TglcBuffer); begin if (aIndex < 0) or (aIndex >= fBuffers.Count) then raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); if not Assigned(aValue) then raise EglcFrameBufferObject.Create('invalid buffer'); Detach(aIndex); fBuffers[aIndex].Buffer := aValue; Attach(aIndex); UpdateAndCheckFBO; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.GetAttachment(const aIndex: Integer): TglcAttachment; begin if (aIndex >= 0) and (aIndex < fBuffers.Count) then result := fBuffers[aIndex].Attachment else raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.SetAttachment(const aIndex: Integer; const aValue: TglcAttachment); begin if (aIndex < 0) or (aIndex >= fBuffers.Count) then raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); if not CheckAttachment(aValue) then raise EglcFrameBufferObject.Create('Attachment already assigned'); Detach(aIndex); fBuffers[aIndex].Attachment := aValue; Attach(aIndex); UpdateAndCheckFBO; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.Attach(const aIndex: Integer); var a: TglcAttachment; b: TglcBuffer; begin a := Attachments[aIndex]; b := Buffers[aIndex]; Bind(false); if (b.BufferType = btRenderBuffer) then glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, (b as TglcRenderBuffer).ID) else glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, (b as TglcTextureBuffer).ID, 0); Unbind(false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.Detach(const aIndex: Integer); var a: TglcAttachment; b: TglcBuffer; begin a := Attachments[aIndex]; b := Buffers[aIndex]; Bind(false); if (b.BufferType = btRenderBuffer) then glFramebufferRenderbuffer(GL_FRAMEBUFFER, GLenum(a), GL_RENDERBUFFER, 0) else glFramebufferTexture2D(GL_FRAMEBUFFER, GLenum(a), GL_TEXTURE_2D, 0, 0); Unbind(false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //legt die neue Breite fest //@Value: Breite; procedure TglcFrameBufferObject.SetWidth(const aValue: Integer); begin SetSize(aValue, fHeight); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //legt die neue Höhe fest //@Value: neue Höhe; procedure TglcFrameBufferObject.SetHeight(const aValue: Integer); begin SetSize(fWidth, aValue); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.CheckFrameBufferStatus; begin case glCheckFramebufferStatus(GL_FRAMEBUFFER) of GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT: raise EglcFrameBufferObject.Create('Incomplete attachment'); GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT: raise EglcFrameBufferObject.Create('Missing attachment'); GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: raise EglcFrameBufferObject.Create('Incomplete dimensions'); GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: raise EglcFrameBufferObject.Create('Incomplete formats'); GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER: raise EglcFrameBufferObject.Create('Incomplete draw buffer'); GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER: raise EglcFrameBufferObject.Create('Incomplete read buffer'); GL_FRAMEBUFFER_UNSUPPORTED: raise EglcFrameBufferObject.Create('Framebufferobjects unsupported'); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //prüft das FrameBufferObjekt auf Fehler procedure TglcFrameBufferObject.UpdateAndCheckFBO; function IsColorAttachment(const a: TglcAttachment): Boolean; begin result := (GLenum(a) >= GL_COLOR_ATTACHMENT0) and (GLenum(a) <= GL_COLOR_ATTACHMENT15); end; var buff: array of GLenum; b: GLboolean; i: Integer; begin if (fBuffers.Count = 0) then exit; Bind(false); //find ColorBuffers SetLength(buff, 0); for i := 0 to fBuffers.Count-1 do if IsColorAttachment(fBuffers[i].Attachment) then begin SetLength(buff, Length(buff) + 1); buff[High(buff)] := GLenum(fBuffers[i].Attachment); end; //set Read and Draw Buffer if (Length(buff) = 0) then begin glReadBuffer(GL_NONE); glDrawBuffer(GL_NONE); end else begin glDrawBuffers(Length(buff), @buff[0]); glGetBooleanv(GL_DOUBLEBUFFER, @b); if b then glReadBuffer(GL_BACK) else glReadBuffer(GL_FRONT); end; Unbind(false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.GetBufferCount: Integer; begin result := fBuffers.Count; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.AddBuffer(const aBuffer: TglcBuffer; const aAttachment: TglcAttachment; const aOwnsBuffer: Boolean); begin if not Assigned(aBuffer) then raise EglcFrameBufferObject.Create('invalid buffer'); if not CheckAttachment(aAttachment) then raise EglcFrameBufferObject.Create('attachment already assigned'); fBuffers.Add(TglcAttachmentContainer.Create(aBuffer, aAttachment, fOwnsObjects and aOwnsBuffer)); if OwnsObjects then aBuffer.SetSize(fWidth, fHeight); Attach(fBuffers.Count-1); UpdateAndCheckFBO; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TglcFrameBufferObject.DelBuffer(const aIndex: Integer); begin if (aIndex >= 0) and (aIndex < fBuffers.Count) then begin Detach(aIndex); fBuffers.Delete(aIndex); UpdateAndCheckFBO; end else raise EglcFrameBufferObject.Create('Index out of Bounds: ' + IntToStr(aIndex)); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.RemBuffer(const aBuffer: TglcBuffer): Integer; begin result := IndexOfBuffer(aBuffer); if (result >= 0) then DelBuffer(result); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.IndexOfBuffer(const aBuffer: TglcBuffer): Integer; var i: Integer; begin for i := 0 to fBuffers.Count-1 do if (fBuffers[i].Buffer = aBuffer) then begin result := i; exit; end; result := -1; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //legt die Größe neu fest //@Width: neue Breite; //@Height: neue Höhe; procedure TglcFrameBufferObject.SetSize(const aWidth, aHeight: Integer); var c: TglcAttachmentContainer; begin if (aWidth <= 0) or (aHeight <= 0) then raise EglcFrameBufferObject.Create('invalid width or height'); fWidth := aWidth; fHeight := aHeight; if OwnsObjects then for c in fBuffers do if c.OwnsObject then c.Buffer.SetSize(fWidth, fHeight); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TglcFrameBufferObject.CheckAttachment(const aAttachment: TglcAttachment): Boolean; var i: Integer; begin result := false; for i := 0 to fBuffers.Count-1 do if (fBuffers[i].Attachment = aAttachment) then exit; result := true; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //Bindet das FrameBufferObjekt procedure TglcFrameBufferObject.Bind(const aSetViewport: Boolean = true); begin glBindFramebuffer(GL_FRAMEBUFFER, fID); if aSetViewport then begin glPushAttrib(GL_VIEWPORT_BIT); glViewPort(0, 0, fWidth, fHeight); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //Entbindet das FrameBufferObjekt procedure TglcFrameBufferObject.Unbind(const aResetViewport: Boolean = true); begin if aResetViewport then glPopAttrib; glBindFramebuffer(GL_FRAMEBUFFER, 0); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //erzeugt das Objekt constructor TglcFrameBufferObject.Create(const aOwnBuffers: Boolean = true); begin inherited Create; glGenFramebuffers(1, @fID); fWidth := 64; fHeight := 64; fOwnsObjects := aOwnBuffers; fBuffers := TglcAttachmentContainerList.Create(true); //containers are always owned by this object! end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //gibt das Objekt frei destructor TglcFrameBufferObject.Destroy; begin fBuffers.Free; glDeleteFramebuffers(1, @fID); inherited Destroy; end; end.