Cleanup
This commit is contained in:
+137
-121
@@ -1,176 +1,177 @@
|
||||
{-# LANGUAGE NoMonomorphismRestriction #-}
|
||||
{-| Concerns resizing framebuffers on the fly.
|
||||
- Seems to need to be called at least once.
|
||||
-}
|
||||
module Framebuffer.Update
|
||||
( sizeFBOs
|
||||
)
|
||||
where
|
||||
import Data.Preload.Render
|
||||
import GLHelp
|
||||
import Unsafe.Coerce
|
||||
import Foreign.Marshal.Array
|
||||
|
||||
import Graphics.Rendering.OpenGL
|
||||
import Graphics.GL.Core45
|
||||
--import Foreign
|
||||
{- | Concerns resizing framebuffers on the fly.
|
||||
- Seems to need to be called at least once.
|
||||
-}
|
||||
module Framebuffer.Update (
|
||||
sizeFBOs,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Data.Preload.Render
|
||||
import Foreign.Marshal.Array
|
||||
import GLHelp
|
||||
import Graphics.GL.Core45
|
||||
import Unsafe.Coerce
|
||||
|
||||
sizeFBOs
|
||||
:: Int -- ^ Scaled width
|
||||
-> Int -- ^ Scaled height
|
||||
-> Int -- ^ Full width
|
||||
-> Int -- ^ Full height
|
||||
-> RenderData
|
||||
-> IO RenderData
|
||||
sizeFBOs ::
|
||||
-- | Scaled width
|
||||
Int ->
|
||||
-- | Scaled height
|
||||
Int ->
|
||||
-- | Full width
|
||||
Int ->
|
||||
-- | Full height
|
||||
Int ->
|
||||
RenderData ->
|
||||
IO RenderData
|
||||
sizeFBOs xsize ysize xfull yfull rdata = do
|
||||
resizeRBO (_rboBaseBloom rdata) xsize ysize
|
||||
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 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'
|
||||
[fboBloom, fboPos]
|
||||
rdata''' <- foldM (updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8) rdata''
|
||||
[fbo2, fbo3]
|
||||
rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'''
|
||||
[fboHalf1,fboHalf2,fboHalf3]
|
||||
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 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F)
|
||||
rdata'
|
||||
[fboBloom, fboPos]
|
||||
rdata''' <-
|
||||
foldM
|
||||
(updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8)
|
||||
rdata''
|
||||
[fbo2, fbo3]
|
||||
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
|
||||
-- return rdata4
|
||||
|
||||
resizeRBO
|
||||
:: GLuint -- RenderbufferObject
|
||||
-> Int
|
||||
-> Int
|
||||
-> IO ()
|
||||
resizeRBO ::
|
||||
GLuint -> -- RenderbufferObject
|
||||
Int ->
|
||||
Int ->
|
||||
IO ()
|
||||
resizeRBO rboName xsize ysize = do
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
glNamedRenderbufferStorage
|
||||
glNamedRenderbufferStorage
|
||||
rboName
|
||||
GL_DEPTH24_STENCIL8
|
||||
xsize'
|
||||
ysize'
|
||||
updateFBOTO
|
||||
:: Int
|
||||
-> Int
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format
|
||||
-> RenderData
|
||||
-> ALens' RenderData (FBO, TO)
|
||||
-> IO RenderData
|
||||
|
||||
updateFBOTO ::
|
||||
Int ->
|
||||
Int ->
|
||||
-- | minification filter
|
||||
GLenum ->
|
||||
-- | magnification filter
|
||||
GLenum ->
|
||||
-- | internal color format
|
||||
GLenum ->
|
||||
RenderData ->
|
||||
ALens' RenderData (FBO, TO) ->
|
||||
IO RenderData
|
||||
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
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format texture1
|
||||
-> GLenum -- ^ internal color format texture2
|
||||
-> RenderData
|
||||
-> ALens' RenderData (FBO, (TO,TO))
|
||||
-> IO RenderData
|
||||
updateFBOTO2 ::
|
||||
Int ->
|
||||
Int ->
|
||||
-- | minification filter
|
||||
GLenum ->
|
||||
-- | magnification filter
|
||||
GLenum ->
|
||||
-- | internal color format texture1
|
||||
GLenum ->
|
||||
-- | internal color format texture2
|
||||
GLenum ->
|
||||
RenderData ->
|
||||
ALens' RenderData (FBO, (TO, TO)) ->
|
||||
IO RenderData
|
||||
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, (TO,TO))
|
||||
-> Int -> Int -> IO (FBO, (TO,TO))
|
||||
resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
|
||||
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)
|
||||
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,(TO to1,TO to2))
|
||||
checkFBO fboname
|
||||
return (fboname, (TO to1, TO to2))
|
||||
|
||||
-- this currently has one mipmap level?
|
||||
resizeFBOTO2
|
||||
:: (FBO , (TO,TO))
|
||||
-> Int
|
||||
-> Int
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format1
|
||||
-> GLenum -- ^ internal color format2
|
||||
-> IO (FBO, (TO,TO))
|
||||
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
|
||||
--bindFramebuffer Framebuffer $= fboName
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
|
||||
resizeFBOTO2 ::
|
||||
(FBO, (TO, TO)) ->
|
||||
Int ->
|
||||
Int ->
|
||||
-- | minification filter
|
||||
GLenum ->
|
||||
-- | magnification filter
|
||||
GLenum ->
|
||||
-- | internal color format1
|
||||
GLenum ->
|
||||
-- | internal color format2
|
||||
GLenum ->
|
||||
IO (FBO, (TO, TO))
|
||||
resizeFBOTO2 (fboname, (toOld1, toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
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
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 to1 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 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, (TO to1,TO to2))
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT1 to2 0
|
||||
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $ \ptr ->
|
||||
glNamedFramebufferDrawBuffers (_unFBO fboname) 2 ptr
|
||||
checkFBO fboname
|
||||
return (fboname, (TO to1, TO to2))
|
||||
|
||||
resizeFBOTO
|
||||
:: (FBO , TO)
|
||||
-> Int
|
||||
-> Int
|
||||
-> GLenum -- ^ minification filter
|
||||
-> GLenum -- ^ magnification filter
|
||||
-> GLenum -- ^ internal color format
|
||||
-> IO (FBO, TO)
|
||||
resizeFBOTO (fboName,oldto) xsize ysize minfilt magfilt inFormat = do
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
|
||||
resizeFBOTO ::
|
||||
(FBO, TO) ->
|
||||
Int ->
|
||||
Int ->
|
||||
-- | minification filter
|
||||
GLenum ->
|
||||
-- | magnification filter
|
||||
GLenum ->
|
||||
-- | internal color format
|
||||
GLenum ->
|
||||
IO (FBO, TO)
|
||||
resizeFBOTO (fboname, oldto) xsize ysize minfilt magfilt inFormat = do
|
||||
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
|
||||
let xsize' = fromIntegral xsize
|
||||
ysize' = fromIntegral ysize
|
||||
mglDelete glDeleteTextures $ _unTO oldto
|
||||
@@ -178,9 +179,24 @@ resizeFBOTO (fboName,oldto) xsize ysize minfilt magfilt inFormat = do
|
||||
glTextureStorage2D to1 1 inFormat xsize' ysize'
|
||||
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
||||
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
||||
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to1 0
|
||||
fboStatus <- framebufferStatus Framebuffer
|
||||
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 to1 0
|
||||
checkFBO fboname
|
||||
return (fboname, TO to1)
|
||||
|
||||
initializeTexture2D :: Int -> Int -> GLenum -> GLenum -> GLenum -> IO GLuint
|
||||
initializeTexture2D x y minfilt magfilt informat = do
|
||||
let xsize' = fromIntegral x
|
||||
ysize' = fromIntegral y
|
||||
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
||||
glTextureStorage2D to1 1 informat xsize' ysize'
|
||||
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
||||
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
||||
return to1
|
||||
|
||||
|
||||
checkFBO :: FBO -> IO ()
|
||||
checkFBO fbo = do
|
||||
fboStatus <- glCheckNamedFramebufferStatus (_unFBO fbo) GL_FRAMEBUFFER
|
||||
case fboStatus of
|
||||
Complete -> return ()
|
||||
36053 -> return ()
|
||||
_ -> error $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus
|
||||
return (fboName, TO to1)
|
||||
|
||||
Reference in New Issue
Block a user