loop/src/Framebuffer/Update.hs

{-# 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 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
                )
            >>= fboLighting
                ( resizeFBOTO'
                    (getWindowSize _gr_world_res cfig)
                    1
                    GL_NEAREST
                    GL_NEAREST
                    GL_RGBA8
                )
            >>= 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
                )
            >>= fboQuarter
                ( resizeFBOTO'
                    (getWindowSize (const SixteenthRes) cfig)
                    1
                    GL_LINEAR_MIPMAP_LINEAR
                    GL_LINEAR
                    GL_RGBA16F
                )
            >>= fboWindow
                ( resizeFBOTO2
                    (getWindowSize _gr_world_res cfig)
                    GL_NEAREST
                    GL_NEAREST
                    GL_RGBA8
                    GL_RGBA8
                )

resizeRBO :: GLuint -> GLsizei -> GLsizei -> IO ()
resizeRBO rboName = glNamedRenderbufferStorage rboName GL_DEPTH24_STENCIL8

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