123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644 |
- //
- // The graphics engine GLScene
- //
- unit GLS.FBORenderer;
- (* Implements FBO support *)
- interface
- {$I Stage.Defines.inc}
- uses
- Winapi.OpenGL,
- Winapi.OpenGLext,
- System.Classes,
- System.SysUtils,
- Stage.OpenGLTokens,
- Stage.TextureFormat,
- Stage.VectorTypes,
- Stage.VectorGeometry,
- GLS.PersistentClasses,
- Stage.PipelineTransform,
- GLS.Scene,
- GLS.Texture,
- GLS.Context,
- GLS.Color,
- GLS.Material,
- GLS.RenderContextInfo,
- GLS.State,
- GLS.MultiSampleImage,
- Stage.Logger;
- const
- MaxColorAttachments = 32;
- type
- TGLRenderbuffer = class
- private
- FRenderbufferHandle: TGLRenderbufferHandle;
- FWidth: Integer;
- FHeight: Integer;
- FStorageValid: Boolean;
- function GetHandle: Cardinal;
- procedure SetHeight(const Value: Integer);
- procedure SetWidth(const Value: Integer);
- protected
- function GetInternalFormat: cardinal; virtual; abstract;
- procedure InvalidateStorage;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Bind;
- procedure Unbind;
- (* Handle to the OpenGL render buffer object.
- If the handle hasn't already been allocated, it will be allocated
- by this call (ie. do not use if no OpenGL context is active!) *)
- property Handle: Cardinal read GetHandle;
- property Width: Integer read FWidth write SetWidth;
- property Height: Integer read FHeight write SetHeight;
- end;
- TGLDepthRBO = class(TGLRenderbuffer)
- private
- FDepthPrecision: TGLDepthPrecision;
- procedure SetDepthPrecision(const Value: TGLDepthPrecision);
- protected
- function GetInternalFormat: cardinal; override;
- public
- constructor Create;
- property DepthPrecision: TGLDepthPrecision read FDepthPrecision write
- SetDepthPrecision;
- end;
- TGLStencilPrecision = (spDefault, sp1bit, sp4bits, sp8bits, sp16bits);
- TGLStencilRBO = class(TGLRenderbuffer)
- private
- FStencilPrecision: TGLStencilPrecision;
- procedure SetStencilPrecision(const Value: TGLStencilPrecision);
- protected
- function GetInternalFormat: cardinal; override;
- public
- constructor Create;
- property StencilPrecision: TGLStencilPrecision read FStencilPrecision write
- SetStencilPrecision;
- end;
- TGLFrameBuffer = class
- private
- FFrameBufferHandle: TGLFramebufferHandle;
- FTarget: Cardinal;
- FWidth: Integer;
- FHeight: Integer;
- FLayer: Integer;
- FLevel: Integer;
- FTextureMipmap: cardinal;
- FAttachedTexture: array[0..MaxColorAttachments - 1] of TGLTexture;
- FDepthTexture: TGLTexture;
- FDRBO: TGLDepthRBO;
- FSRBO: TGLStencilRBO;
- function GetStatus: TGLFramebufferStatus;
- procedure SetHeight(const Value: Integer);
- procedure SetWidth(const Value: Integer);
- procedure SetLayer(const Value: Integer);
- procedure SetLevel(const Value: Integer);
- protected
- procedure AttachTexture(
- const attachment: Cardinal;
- const textarget: Cardinal;
- const texture: Cardinal;
- const level: TGLint;
- const layer: TGLint); overload;
- procedure ReattachTextures;
- public
- constructor Create;
- destructor Destroy; override;
- // attaches a depth rbo to the fbo
- // the depth buffer must have the same dimentions as the fbo
- procedure AttachDepthBuffer(DepthBuffer: TGLDepthRBO); overload;
- // detaches depth attachment from the fbo
- procedure DetachDepthBuffer;
- // attaches a stencil rbo to the fbo
- // the stencil buffer must have the same dimentions as the fbo
- procedure AttachStencilBuffer(StencilBuffer: TGLStencilRBO); overload;
- // detaches stencil attachment from the fbo
- procedure DetachStencilBuffer;
- // attaches a depth texture to the fbo
- // the depth texture must have the same dimentions as the fbo
- procedure AttachDepthTexture(Texture: TGLTexture); overload;
- procedure DetachDepthTexture;
- procedure AttachTexture(n: Cardinal; Texture: TGLTexture); overload;
- procedure DetachTexture(n: Cardinal);
- function GetStringStatus(out clarification: string): TGLFramebufferStatus;
- property Status: TGLFramebufferStatus read GetStatus;
- procedure Bind;
- procedure Unbind;
- procedure PreRender;
- procedure Render(var rci: TGLRenderContextInfo; baseObject: TGLBaseSceneObject);
- procedure PostRender(const PostGenerateMipmap: Boolean);
- property Handle: TGLFramebufferHandle read FFrameBufferHandle;
- property Width: Integer read FWidth write SetWidth;
- property Height: Integer read FHeight write SetHeight;
- property Layer: Integer read FLayer write SetLayer;
- property Level: Integer read FLevel write SetLevel;
- end;
- //----------------------- GLS.FBORenderer classes --------------------------
- TGLEnabledRenderBuffer = (erbDepth, erbStencil);
- TGLEnabledRenderBuffers = set of TGLEnabledRenderBuffer;
- TGLFBOTargetVisibility = (tvDefault, tvFBOOnly);
- TGLFBOClearOption = (coColorBufferClear, coDepthBufferClear,
- coStencilBufferClear, coUseBufferBackground);
- TGLFBOClearOptions = set of TGLFBOClearOption;
- TGLTextureArray = array of TGLTexture;
- TSetTextureTargetsEvent = procedure(Sender : TObject;
- var colorTexs : TGLTextureArray) of object;
- TGLFBORenderer = class(TGLBaseSceneObject, IGLMaterialLibrarySupported)
- private
- FFbo: TGLFrameBuffer;
- FDepthRBO: TGLDepthRBO;
- FStencilRBO: TGLStencilRBO;
- FColorAttachment: Integer;
- FRendering: Boolean;
- FHasColor: Boolean;
- FHasDepth: Boolean;
- FHasStencil: Boolean;
- FMaterialLibrary: TGLMaterialLibrary;
- FColorTextureName: TGLLibMaterialName;
- FDepthTextureName: TGLLibMaterialName;
- FWidth: Integer;
- FHeight: Integer;
- FForceTextureDimensions: Boolean;
- FStencilPrecision: TGLStencilPrecision;
- FRootObject: TGLBaseSceneObject;
- FRootVisible: Boolean;
- FCamera: TGLCamera;
- FEnabledRenderBuffers: TGLEnabledRenderBuffers;
- FTargetVisibility: TGLFBOTargetVisibility;
- FBeforeRender: TGLDirectRenderEvent;
- FPostInitialize: TNotifyEvent;
- FAfterRender: TGLDirectRenderEvent;
- FPreInitialize: TNotifyEvent;
- FBackgroundColor: TGLColor;
- FClearOptions: TGLFBOClearOptions;
- FAspect: Single;
- FSceneScaleFactor: Single;
- FUseLibraryAsMultiTarget: Boolean;
- FPostGenerateMipmap: Boolean;
- FMaxSize: Integer;
- FMaxAttachment: Integer;
- FStoreCamera: array[0..2] of TGLVector;
- FOnSetTextureTargets: TSetTextureTargetsEvent;
- // implementing IGLMaterialLibrarySupported
- function GetMaterialLibrary: TGLAbstractMaterialLibrary;
- procedure SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
- procedure SetDepthTextureName(const Value: TGLLibMaterialName);
- procedure SetColorTextureName(const Value: TGLLibMaterialName);
- procedure SetForceTextureDimentions(const Value: Boolean);
- procedure SetHeight(Value: Integer);
- procedure SetWidth(Value: Integer);
- procedure SetLayer(const Value: Integer);
- function GetLayer: Integer;
- procedure SetLevel(const Value: Integer);
- function GetLevel: Integer;
- procedure SetStencilPrecision(const Value: TGLStencilPrecision);
- procedure SetRootObject(const Value: TGLBaseSceneObject);
- function GetViewport: TRectangle;
- procedure SetCamera(const Value: TGLCamera);
- procedure SetEnabledRenderBuffers(const Value: TGLEnabledRenderBuffers);
- procedure SetTargetVisibility(const Value: TGLFBOTargetVisibility);
- procedure SetBackgroundColor(const Value: TGLColor);
- function StoreSceneScaleFactor: Boolean;
- function StoreAspect: Boolean;
- procedure SetUseLibraryAsMultiTarget(Value: Boolean);
- procedure SetPostGenerateMipmap(const Value: Boolean);
- protected
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- procedure Initialize;
- procedure ForceDimensions(Texture: TGLTexture);
- procedure RenderToFBO(var ARci: TGLRenderContextInfo);
- procedure ApplyCamera(var ARci: TGLRenderContextInfo);
- procedure UnApplyCamera(var ARci: TGLRenderContextInfo);
- procedure DoBeforeRender(var ARci: TGLRenderContextInfo);
- procedure DoAfterRender(var ARci: TGLRenderContextInfo);
- procedure DoPreInitialize;
- procedure DoPostInitialize;
- property HasColor: Boolean read FHasColor;
- property HasDepth: Boolean read FHasDepth;
- property HasStencil: Boolean read FHasStencil;
- property Viewport: TRectangle read GetViewport;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure DoRender(var ARci: TGLRenderContextInfo; ARenderSelf: Boolean;
- ARenderChildren: Boolean); override;
- (* Layer (also cube map face) is activated only on
- the volume textures, texture array and cube map.
- You can select the layer during the drawing to. *)
- property Layer: Integer read GetLayer write SetLayer;
- // Mipmap Level where will be rendering
- property Level: Integer read GetLevel write SetLevel;
- published
- property Active: Boolean read GetVisible write SetVisible default True;
- property PickableTarget: Boolean read GetPickable write SetPickable default False;
- (* Force texture dimensions when initializing
- only works with TGLBlankImage and TGLFloatDataImage, otherwise does nothing *)
- property ForceTextureDimensions: Boolean read FForceTextureDimensions
- write SetForceTextureDimentions default True;
- property Width: Integer read FWidth write SetWidth default 256;
- property Height: Integer read FHeight write SetHeight default 256;
- property Aspect: Single read FAspect write FAspect stored StoreAspect;
- property ColorTextureName: TGLLibMaterialName read FColorTextureName
- write SetColorTextureName;
- property DepthTextureName: TGLLibMaterialName read FDepthTextureName
- write SetDepthTextureName;
- property MaterialLibrary: TGLAbstractMaterialLibrary read GetMaterialLibrary
- write SetMaterialLibrary;
- property BackgroundColor: TGLColor read FBackgroundColor write SetBackgroundColor;
- property ClearOptions: TGLFBOClearOptions read FClearOptions
- write FClearOptions;
- (* Camera used for rendering to the FBO
- if not assigned, use the active view's camera *)
- property Camera: TGLCamera read FCamera write SetCamera;
- (* Adjust the scene scale of the camera so that the rendering
- becomes independent of the width of the fbo renderer
- 0 = disabled *)
- property SceneScaleFactor: Single read FSceneScaleFactor
- write FSceneScaleFactor stored StoreSceneScaleFactor;
- (* Root object used when rendering to the FBO
- if not assigned, uses itself as root and renders the child objects to the FBO *)
- property RootObject: TGLBaseSceneObject read FRootObject
- write SetRootObject;
- (* Determines if target is rendered to FBO only or rendered normally
- in FBO only mode, if RootObject is assigned, the RootObject's Visible flag is modified
- in default mode, if RootObject is not assigned, children are rendered normally after being
- rendered to the FBO *)
- property TargetVisibility: TGLFBOTargetVisibility read FTargetVisibility
- write SetTargetVisibility default tvDefault;
- // Enables the use of a render buffer if a texture is not assigned
- property EnabledRenderBuffers: TGLEnabledRenderBuffers
- read FEnabledRenderBuffers write SetEnabledRenderBuffers;
- // use stencil buffer
- property StencilPrecision: TGLStencilPrecision read FStencilPrecision
- write SetStencilPrecision default spDefault;
- // called before rendering to the FBO
- property BeforeRender: TGLDirectRenderEvent read FBeforeRender write FBeforeRender;
- // called after the rendering to the FBO
- property AfterRender: TGLDirectRenderEvent read FAfterRender write FAfterRender;
- (* Called before the FBO is initialized
- the FBO is bound before calling this event *)
- property PreInitialize: TNotifyEvent read FPreInitialize write FPreInitialize;
- (* Called after the FBO is initialized, but before any rendering
- the FBO is bound before calling this event *)
- property PostInitialize: TNotifyEvent read FPostInitialize write FPostInitialize;
- property UseLibraryAsMultiTarget: Boolean read FUseLibraryAsMultiTarget
- write SetUseLibraryAsMultiTarget default False;
- (* Control mipmap generation after rendering
- texture must have MinFilter with mipmaping *)
- property PostGenerateMipmap: Boolean read FPostGenerateMipmap
- write SetPostGenerateMipmap default True;
- (* Allows multiTargeting to different texture sources instead of all coming
- from one single MatLib with UseLibraryAsMultiTarget. OnSetTextureTargets
- overrides the other method of setting target textures via the MaterialLibrary,
- ColorTextureName and DepthTextureName propertes *)
- property OnSetTextureTargets: TSetTextureTargetsEvent read FOnSetTextureTargets
- write FOnSetTextureTargets;
- end;
- //======================================================================
- implementation
- //======================================================================
- //---------------------------------------
- //---------- TGLRenderbuffer
- //---------------------------------------
- constructor TGLRenderbuffer.Create;
- begin
- inherited Create;
- FRenderbufferHandle := TGLRenderbufferHandle.Create;
- FWidth := 256;
- FHeight := 256;
- end;
- destructor TGLRenderbuffer.Destroy;
- begin
- FRenderbufferHandle.DestroyHandle;
- FRenderbufferHandle.Free;
- inherited Destroy;
- end;
- function TGLRenderbuffer.GetHandle: Cardinal;
- begin
- if FRenderbufferHandle.Handle = 0 then
- FRenderbufferHandle.AllocateHandle;
- Result := FRenderbufferHandle.Handle;
- end;
- procedure TGLRenderbuffer.InvalidateStorage;
- begin
- FStorageValid := False;
- end;
- procedure TGLRenderbuffer.SetHeight(const Value: Integer);
- begin
- if FHeight <> Value then
- begin
- FHeight := Value;
- InvalidateStorage;
- end;
- end;
- procedure TGLRenderbuffer.SetWidth(const Value: Integer);
- begin
- if FWidth <> Value then
- begin
- FWidth := Value;
- InvalidateStorage;
- end;
- end;
- procedure TGLRenderbuffer.Bind;
- var
- internalFormat: cardinal;
- begin
- FRenderbufferHandle.AllocateHandle;
- FRenderbufferHandle.Bind;
- if not FStorageValid then
- begin
- internalFormat := GetInternalFormat;
- FRenderbufferHandle.SetStorage(internalFormat, FWidth, FHeight);
- end;
- end;
- procedure TGLRenderbuffer.Unbind;
- begin
- FRenderbufferHandle.UnBind;
- end;
- //---------------------------------
- //----------- TGLDepthRBO
- //---------------------------------
- constructor TGLDepthRBO.Create;
- begin
- inherited Create;
- FDepthPrecision := dpDefault;
- end;
- function TGLDepthRBO.GetInternalFormat: cardinal;
- begin
- case DepthPrecision of
- dp24bits: Result := GL_DEPTH_COMPONENT24;
- dp16bits: Result := GL_DEPTH_COMPONENT16;
- dp32bits: Result := GL_DEPTH_COMPONENT32;
- else
- // dpDefault
- Result := GL_DEPTH_COMPONENT24_ARB;
- end;
- end;
- procedure TGLDepthRBO.SetDepthPrecision(const Value: TGLDepthPrecision);
- begin
- if FDepthPrecision <> Value then
- begin
- FDepthPrecision := Value;
- InvalidateStorage;
- end;
- end;
- //-----------------------------------------
- //------------- TGLStencilRBO
- //-----------------------------------------
- constructor TGLStencilRBO.Create;
- begin
- inherited Create;
- FStencilPrecision := spDefault;
- end;
- function TGLStencilRBO.GetInternalFormat: cardinal;
- begin
- case StencilPrecision of
- spDefault: Result := GL_STENCIL_INDEX;
- sp1bit: Result := GL_STENCIL_INDEX1_EXT;
- sp4bits: Result := GL_STENCIL_INDEX4_EXT;
- sp8bits: Result := GL_STENCIL_INDEX8_EXT;
- sp16bits: Result := GL_STENCIL_INDEX16_EXT;
- else
- // spDefault
- Result := GL_STENCIL_INDEX;
- end;
- end;
- procedure TGLStencilRBO.SetStencilPrecision(const Value: TGLStencilPrecision);
- begin
- if FStencilPrecision <> Value then
- begin
- FStencilPrecision := Value;
- InvalidateStorage;
- end;
- end;
- //-----------------------------------------
- //--------------- TGLFrameBuffer
- //-----------------------------------------
- constructor TGLFrameBuffer.Create;
- begin
- inherited;
- FFrameBufferHandle := TGLFrameBufferHandle.Create;
- FWidth := 256;
- FHeight := 256;
- FLayer := 0;
- FLevel := 0;
- FTextureMipmap := 0;
- FTarget := GL_FRAMEBUFFER;
- end;
- destructor TGLFrameBuffer.Destroy;
- begin
- FFrameBufferHandle.DestroyHandle;
- FFrameBufferHandle.Free;
- inherited Destroy;
- end;
- procedure TGLFrameBuffer.AttachTexture(n: Cardinal; Texture: TGLTexture);
- var
- textarget: TGLTextureTarget;
- begin
- Assert(n < MaxColorAttachments);
- Texture.Handle;
- FAttachedTexture[n] := Texture;
- textarget := Texture.Image.NativeTextureTarget;
- // Store mipmaping requires
- if not ((Texture.MinFilter in [miNearest, miLinear])
- or (textarget = ttTextureRect)) then
- FTextureMipmap := FTextureMipmap or (1 shl n);
- if Texture.Image is TGLMultiSampleImage then
- FTextureMipmap := 0;
- AttachTexture(
- GL_COLOR_ATTACHMENT0_EXT + n,
- DecodeTextureTarget(textarget),
- Texture.Handle,
- FLevel, FLayer);
- end;
- procedure TGLFrameBuffer.AttachDepthBuffer(DepthBuffer: TGLDepthRBO);
- procedure AttachDepthRB;
- begin
- // forces initialization
- DepthBuffer.Bind;
- DepthBuffer.Unbind;
- gl.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT_EXT,
- GL_RENDERBUFFER_EXT, DepthBuffer.Handle);
- end;
- var
- dp: TGLDepthPrecision;
- begin
- if Assigned(FDRBO) then
- DetachDepthBuffer;
- FDRBO := DepthBuffer;
- Bind;
- AttachDepthRB;
- // if default format didn't work, try something else
- // crude, but might work
- if (Status = fsUnsupported) and (DepthBuffer.DepthPrecision = dpDefault) then
- begin
- // try the other formats
- // best quality first
- for dp := high(dp) downto low(dp) do
- begin
- if dp = dpDefault then
- Continue;
- DepthBuffer.DepthPrecision := dp;
- AttachDepthRB;
- if not (Status = fsUnsupported) then
- Break;
- end;
- end;
- Status;
- Unbind;
- end;
- procedure TGLFrameBuffer.AttachDepthTexture(Texture: TGLTexture);
- begin
- FDepthTexture := Texture;
- if FDepthTexture.Image is TGLMultisampleImage then
- begin
- if not IsDepthFormat(FDepthTexture.TextureFormatEx) then
- begin
- // Force texture properties to depth compatibility
- FDepthTexture.TextureFormatEx := tfDEPTH_COMPONENT24;
- TGLMultisampleImage(FDepthTexture.Image).Width := Width;
- TGLMultisampleImage(FDepthTexture.Image).Height := Height;
- end;
- FTextureMipmap := 0;
- end
- else
- begin
- if not IsDepthFormat(FDepthTexture.TextureFormatEx) then
- begin
- // Force texture properties to depth compatibility
- FDepthTexture.ImageClassName := TGLBlankImage.ClassName;
- FDepthTexture.TextureFormatEx := tfDEPTH_COMPONENT24;
- TGLBlankImage(FDepthTexture.Image).Width := Width;
- TGLBlankImage(FDepthTexture.Image).Height := Height;
- end;
- if FDepthTexture.TextureFormatEx = tfDEPTH24_STENCIL8 then
- begin
- TGLBlankImage(FDepthTexture.Image).GetBitmap32.SetColorFormatDataType(GL_DEPTH_STENCIL, GL_UNSIGNED_INT_24_8);
- TGLBlankImage(FDepthTexture.Image).ColorFormat := GL_DEPTH_STENCIL;
- end
- else
- begin
- TGLBlankImage(FDepthTexture.Image).GetBitmap32.SetColorFormatDataType(GL_DEPTH_COMPONENT, GL_UNSIGNED_BYTE);
- TGLBlankImage(FDepthTexture.Image).ColorFormat := GL_DEPTH_COMPONENT;
- end;
- // Depth texture mipmaping
- if not ((FDepthTexture.MinFilter in [miNearest, miLinear])) then
- FTextureMipmap := FTextureMipmap or Cardinal(1 shl MaxColorAttachments);
- end;
- AttachTexture(
- GL_DEPTH_ATTACHMENT,
- DecodeTextureTarget(FDepthTexture.Image.NativeTextureTarget),
- FDepthTexture.Handle,
- FLevel,
- FLayer);
- if FDepthTexture.TextureFormatEx = tfDEPTH24_STENCIL8 then
- AttachTexture(
- GL_STENCIL_ATTACHMENT,
- DecodeTextureTarget(FDepthTexture.Image.NativeTextureTarget),
- FDepthTexture.Handle,
- FLevel,
- FLayer);
- end;
- procedure TGLFrameBuffer.DetachDepthTexture;
- begin
- if Assigned(FDepthTexture) then
- begin
- FTextureMipmap := FTextureMipmap and (not (1 shl MaxColorAttachments));
- AttachTexture(
- GL_DEPTH_ATTACHMENT,
- DecodeTextureTarget(FDepthTexture.Image.NativeTextureTarget),
- 0, 0, 0);
- FDepthTexture := nil;
- end;
- end;
- procedure TGLFrameBuffer.AttachStencilBuffer(StencilBuffer: TGLStencilRBO);
- procedure AttachStencilRB;
- begin
- // forces initialization
- StencilBuffer.Bind;
- StencilBuffer.Unbind;
- gl.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
- GL_RENDERBUFFER_EXT, StencilBuffer.Handle);
- end;
- var
- sp: TGLStencilPrecision;
- begin
- if Assigned(FSRBO) then
- DetachStencilBuffer;
- FSRBO := StencilBuffer;
- Bind;
- AttachStencilRB;
- // if default format didn't work, try something else
- // crude, but might work
- if (Status = fsUnsupported)
- and (StencilBuffer.StencilPrecision = spDefault) then
- begin
- // try the other formats
- // best quality first
- for sp := high(sp) downto low(sp) do
- begin
- if sp = spDefault then
- Continue;
- StencilBuffer.StencilPrecision := sp;
- AttachStencilRB;
- if not (Status = fsUnsupported) then
- Break;
- end;
- end;
- Status;
- Unbind;
- end;
- procedure TGLFrameBuffer.AttachTexture(
- const attachment: Cardinal;
- const textarget: Cardinal;
- const texture: Cardinal;
- const level: TGLint;
- const layer: TGLint);
- var
- storeDFB: Cardinal;
- RC: TGLContext;
- begin
- RC := SafeCurrentGLContext;
- storeDFB := RC.GLStates.DrawFrameBuffer;
- if storeDFB <> FFrameBufferHandle.Handle then
- Bind;
- with FFrameBufferHandle do
- case textarget of
- GL_TEXTURE_1D:
- Attach1DTexture(FTarget, attachment, textarget, texture, level);
- GL_TEXTURE_2D:
- Attach2DTexture(FTarget, attachment, textarget, texture, level);
- GL_TEXTURE_RECTANGLE: // Rectangle texture can't be leveled
- Attach2DTexture(FTarget, attachment, textarget, texture, 0);
- GL_TEXTURE_3D:
- Attach3DTexture(FTarget, attachment, textarget, texture, level, layer);
- GL_TEXTURE_CUBE_MAP:
- Attach2DTexture(FTarget, attachment, GL_TEXTURE_CUBE_MAP_POSITIVE_X + layer, texture, level);
- GL_TEXTURE_CUBE_MAP_POSITIVE_X,
- GL_TEXTURE_CUBE_MAP_NEGATIVE_X,
- GL_TEXTURE_CUBE_MAP_POSITIVE_Y,
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Y,
- GL_TEXTURE_CUBE_MAP_POSITIVE_Z,
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Z:
- Attach2DTexture(FTarget, attachment, textarget, texture, level);
- GL_TEXTURE_CUBE_MAP_ARRAY,
- GL_TEXTURE_1D_ARRAY,
- GL_TEXTURE_2D_ARRAY:
- AttachLayer(FTarget, attachment, texture, level, layer);
- GL_TEXTURE_2D_MULTISAMPLE: // Multisample texture can't be leveled
- Attach2DTexture(FTarget, attachment, textarget, texture, 0);
- GL_TEXTURE_2D_MULTISAMPLE_ARRAY:
- AttachLayer(FTarget, attachment, texture, 0, layer);
- end;
- if storeDFB <> FFrameBufferHandle.Handle then
- RC.GLStates.SetFrameBuffer(storeDFB);
- end;
- procedure TGLFrameBuffer.Bind;
- begin
- if Handle.IsDataNeedUpdate then
- ReattachTextures
- else
- Handle.Bind;
- end;
- procedure TGLFrameBuffer.Unbind;
- begin
- FFrameBufferHandle.UnBind;
- end;
- procedure TGLFrameBuffer.DetachTexture(n: Cardinal);
- begin
- // textarget ignored when binding 0
- if Assigned(FAttachedTexture[n]) then
- begin
- Bind;
- AttachTexture(
- GL_COLOR_ATTACHMENT0 + n,
- GL_TEXTURE_2D, // target does not matter
- 0, 0, 0);
- FTextureMipmap := FTextureMipmap and (not (1 shl n));
- FAttachedTexture[n] := nil;
- Unbind;
- end;
- end;
- procedure TGLFrameBuffer.DetachDepthBuffer;
- begin
- Bind;
- gl.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT,
- GL_RENDERBUFFER, 0);
- Unbind;
- FDRBO := nil;
- end;
- procedure TGLFrameBuffer.DetachStencilBuffer;
- begin
- Bind;
- gl.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
- GL_RENDERBUFFER, 0);
- Unbind;
- FSRBO := nil;
- end;
- function TGLFrameBuffer.GetStatus: TGLFramebufferStatus;
- var
- status: cardinal;
- begin
- status := gl.CheckFramebufferStatus(FTarget);
- case status of
- GL_FRAMEBUFFER_COMPLETE_EXT: Result := fsComplete;
- GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT: Result := fsIncompleteAttachment;
- GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT: Result :=
- fsIncompleteMissingAttachment;
- GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT: Result :=
- fsIncompleteDuplicateAttachment;
- GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: Result := fsIncompleteDimensions;
- GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: Result := fsIncompleteFormats;
- GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT: Result := fsIncompleteDrawBuffer;
- GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT: Result := fsIncompleteReadBuffer;
- GL_FRAMEBUFFER_UNSUPPORTED_EXT: Result := fsUnsupported;
- GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE: Result := fsIncompleteMultisample;
- else
- Result := fsStatusError;
- end;
- end;
- function TGLFrameBuffer.GetStringStatus(out clarification: string):
- TGLFramebufferStatus;
- const
- cFBOStatus: array[TGLFramebufferStatus] of string = (
- 'Complete',
- 'Incomplete attachment',
- 'Incomplete missing attachment',
- 'Incomplete duplicate attachment',
- 'Incomplete dimensions',
- 'Incomplete formats',
- 'Incomplete draw buffer',
- 'Incomplete read buffer',
- 'Unsupported',
- 'Incomplite multisample',
- 'Status Error');
- begin
- Result := GetStatus;
- clarification := cFBOStatus[Result];
- end;
- procedure TGLFrameBuffer.PostRender(const PostGenerateMipmap: Boolean);
- var
- n: Integer;
- textarget: TGLTextureTarget;
- begin
- if (FTextureMipmap > 0) and PostGenerateMipmap then
- begin
- for n := 0 to MaxColorAttachments - 1 do
- if Assigned(FAttachedTexture[n]) then
- begin
- if FTextureMipmap and (1 shl n) = 0 then
- Continue;
- textarget := FAttachedTexture[n].Image.NativeTextureTarget;
- with FFrameBufferHandle.RenderingContext.GLStates do
- TextureBinding[ActiveTexture, textarget] :=
- FAttachedTexture[n].Handle;
- gl.GenerateMipmap(DecodeTextureTarget(textarget));
- end;
- end;
- end;
- procedure TGLFrameBuffer.PreRender;
- begin
- end;
- procedure TGLFrameBuffer.Render(var rci: TGLRenderContextInfo; baseObject:
- TGLBaseSceneObject);
- var
- backColor: TGLColorVector;
- buffer: TGLSceneBuffer;
- begin
- Bind;
- Assert(Status = fsComplete, 'Framebuffer not complete');
- buffer := TGLSceneBuffer(rci.buffer);
- backColor := ConvertWinColor(buffer.BackgroundColor);
- gl.ClearColor(backColor.X, backColor.Y, backColor.Z,
- buffer.BackgroundAlpha);
- rci.GLStates.SetColorMask(cAllColorComponents);
- rci.GLStates.DepthWriteMask := True;
- gl.Clear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- baseObject.Render(rci);
- Unbind;
- end;
- procedure TGLFrameBuffer.SetHeight(const Value: Integer);
- begin
- if FHeight <> Value then
- begin
- FHeight := Value;
- end;
- end;
- procedure TGLFrameBuffer.SetWidth(const Value: Integer);
- begin
- if FWidth <> Value then
- begin
- FWidth := Value;
- end;
- end;
- procedure TGLFrameBuffer.ReattachTextures;
- var
- n: Integer;
- bEmpty: Boolean;
- s: String;
- begin
- Handle.AllocateHandle;
- Handle.Bind;
- // Reattach layered textures
- bEmpty := True;
- for n := 0 to MaxColorAttachments - 1 do
- if Assigned(FAttachedTexture[n]) then
- begin
- AttachTexture(
- GL_COLOR_ATTACHMENT0_EXT + n,
- DecodeTextureTarget(FAttachedTexture[n].Image.NativeTextureTarget),
- FAttachedTexture[n].Handle,
- FLevel,
- FLayer);
- bEmpty := False;
- end;
- if Assigned(FDepthTexture) then
- begin
- AttachTexture(
- GL_DEPTH_ATTACHMENT,
- DecodeTextureTarget(FDepthTexture.Image.NativeTextureTarget),
- FDepthTexture.Handle,
- FLevel,
- FLayer);
- bEmpty := False;
- end;
- if Assigned(FDRBO) then
- begin
- FDRBO.Bind;
- FDRBO.Unbind;
- gl.FramebufferRenderbuffer(FTarget, GL_DEPTH_ATTACHMENT_EXT,
- GL_RENDERBUFFER_EXT, FDRBO.Handle);
- bEmpty := False;
- end;
- if Assigned(FSRBO) then
- begin
- FSRBO.Bind;
- FSRBO.Unbind;
- gl.FramebufferRenderbuffer(FTarget, GL_STENCIL_ATTACHMENT,
- GL_RENDERBUFFER_EXT, FSRBO.Handle);
- bEmpty := False;
- end;
- if not bEmpty and (GetStringStatus(s) <> fsComplete) then
- GLSLogger.LogErrorFmt('Framebuffer error: %s. Deactivated', [s]);
- Handle.NotifyDataUpdated;
- end;
- procedure TGLFrameBuffer.SetLayer(const Value: Integer);
- var
- RC: TGLContext;
- begin
- if FLayer <> Value then
- begin
- FLayer := Value;
- RC := CurrentGLContext;
- if Assigned(RC) then
- begin
- if RC.GLStates.DrawFrameBuffer = FFrameBufferHandle.Handle then
- ReattachTextures;
- end;
- end;
- end;
- procedure TGLFrameBuffer.SetLevel(const Value: Integer);
- var
- RC: TGLContext;
- begin
- if FLevel <> Value then
- begin
- FLevel := Value;
- RC := CurrentGLContext;
- if Assigned(RC) then
- begin
- if RC.GLStates.DrawFrameBuffer = FFrameBufferHandle.Handle then
- ReattachTextures;
- end;
- end;
- end;
- //
- // ------------------- TGLFBORenderer --------------------------
- //
- procedure TGLFBORenderer.ApplyCamera(var ARci: TGLRenderContextInfo);
- var
- sc: Single;
- begin
- with ARci.PipelineTransformation do
- begin
- Push;
- if Assigned(Camera) then
- begin
- FStoreCamera[0] := ARci.cameraPosition;
- FStoreCamera[1] := ARci.cameraDirection;
- FStoreCamera[2] := ARci.cameraUp;
- IdentityAll;
- sc := FCamera.SceneScale;
- if FSceneScaleFactor > 0 then
- FCamera.SceneScale := Width / FSceneScaleFactor;
- FCamera.ApplyPerspective(Viewport, Width, Height, 96);
- // 96 is default dpi
- FCamera.SceneScale := sc;
- SetViewMatrix(CreateScaleMatrix(Vector3fMake(1.0 / FAspect, 1.0, 1.0)));
- FCamera.Apply;
- end
- else
- begin
- SetViewMatrix(MatrixMultiply(ViewMatrix^,
- CreateScaleMatrix(Vector3fMake(1.0 / FAspect, 1.0, 1.0))));
- end;
- end;
- end;
- procedure TGLFBORenderer.UnApplyCamera(var ARci: TGLRenderContextInfo);
- begin
- ARci.cameraPosition := FStoreCamera[0];
- ARci.cameraDirection := FStoreCamera[1];
- ARci.cameraUp := FStoreCamera[2];
- ARci.PipelineTransformation.Pop;
- end;
- constructor TGLFBORenderer.Create(AOwner: TComponent);
- begin
- inherited;
- ObjectStyle := [osDirectDraw, osNoVisibilityCulling];
- FFbo := TGLFrameBuffer.Create;
- FBackgroundColor := TGLColor.Create(Self);
- FUseLibraryAsMultiTarget := False;
- FForceTextureDimensions := True;
- FWidth := 256;
- FHeight := 256;
- FEnabledRenderBuffers := [erbDepth];
- FClearOptions := [coColorBufferClear, coDepthBufferClear,
- coStencilBufferClear, coUseBufferBackground];
- PickableTarget := False;
- FAspect := 1.0;
- FSceneScaleFactor := 0.0;
- FPostGenerateMipmap := True;
- StructureChanged;
- end;
- destructor TGLFBORenderer.Destroy;
- begin
- FFbo.Free;
- FDepthRBO.Free;
- FStencilRBO.Free;
- FBackgroundColor.Free;
- inherited;
- end;
- procedure TGLFBORenderer.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited;
- if (AComponent = FRootObject) and (Operation = opRemove) then
- FRootObject := nil;
- end;
- procedure TGLFBORenderer.DoAfterRender(var ARci: TGLRenderContextInfo);
- begin
- if Assigned(FAfterRender) then
- FAfterRender(Self, ARci);
- end;
- procedure TGLFBORenderer.DoBeforeRender(var ARci: TGLRenderContextInfo);
- begin
- if Assigned(FBeforeRender) then
- FBeforeRender(Self, ARci);
- end;
- procedure TGLFBORenderer.DoPostInitialize;
- begin
- if Assigned(FPostInitialize) then
- FPostInitialize(Self);
- end;
- procedure TGLFBORenderer.DoPreInitialize;
- begin
- if Assigned(FPreInitialize) then
- FPreInitialize(Self);
- end;
- procedure TGLFBORenderer.DoRender(var ARci: TGLRenderContextInfo;
- ARenderSelf, ARenderChildren: Boolean);
- begin
- if not (csDesigning in ComponentState) then
- RenderToFBO(ARci);
- if (not Assigned(FRootObject)) and (TargetVisibility = tvDefault) and ARenderChildren
- then
- RenderChildren(0, Count - 1, ARci);
- end;
- procedure TGLFBORenderer.ForceDimensions(Texture: TGLTexture);
- var
- bi: TGLBlankImage;
- mi: TGLMultisampleImage;
- begin
- if Texture.Image is TGLBlankImage then
- begin
- bi := TGLBlankImage(Texture.Image);
- bi.Width := Width;
- bi.Height := Height;
- end
- else if Texture.Image is TGLMultisampleImage then
- begin
- mi := TGLMultisampleImage(Texture.Image);
- mi.Width := Width;
- mi.Height := Height;
- end;
- end;
- function TGLFBORenderer.GetViewport: TRectangle;
- begin
- Result.Left := 0;
- Result.Top := 0;
- Result.Width := Width;
- Result.Height := Height;
- end;
- procedure TGLFBORenderer.Initialize;
- procedure AddOneMultiTarget(colorTex: TGLTexture);
- begin
- if ForceTextureDimensions then
- ForceDimensions(colorTex);
- if FColorAttachment >= FMaxAttachment then
- begin
- GLSLogger.LogError
- ('Number of color attachments out of GL_MAX_COLOR_ATTACHMENTS');
- Visible := False;
- Abort;
- end;
- FFbo.AttachTexture(FColorAttachment, colorTex);
- Inc(FColorAttachment);
- end;
- const
- cDrawBuffers: array [0 .. 15] of Cardinal = (GL_COLOR_ATTACHMENT0,
- GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2,
- GL_COLOR_ATTACHMENT3, GL_COLOR_ATTACHMENT4,
- GL_COLOR_ATTACHMENT5, GL_COLOR_ATTACHMENT6,
- GL_COLOR_ATTACHMENT7, GL_COLOR_ATTACHMENT8,
- GL_COLOR_ATTACHMENT9, GL_COLOR_ATTACHMENT10,
- GL_COLOR_ATTACHMENT11, GL_COLOR_ATTACHMENT12,
- GL_COLOR_ATTACHMENT13, GL_COLOR_ATTACHMENT14,
- GL_COLOR_ATTACHMENT15);
- var
- colorTex: TGLTexture;
- depthTex: TGLTexture;
- I: Integer;
- MulTexture : TGLTextureArray;
- begin
- for I := 0 to MaxColorAttachments - 1 do
- FFbo.DetachTexture(I);
- if FMaxSize = 0 then
- gl.GetIntegerv(GL_MAX_RENDERBUFFER_SIZE, @FMaxSize);
- if Width > FMaxSize then
- begin
- FWidth := FMaxSize;
- GLSLogger.LogWarningFmt('%s.Width out of GL_MAX_RENDERBUFFER_SIZE', [Name]);
- end;
- if Height > FMaxSize then
- begin
- FHeight := FMaxSize;
- GLSLogger.LogWarningFmt('%s.Height out of GL_MAX_RENDERBUFFER_SIZE', [Name]);
- end;
- FFbo.Width := Width;
- FFbo.Height := Height;
- FFbo.Bind;
- DoPreInitialize;
- FFbo.Unbind;
- if Assigned(FMaterialLibrary) then
- begin
- colorTex := FMaterialLibrary.TextureByName(ColorTextureName);
- depthTex := FMaterialLibrary.TextureByName(DepthTextureName);
- end
- else
- begin
- colorTex := nil;
- depthTex := nil;
- end;
- FHasColor := False;
- FHasDepth := False;
- FHasStencil := False;
- FColorAttachment := 0;
- if FUseLibraryAsMultiTarget or Assigned(FOnSetTextureTargets) then
- begin
- if not(gl.ARB_draw_buffers or gl.ATI_draw_buffers) then
- begin
- GLSLogger.LogError('Hardware do not support MRT');
- Active := False;
- exit;
- end;
- if FMaxAttachment = 0 then
- gl.GetIntegerv(GL_MAX_COLOR_ATTACHMENTS, @FMaxAttachment);
- if Assigned(FOnSetTextureTargets) then
- begin
- FOnSetTextureTargets(Self, MulTexture);
- for I := 0 to High(MulTexture) do
- begin
- colorTex := MulTexture[i];
- // Skip depth texture
- if colorTex = depthTex then
- Continue;
- AddOneMultiTarget(colorTex);
- end;
- end
- else
- // Multicolor attachments
- for I := 0 to FMaterialLibrary.Materials.Count - 1 do
- begin
- colorTex := FMaterialLibrary.Materials[I].Material.Texture;
- // Skip depth texture
- if colorTex = depthTex then
- Continue;
- AddOneMultiTarget(colorTex);
- end;
- FHasColor := FColorAttachment > 0;
- end
- else
- begin
- // One color attachment
- if Assigned(colorTex) then
- begin
- if ForceTextureDimensions then
- ForceDimensions(colorTex);
- FFbo.AttachTexture(0, colorTex);
- Inc(FColorAttachment);
- FHasColor := True;
- end;
- end;
- if Assigned(depthTex) then
- begin
- if ForceTextureDimensions then
- ForceDimensions(depthTex);
- FFbo.AttachDepthTexture(depthTex);
- FDepthRBO.Free;
- FDepthRBO := nil;
- FHasDepth := True;
- FHasStencil := depthTex.TextureFormatEx = tfDEPTH24_STENCIL8;
- end
- else if erbDepth in EnabledRenderBuffers then
- begin
- if not Assigned(FDepthRBO) then
- FDepthRBO := TGLDepthRBO.Create;
- FDepthRBO.Width := Width;
- FDepthRBO.Height := Height;
- FFbo.AttachDepthBuffer(FDepthRBO);
- FHasDepth := True;
- end
- else
- begin
- FFbo.DetachDepthBuffer;
- if Assigned(FDepthRBO) then
- begin
- FDepthRBO.Free;
- FDepthRBO := nil;
- end;
- end;
- if erbStencil in EnabledRenderBuffers then
- begin
- if not Assigned(FStencilRBO) then
- FStencilRBO := TGLStencilRBO.Create;
- FStencilRBO.StencilPrecision := FStencilPrecision;
- FStencilRBO.Width := Width;
- FStencilRBO.Height := Height;
- FFbo.AttachStencilBuffer(FStencilRBO);
- FHasStencil := True;
- end
- else
- begin
- if not FHasStencil then
- FFbo.DetachStencilBuffer;
- if Assigned(FStencilRBO) then
- begin
- FStencilRBO.Free;
- FStencilRBO := nil;
- end;
- end;
- FFbo.Bind;
- if FColorAttachment = 0 then
- begin
- gl.DrawBuffer(GL_NONE);
- gl.ReadBuffer(GL_NONE);
- end
- else
- gl.DrawBuffers(FColorAttachment, @cDrawBuffers);
- DoPostInitialize;
- FFbo.Unbind;
- gl.CheckError;
- ClearStructureChanged;
- end;
- procedure TGLFBORenderer.RenderToFBO(var ARci: TGLRenderContextInfo);
- function GetClearBits: cardinal;
- begin
- Result := 0;
- if HasColor and (coColorBufferClear in FClearOptions) then
- Result := Result or GL_COLOR_BUFFER_BIT;
- if HasDepth and (coDepthBufferClear in FClearOptions) then
- Result := Result or GL_DEPTH_BUFFER_BIT;
- if HasStencil and (coStencilBufferClear in FClearOptions) then
- Result := Result or GL_STENCIL_BUFFER_BIT;
- end;
- type
- TGLStoredStates = record
- ColorClearValue: TGLColorVector;
- ColorWriteMask: TGLColorMask;
- Tests: TGLStates;
- end;
- function StoreStates: TGLStoredStates;
- begin
- Result.ColorClearValue := ARci.GLStates.ColorClearValue;
- Result.ColorWriteMask := ARci.GLStates.ColorWriteMask[0];
- Result.Tests := [stDepthTest, stStencilTest] * ARci.GLStates.States;
- end;
- procedure RestoreStates(const aStates: TGLStoredStates);
- begin
- ARci.GLStates.ColorClearValue := aStates.ColorClearValue;
- ARci.GLStates.SetColorMask(aStates.ColorWriteMask);
- if stDepthTest in aStates.Tests then
- ARci.GLStates.Enable(stDepthTest)
- else
- ARci.GLStates.Disable(stDepthTest);
- if stStencilTest in aStates.Tests then
- ARci.GLStates.Enable(stStencilTest)
- else
- ARci.GLStates.Disable(stStencilTest);
- end;
- var
- backColor: TGLColorVector;
- buffer: TGLSceneBuffer;
- savedStates: TGLStoredStates;
- w, h: Integer;
- s: string;
- begin
- if (ARci.drawState = dsPicking) and not PickableTarget then
- Exit;
- if not TGLFramebufferHandle.IsSupported then
- begin
- GLSLogger.LogError('Framebuffer not supported - deactivated');
- Active := False;
- Exit;
- end;
- // prevent recursion
- if FRendering then
- Exit;
- FRendering := True;
- if (ocStructure in Changes) or Assigned(FOnSetTextureTargets) then
- begin
- Initialize;
- if not Active then
- Exit;
- end;
- ApplyCamera(ARci);
- try
- savedStates := StoreStates;
- FFbo.Bind;
- if FFbo.GetStringStatus(s) <> fsComplete then
- begin
- GLSLogger.LogErrorFmt('Framebuffer error: %s. Deactivated', [s]);
- Active := False;
- Exit;
- end;
- DoBeforeRender(ARci);
- if Assigned(Camera) then
- Camera.Scene.SetupLights(ARci.GLStates.MaxLights);
- w := Width;
- h := Height;
- if FFbo.Level > 0 then
- begin
- w := w shr FFbo.Level;
- h := h shr FFbo.Level;
- if w = 0 then
- w := 1;
- if h = 0 then
- h := 1;
- end;
- ARci.GLStates.Viewport := Vector4iMake(0, 0, w, h);
- buffer := ARci.buffer as TGLSceneBuffer;
- if HasColor then
- ARci.GLStates.SetColorMask(cAllColorComponents)
- else
- ARci.GLStates.SetColorMask([]);
- ARci.GLStates.DepthWriteMask := HasDepth;
- if HasStencil then
- ARci.GLStates.Enable(stStencilTest)
- else
- ARci.GLStates.Disable(stStencilTest);
- if coUseBufferBackground in FClearOptions then
- begin
- backColor := ConvertWinColor(buffer.BackgroundColor);
- backColor.W := buffer.BackgroundAlpha;
- ARci.GLStates.ColorClearValue := backColor;
- end
- else
- begin
- ARci.GLStates.ColorClearValue := FBackgroundColor.Color;
- end;
- gl.Clear(GetClearBits);
- FFbo.PreRender;
- // render to fbo
- if Assigned(RootObject) then
- begin
- // if object should only be rendered to the fbo
- // ensure it's visible before rendering to fbo
- if TargetVisibility = tvFBOOnly then
- RootObject.Visible := True;
- RootObject.Render(ARci);
- // then make it invisible afterwards
- if TargetVisibility = tvFBOOnly then
- RootObject.Visible := False;
- end
- else if (Count > 0) then
- RenderChildren(0, Count - 1, ARci);
- FFbo.PostRender(FPostGenerateMipmap);
- RestoreStates(savedStates);
- ARci.GLStates.Viewport := Vector4iMake(0, 0, ARci.viewPortSize.cx,
- ARci.viewPortSize.cy);
- finally
- FFbo.Unbind;
- FRendering := False;
- DoAfterRender(ARci);
- UnApplyCamera(ARci);
- if Assigned(Camera) then
- Camera.Scene.SetupLights(ARci.GLStates.MaxLights);
- end;
- end;
- procedure TGLFBORenderer.SetBackgroundColor(const Value: TGLColor);
- begin
- FBackgroundColor.Assign(Value);
- end;
- procedure TGLFBORenderer.SetCamera(const Value: TGLCamera);
- begin
- if FCamera <> Value then
- begin
- FCamera := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetColorTextureName(const Value: TGLLibMaterialName);
- begin
- if FColorTextureName <> Value then
- begin
- FColorTextureName := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetDepthTextureName(const Value: TGLLibMaterialName);
- begin
- if FDepthTextureName <> Value then
- begin
- FDepthTextureName := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetEnabledRenderBuffers(const Value
- : TGLEnabledRenderBuffers);
- begin
- if FEnabledRenderBuffers <> Value then
- begin
- FEnabledRenderBuffers := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetForceTextureDimentions(const Value: Boolean);
- begin
- if FForceTextureDimensions <> Value then
- begin
- FForceTextureDimensions := Value;
- StructureChanged;
- end;
- end;
- function TGLFBORenderer.GetMaterialLibrary: TGLAbstractMaterialLibrary;
- begin
- Result := FMaterialLibrary;
- end;
- procedure TGLFBORenderer.SetMaterialLibrary(const Value: TGLAbstractMaterialLibrary);
- begin
- if FMaterialLibrary <> Value then
- begin
- if Value is TGLMaterialLibrary then
- begin
- FMaterialLibrary := TGLMaterialLibrary(Value);
- StructureChanged;
- end;
- end;
- end;
- procedure TGLFBORenderer.SetUseLibraryAsMultiTarget(Value: Boolean);
- begin
- if FUseLibraryAsMultiTarget <> Value then
- begin
- FUseLibraryAsMultiTarget := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetPostGenerateMipmap(const Value: Boolean);
- begin
- if FPostGenerateMipmap <> Value then
- FPostGenerateMipmap := Value;
- end;
- procedure TGLFBORenderer.SetRootObject(const Value: TGLBaseSceneObject);
- begin
- if FRootObject <> Value then
- begin
- if Assigned(FRootObject) then
- FRootObject.RemoveFreeNotification(Self);
- FRootObject := Value;
- if Assigned(FRootObject) then
- FRootObject.FreeNotification(Self);
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetStencilPrecision(const Value: TGLStencilPrecision);
- begin
- if FStencilPrecision <> Value then
- begin
- FStencilPrecision := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetTargetVisibility(const Value
- : TGLFBOTargetVisibility);
- begin
- if FTargetVisibility <> Value then
- begin
- if Assigned(RootObject) then
- begin
- if (TargetVisibility = tvFBOOnly) then
- begin
- // we went from fbo only, restore root's old visibility
- RootObject.Visible := FRootVisible;
- end
- else
- begin
- // we're going to fbo only, save root visibility for later
- FRootVisible := RootObject.Visible;
- end;
- end;
- FTargetVisibility := Value;
- StructureChanged;
- end;
- end;
- function TGLFBORenderer.StoreSceneScaleFactor: Boolean;
- begin
- Result := (FSceneScaleFactor <> 0.0);
- end;
- function TGLFBORenderer.StoreAspect: Boolean;
- begin
- Result := (FAspect <> 1.0);
- end;
- procedure TGLFBORenderer.SetWidth(Value: Integer);
- begin
- if FWidth <> Value then
- begin
- FWidth := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetHeight(Value: Integer);
- begin
- if FHeight <> Value then
- begin
- FHeight := Value;
- StructureChanged;
- end;
- end;
- procedure TGLFBORenderer.SetLayer(const Value: Integer);
- begin
- if Value <> FFbo.Layer then
- begin
- if FRendering or (ocStructure in Changes) then
- FFbo.Layer := Value
- else
- begin
- FFbo.Bind;
- FFbo.Layer := Value;
- FFbo.Unbind;
- end;
- end;
- end;
- function TGLFBORenderer.GetLayer: Integer;
- begin
- Result := FFbo.Layer;
- end;
- procedure TGLFBORenderer.SetLevel(const Value: Integer);
- var
- w, h: Integer;
- begin
- if Value <> FFbo.Level then
- begin
- if FRendering or (ocStructure in Changes) then
- begin
- FFbo.Level := Value;
- w := Width;
- h := Height;
- if FFbo.Level > 0 then
- begin
- w := w shr FFbo.Level;
- h := h shr FFbo.Level;
- if w = 0 then
- w := 1;
- if h = 0 then
- h := 1;
- CurrentGLContext.GLStates.Viewport := Vector4iMake(0, 0, w, h);
- end;
- end
- else
- begin
- FFbo.Bind;
- FFbo.Level := Value;
- FFbo.Unbind;
- end;
- end;
- end;
- function TGLFBORenderer.GetLevel: Integer;
- begin
- Result := FFbo.Level;
- end;
- //-------------------------------------------------
- initialization
- //-------------------------------------------------
- RegisterClasses([TGLFBORenderer]);
- end.
|