267 lines
8.7 KiB
Haskell
267 lines
8.7 KiB
Haskell
{-# LANGUAGE NoMonomorphismRestriction #-}
|
|
|
|
{- | 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 Dodge.Data.Config
|
|
import Dodge.WindowSize
|
|
import Foreign.Marshal.Array
|
|
import Framebuffer.Check
|
|
import GLHelp
|
|
import Geometry.Data
|
|
import Graphics.GL.Core45
|
|
import Shader.Data
|
|
import Unsafe.Coerce
|
|
|
|
sizeFBOs :: Config -> RenderData -> IO RenderData
|
|
sizeFBOs cfig rdata =
|
|
uncurryV (resizeRBO (_rboBaseBloom rdata)) (getWindowSize _gr_world_res cfig)
|
|
>> fboBase
|
|
( resizeFBOTO3'
|
|
(getWindowSize _gr_world_res cfig)
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGB16F -- RGBAF not sure if the alpha is necessary here
|
|
GL_RGB16F -- could possibly recover using depth in a clever way
|
|
-- but probably not, because the projection matrix is
|
|
-- not always on-center
|
|
GL_RGBA8_SNORM
|
|
)
|
|
rdata
|
|
>>= fboCloud
|
|
( resizeFBOTO3
|
|
(getWindowSize _gr_world_res cfig)
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGBA8
|
|
GL_RGBA16F
|
|
GL_RGBA16F
|
|
)
|
|
>>= fboFullscreen
|
|
( resizeFBOTO'
|
|
(getWindowSize (const FullRes) cfig)
|
|
1
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGBA16F
|
|
-- [fboBloom] -- fboPos probably doesn't need the alpha channel
|
|
)
|
|
>>= foldUpdateFBOTO
|
|
_gr_world_res
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGBA8
|
|
[fboLighting]
|
|
>>= fboBloom
|
|
( resizeFBOTO'
|
|
(getWindowSize _gr_world_res cfig)
|
|
5
|
|
GL_LINEAR_MIPMAP_LINEAR
|
|
GL_LINEAR
|
|
GL_RGBA16F
|
|
)
|
|
>>= fboPos
|
|
( resizeFBOTO
|
|
(getWindowSize _gr_world_res cfig)
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGBA16F -- possibly doesn't need the alpha channel...
|
|
)
|
|
>>= fboHalf
|
|
( resizeFBOTO'
|
|
(getWindowSize (const EighthRes) cfig)
|
|
5
|
|
GL_LINEAR_MIPMAP_LINEAR
|
|
GL_LINEAR
|
|
GL_RGBA16F
|
|
)
|
|
-- >>= foldUpdateFBOTO
|
|
-- _gr_downsize_res
|
|
-- GL_LINEAR_MIPMAP_LINEAR
|
|
-- GL_LINEAR
|
|
-- GL_RGBA16F
|
|
-- [fboHalf]
|
|
>>= foldUpdateFBOTO
|
|
(const SixteenthRes)
|
|
GL_LINEAR_MIPMAP_LINEAR
|
|
GL_LINEAR
|
|
GL_RGBA16F
|
|
[fboQuarter]
|
|
>>= fboWindow
|
|
( resizeFBOTO2
|
|
(getWindowSize _gr_world_res cfig)
|
|
GL_NEAREST
|
|
GL_NEAREST
|
|
GL_RGBA8
|
|
GL_RGBA8
|
|
)
|
|
where
|
|
updateFBOTO' f = updateFBOTO (getWindowSize f cfig)
|
|
foldUpdateFBOTO f minfilt magfilt form =
|
|
ffoldM (updateFBOTO' f minfilt magfilt form)
|
|
|
|
ffoldM :: (Foldable t, Monad m) => (a1 -> a2 -> m a1) -> t a2 -> a1 -> m a1
|
|
ffoldM f = flip $ foldM f
|
|
|
|
resizeRBO :: GLuint -> GLsizei -> GLsizei -> IO ()
|
|
resizeRBO rboName = glNamedRenderbufferStorage rboName GL_DEPTH24_STENCIL8
|
|
|
|
updateFBOTO ::
|
|
V2 Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format
|
|
GLenum ->
|
|
RenderData ->
|
|
ALens' RenderData (FBO, TO) ->
|
|
IO RenderData
|
|
updateFBOTO wsize minfilt magfilt form pdata target = do
|
|
newfbo2 <- resizeFBOTO wsize minfilt magfilt form (pdata ^# target)
|
|
return $ storing target newfbo2 pdata
|
|
|
|
resizeFBOTO2 ::
|
|
V2 Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format1
|
|
GLenum ->
|
|
-- | internal color format2
|
|
GLenum ->
|
|
(FBO, (TO, TO)) ->
|
|
IO (FBO, (TO, TO))
|
|
resizeFBOTO2 wsize minfilt magfilt form1 form2 (fbo, (told1, told2)) = do
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
|
|
mglDelete glDeleteTextures $ _unTO told1
|
|
mglDelete glDeleteTextures $ _unTO told2
|
|
to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 wsize 1 minfilt magfilt form1
|
|
to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 wsize 1 minfilt magfilt form2
|
|
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
|
|
glNamedFramebufferDrawBuffers (_unFBO fbo) 2
|
|
checkFBO fbo
|
|
return (fbo, (TO to1, TO to2))
|
|
|
|
resizeFBOTO3 ::
|
|
V2 Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format1
|
|
GLenum ->
|
|
-- | internal color format2
|
|
GLenum ->
|
|
-- | internal color format3
|
|
GLenum ->
|
|
(FBO, (TO, TO, TO)) ->
|
|
IO (FBO, (TO, TO, TO))
|
|
resizeFBOTO3 wsize minfilt magfilt form1 form2 form3 (fbo, (told1, told2, told3)) = do
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
|
|
mglDelete glDeleteTextures $ _unTO told1
|
|
mglDelete glDeleteTextures $ _unTO told2
|
|
mglDelete glDeleteTextures $ _unTO told3
|
|
to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 wsize 1 minfilt magfilt form1
|
|
to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 wsize 1 minfilt magfilt form2
|
|
to3 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT2 wsize 1 minfilt magfilt form3
|
|
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
|
|
glNamedFramebufferDrawBuffers (_unFBO fbo) 3
|
|
checkFBO fbo
|
|
return (fbo, (TO to1, TO to2, TO to3))
|
|
|
|
resizeFBOTO3' ::
|
|
V2 Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format1
|
|
GLenum ->
|
|
-- | internal color format2
|
|
GLenum ->
|
|
-- | internal color format3
|
|
GLenum ->
|
|
(FBO, (TO, TO, TO)) ->
|
|
IO (FBO, (TO, TO, TO))
|
|
resizeFBOTO3' wsize min1 mag1 minfilt magfilt form1 form2 form3 (fbo, (told1, told2, told3)) = do
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
|
|
mglDelete glDeleteTextures $ _unTO told1
|
|
mglDelete glDeleteTextures $ _unTO told2
|
|
mglDelete glDeleteTextures $ _unTO told3
|
|
to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 wsize 1 min1 mag1 form1
|
|
to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 wsize 1 minfilt magfilt form2
|
|
to3 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT2 wsize 1 minfilt magfilt form3
|
|
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
|
|
glNamedFramebufferDrawBuffers (_unFBO fbo) 3
|
|
checkFBO fbo
|
|
return (fbo, (TO to1, TO to2, TO to3))
|
|
|
|
resizeFBOTO ::
|
|
V2 Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format
|
|
GLenum ->
|
|
(FBO, TO) ->
|
|
IO (FBO, TO)
|
|
resizeFBOTO wsize minfilt magfilt form (fbo, oldto) = do
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
|
|
mglDelete glDeleteTextures $ _unTO oldto
|
|
to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 wsize 1 minfilt magfilt form
|
|
checkFBO fbo
|
|
return (fbo, TO to1)
|
|
|
|
resizeFBOTO' ::
|
|
V2 Int ->
|
|
Int ->
|
|
-- | minification filter
|
|
GLenum ->
|
|
-- | magnification filter
|
|
GLenum ->
|
|
-- | internal color format
|
|
GLenum ->
|
|
(FBO, TO) ->
|
|
IO (FBO, TO)
|
|
resizeFBOTO' wsize nlevels minfilt magfilt form (fbo, oldto) = do
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
|
|
mglDelete glDeleteTextures $ _unTO oldto
|
|
to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 wsize nlevels minfilt magfilt form
|
|
checkFBO fbo
|
|
return (fbo, TO to1)
|
|
|
|
initializeTexture2D ::
|
|
FBO ->
|
|
GLenum ->
|
|
V2 Int ->
|
|
Int ->
|
|
GLenum ->
|
|
GLenum ->
|
|
GLenum ->
|
|
IO GLuint
|
|
initializeTexture2D fbo attachpoint (V2 x y) nlevels minfilt magfilt form = do
|
|
let xsize' = fromIntegral x
|
|
ysize' = fromIntegral y
|
|
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
|
|
glTextureStorage2D to1 (fromIntegral nlevels) form xsize' ysize'
|
|
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
|
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
|
glTextureParameteri to1 GL_TEXTURE_WRAP_S (unsafeCoerce GL_CLAMP_TO_EDGE)
|
|
glTextureParameteri to1 GL_TEXTURE_WRAP_T (unsafeCoerce GL_CLAMP_TO_EDGE)
|
|
glNamedFramebufferTexture (_unFBO fbo) attachpoint to1 0
|
|
return to1
|