Move texture objects to openglraw
This commit is contained in:
+30
-22
@@ -6,6 +6,7 @@ module Framebuffer.Setup (
|
||||
setupShadowFramebuffer,
|
||||
) where
|
||||
|
||||
import Unsafe.Coerce
|
||||
import Data.Preload.Render
|
||||
import GLHelp
|
||||
import Graphics.GL.Core45
|
||||
@@ -14,68 +15,75 @@ import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
|
||||
setupTextureFramebuffer ::
|
||||
GLsizei ->
|
||||
GLsizei ->
|
||||
IO (FBO, TextureObject)
|
||||
IO (FBO, TO)
|
||||
{-# INLINE setupTextureFramebuffer #-}
|
||||
setupTextureFramebuffer x y = do
|
||||
--fboName <- genObjectName
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
fboName <- mglCreateSingle glCreateFramebuffers
|
||||
fboTO <- genObjectName
|
||||
textureBinding Texture2D $= Just fboTO
|
||||
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
|
||||
textureFilter Texture2D $= minMagFilter
|
||||
fboName <- mglCreate glCreateFramebuffers
|
||||
--fboTO <- genObjectName
|
||||
to <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
--textureBinding Texture2D $= Just fboTO
|
||||
--glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
|
||||
glTextureStorage2D to 1 GL_RGBA8 x y
|
||||
glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
|
||||
glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
|
||||
--textureFilter Texture2D $= minMagFilter
|
||||
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
|
||||
glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 (unTexture fboTO) 0
|
||||
glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 to 0
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
|
||||
return (FBO fboName, fboTO)
|
||||
return (FBO fboName, TO to)
|
||||
|
||||
setupShadowFramebuffer :: IO (FBO, (TextureObject, TextureObject))
|
||||
setupShadowFramebuffer :: IO (FBO, (TO, TO))
|
||||
setupShadowFramebuffer = do
|
||||
--fboName <- genObjectName
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
fboName <- mglCreateSingle glCreateFramebuffers
|
||||
toName <- genObjectName
|
||||
toName2 <- genObjectName
|
||||
fboName <- mglCreate glCreateFramebuffers
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
|
||||
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
|
||||
--textureBinding Texture2DArray $= Just toName
|
||||
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
||||
return (FBO fboName, (toName, toName2))
|
||||
return (FBO fboName, (TO to1,TO to2))
|
||||
|
||||
setupFramebufferGivenStencil ::
|
||||
GLuint -> -- RenderbufferObject
|
||||
IO (FBO, TextureObject)
|
||||
IO (FBO, TO)
|
||||
{-# INLINE setupFramebufferGivenStencil #-}
|
||||
setupFramebufferGivenStencil rboName = do
|
||||
--fboName <- genObjectName
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
fboName <- mglCreateSingle glCreateFramebuffers
|
||||
toName <- genObjectName
|
||||
fboName <- mglCreate glCreateFramebuffers
|
||||
--toName <- genObjectName
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
||||
glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
|
||||
return (FBO fboName, toName)
|
||||
return (FBO fboName, TO to1)
|
||||
|
||||
setupFramebuffer2GivenStencil ::
|
||||
GLuint -> -- RenderbufferObject
|
||||
IO (FBO, (TextureObject, TextureObject))
|
||||
IO (FBO, (TO, TO))
|
||||
setupFramebuffer2GivenStencil rboName = do
|
||||
--fboName <- genObjectName
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
fboName <- mglCreateSingle glCreateFramebuffers
|
||||
toName <- genObjectName
|
||||
toName2 <- genObjectName
|
||||
fboName <- mglCreate glCreateFramebuffers
|
||||
-- toName <- genObjectName
|
||||
-- toName2 <- genObjectName
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
||||
glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus
|
||||
return (FBO fboName, (toName, toName2))
|
||||
return (FBO fboName, (TO to1, TO to2))
|
||||
|
||||
minMagFilter :: ((TextureFilter, Maybe TextureFilter), TextureFilter)
|
||||
minMagFilter = ((Nearest, Nothing), Nearest)
|
||||
|
||||
+90
-57
@@ -8,6 +8,8 @@ module Framebuffer.Update
|
||||
where
|
||||
import Data.Preload.Render
|
||||
import GLHelp
|
||||
import Unsafe.Coerce
|
||||
import Foreign.Marshal.Array
|
||||
|
||||
import Graphics.Rendering.OpenGL
|
||||
import Graphics.GL.Core45
|
||||
@@ -24,14 +26,14 @@ sizeFBOs
|
||||
-> IO RenderData
|
||||
sizeFBOs xsize ysize xfull yfull rdata = do
|
||||
resizeRBO (_rboBaseBloom rdata) xsize ysize
|
||||
rdata' <- foldM (updateFBOTO2 xsize ysize minMagFilter GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud]
|
||||
>>= flip (foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8))
|
||||
rdata' <- foldM (updateFBOTO2 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud]
|
||||
>>= flip (foldM (updateFBOTO xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8))
|
||||
[fboColor,fboLighting,fboLightingHigh]
|
||||
rdata'' <- foldM (updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F) rdata'
|
||||
rdata'' <- foldM (updateFBOTO xsize ysize GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'
|
||||
[fboBloom, fboPos]
|
||||
rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata''
|
||||
rdata''' <- foldM (updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8) rdata''
|
||||
[fbo2, fbo3]
|
||||
rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata'''
|
||||
rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'''
|
||||
[fboHalf1,fboHalf2,fboHalf3]
|
||||
newShadowFBO <- resizeShadowFBO (rdata ^. fboShadow) xsize ysize
|
||||
return $ rdata4 & fboShadow .~ newShadowFBO
|
||||
@@ -53,111 +55,142 @@ resizeRBO rboName xsize ysize = do
|
||||
updateFBOTO
|
||||
:: Int
|
||||
-> Int
|
||||
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format
|
||||
-> RenderData
|
||||
-> ALens' RenderData (FBO, TextureObject)
|
||||
-> ALens' RenderData (FBO, TO)
|
||||
-> IO RenderData
|
||||
updateFBOTO xsize ysize mmfilt inFormat pdata target = do
|
||||
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
|
||||
updateFBOTO xsize ysize minfilt magfilt inFormat pdata target = do
|
||||
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize minfilt magfilt inFormat
|
||||
return $ storing target newfbo2 pdata
|
||||
|
||||
updateFBOTO2
|
||||
:: Int
|
||||
-> Int
|
||||
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format texture1
|
||||
-> GLenum -- ^ internal color format texture2
|
||||
-> RenderData
|
||||
-> ALens' RenderData (FBO, (TextureObject,TextureObject))
|
||||
-> ALens' RenderData (FBO, (TO,TO))
|
||||
-> IO RenderData
|
||||
updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
|
||||
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
|
||||
updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 pdata target = do
|
||||
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2
|
||||
return $ storing target newfbo2 pdata
|
||||
|
||||
-- note we only really "change" the texture objects
|
||||
resizeShadowFBO :: (FBO, (TextureObject,TextureObject))
|
||||
-> Int -> Int -> IO (FBO, (TextureObject,TextureObject))
|
||||
resizeShadowFBO :: (FBO, (TO,TO))
|
||||
-> Int -> Int -> IO (FBO, (TO,TO))
|
||||
resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
--bindFramebuffer Framebuffer $= fboname
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
|
||||
deleteObjectName oldto1
|
||||
deleteObjectName oldto2
|
||||
to1 <- genObjectName
|
||||
to2 <- genObjectName
|
||||
textureBinding Texture2DArray $= Just to1
|
||||
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
|
||||
textureFilter Texture2DArray $= minMagFilter
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 (unTexture to1) 0
|
||||
textureBinding Texture2DArray $= Just to2
|
||||
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
|
||||
textureFilter Texture2DArray $= minMagFilter
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
|
||||
mglDelete glDeleteTextures $ _unTO oldto1
|
||||
mglDelete glDeleteTextures $ _unTO oldto2
|
||||
--deleteObjectName oldto1
|
||||
--deleteObjectName oldto2
|
||||
--to1 <- genObjectName
|
||||
--to2 <- genObjectName
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
|
||||
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
|
||||
--textureBinding Texture2DArray $= Just to1
|
||||
glTextureStorage3D to1 1 GL_RGBA8 xsize' ysize' 10
|
||||
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
|
||||
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
|
||||
--textureFilter Texture2DArray $= minMagFilter
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 to1 0
|
||||
--textureBinding Texture2DArray $= Just to2
|
||||
glTextureStorage3D to2 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
|
||||
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
|
||||
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
|
||||
--textureFilter Texture2DArray $= minMagFilter
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT to2 0
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
|
||||
return (fboname,(to1,to2))
|
||||
return (fboname,(TO to1,TO to2))
|
||||
|
||||
-- this currently has one mipmap level?
|
||||
resizeFBOTO2
|
||||
:: (FBO , (TextureObject,TextureObject))
|
||||
:: (FBO , (TO,TO))
|
||||
-> Int
|
||||
-> Int
|
||||
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format1
|
||||
-> GLenum -- ^ internal color format2
|
||||
-> IO (FBO, (TextureObject,TextureObject))
|
||||
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do
|
||||
-> IO (FBO, (TO,TO))
|
||||
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
deleteObjectName toOld1
|
||||
deleteObjectName toOld2
|
||||
toName1 <- genObjectName
|
||||
textureBinding Texture2D $= Just toName1
|
||||
glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize'
|
||||
textureFilter Texture2D $= mmfilt
|
||||
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0
|
||||
toName2 <- genObjectName
|
||||
textureBinding Texture2D $= Just toName2
|
||||
glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
|
||||
textureFilter Texture2D $= mmfilt
|
||||
mglDelete glDeleteTextures $ _unTO toOld1
|
||||
mglDelete glDeleteTextures $ _unTO toOld2
|
||||
-- deleteObjectName toOld1
|
||||
-- deleteObjectName toOld2
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
--toName1 <- genObjectName
|
||||
--textureBinding Texture2D $= Just toName1
|
||||
--glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize'
|
||||
glTextureStorage2D to1 1 inFormat1 xsize' ysize'
|
||||
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
||||
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
||||
--textureFilter Texture2D $= mmfilt
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to1 0
|
||||
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0
|
||||
glTextureStorage2D to2 1 inFormat2 xsize' ysize'
|
||||
glTextureParameteri to2 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
||||
glTextureParameteri to2 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
||||
--toName2 <- genObjectName
|
||||
--textureBinding Texture2D $= Just toName2
|
||||
--glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
|
||||
--textureFilter Texture2D $= mmfilt
|
||||
--framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 (unTexture toName2) 0
|
||||
drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 to2 0
|
||||
withArray [GL_COLOR_ATTACHMENT0,GL_COLOR_ATTACHMENT1] $ \ptr ->
|
||||
glNamedFramebufferDrawBuffers (_unFBO fboName) 2 ptr
|
||||
--drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
|
||||
return (fboName, (toName1,toName2))
|
||||
return (fboName, (TO to1,TO to2))
|
||||
|
||||
resizeFBOTO
|
||||
:: (FBO , TextureObject)
|
||||
:: (FBO , TO)
|
||||
-> Int
|
||||
-> Int
|
||||
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
-> GLenum -- ^ minification filter
|
||||
--((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format
|
||||
-> IO (FBO, TextureObject)
|
||||
resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
|
||||
-> IO (FBO, TO)
|
||||
resizeFBOTO (fboName,oldto) xsize ysize minfilt magfilt inFormat = do
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
deleteObjectName toOld
|
||||
toName <- genObjectName
|
||||
textureBinding Texture2D $= Just toName
|
||||
glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
|
||||
textureFilter Texture2D $= mmfilt
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 (unTexture toName) 0
|
||||
mglDelete glDeleteTextures $ _unTO oldto
|
||||
to <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
--toName <- genObjectName
|
||||
--textureBinding Texture2D $= Just toName
|
||||
--glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
|
||||
glTextureStorage2D to 1 inFormat xsize' ysize'
|
||||
glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
||||
glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
||||
--textureFilter Texture2D $= mmfilt
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to 0
|
||||
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
_ -> error $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus
|
||||
return (fboName, toName)
|
||||
return (fboName, TO to)
|
||||
|
||||
minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
||||
minMagFilter = ((Nearest,Nothing),Nearest)
|
||||
|
||||
Reference in New Issue
Block a user