{-# LANGUAGE NoMonomorphismRestriction #-}

{- | Concerns resizing framebuffers on the fly.
 - Seems to need to be called at least once.
-}
module Framebuffer.Update (sizeFBOs) where

import Geometry.Data
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 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)
        >>  updateFBOTO3
            (getWindowSize _gr_world_res cfig)
            GL_NEAREST
            GL_NEAREST
            GL_RGBA16F
            GL_RGBA16F -- 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
            fboBase
            >>= flip
                ( 
                    updateFBOTO3
                    (getWindowSize _gr_world_res cfig)
                    GL_NEAREST
                    GL_NEAREST
                    GL_RGBA8
                    GL_RGBA16F
                    GL_RGBA16F
                )
                fboCloud
            >>= foldUpdateFBOTO
                _gr_world_res
                GL_NEAREST
                GL_NEAREST
                GL_RGBA8
                [fboLighting]
            >>= foldUpdateFBOTO
                _gr_world_res
                GL_LINEAR_MIPMAP_LINEAR
                GL_LINEAR
                GL_RGBA16F
                [fboBloom, fboPos]
--            >>= foldUpdateFBOTO
--                _gr_distortion_res
--                GL_LINEAR_MIPMAP_LINEAR
--                GL_LINEAR
--                GL_RGBA8
--                [fbo2]
            >>= foldUpdateFBOTO
                _gr_downsize_res
                GL_LINEAR_MIPMAP_LINEAR
                GL_LINEAR
                GL_RGBA16F
                [fboHalf1, fboHalf2]
            >>= flip
                ( updateFBOTO2
                    (getWindowSize _gr_world_res cfig)
                    GL_NEAREST
                    GL_NEAREST
                    GL_RGBA8
                    GL_RGBA8
                )
                fboWindow
  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 (V2 xsize ysize) minfilt magfilt form pdata target = do
    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize minfilt magfilt form
    return $ storing target newfbo2 pdata

-- note that the ordering of arguments is different to the other update
-- functions... this all needs rethinking
updateFBOTO2 ::
    V2 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 (V2 xsize ysize) minfilt magfilt form1 form2 pdata target = do
    newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt form1 form2
    return $ storing target newfbo2 pdata

updateFBOTO3 ::
    V2 Int ->
    -- | minification filter
    GLenum ->
    -- | magnification filter
    GLenum ->
    -- | internal color format texture1
    GLenum ->
    -- | internal color format texture2
    GLenum ->
    -- | internal color format texture3
    GLenum ->
    RenderData ->
    ALens' RenderData (FBO, (TO, TO, TO)) ->
    IO RenderData
updateFBOTO3 (V2 xsize ysize) minfilt magfilt form1 form2 form3 pdata target = do
    newfbo2 <- resizeFBOTO3 (pdata ^# target) xsize ysize minfilt magfilt form1 form2 form3
    return $ storing target newfbo2 pdata

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 (fbo, (told1, told2)) xsize ysize minfilt magfilt form1 form2 = do
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
    mglDelete glDeleteTextures $ _unTO told1
    mglDelete glDeleteTextures $ _unTO told2
    to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt form1
    to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 xsize ysize minfilt magfilt form2
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
        glNamedFramebufferDrawBuffers (_unFBO fbo) 2
    checkFBO fbo
    return (fbo, (TO to1, TO to2))

resizeFBOTO3 ::
    (FBO, (TO, TO, TO)) ->
    Int ->
    Int ->
    -- | minification filter
    GLenum ->
    -- | magnification filter
    GLenum ->
    -- | internal color format1
    GLenum ->
    -- | internal color format2
    GLenum ->
    -- | internal color format3
    GLenum ->
    IO (FBO, (TO, TO, TO))
resizeFBOTO3 (fbo, (told1, told2, told3)) xsize ysize minfilt magfilt form1 form2 form3 = do
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
    mglDelete glDeleteTextures $ _unTO told1
    mglDelete glDeleteTextures $ _unTO told2
    mglDelete glDeleteTextures $ _unTO told3
    to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt form1
    to2 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT1 xsize ysize minfilt magfilt form2
    to3 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT2 xsize ysize minfilt magfilt form3
    withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr ->
        glNamedFramebufferDrawBuffers (_unFBO fbo) 3 ptr
    checkFBO fbo
    return (fbo, (TO to1, TO to2, TO to3))

resizeFBOTO ::
    (FBO, TO) ->
    Int ->
    Int ->
    -- | minification filter
    GLenum ->
    -- | magnification filter
    GLenum ->
    -- | internal color format
    GLenum ->
    IO (FBO, TO)
resizeFBOTO (fbo, oldto) xsize ysize minfilt magfilt form = do
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO fbo)
    mglDelete glDeleteTextures $ _unTO oldto
    to1 <- initializeTexture2D fbo GL_COLOR_ATTACHMENT0 xsize ysize minfilt magfilt form
    checkFBO fbo
    return (fbo, TO to1)

initializeTexture2D ::
    FBO -> GLenum -> Int -> Int -> GLenum -> GLenum -> GLenum -> IO GLuint
initializeTexture2D fbo attachpoint x y minfilt magfilt form = do
    let xsize' = fromIntegral x
        ysize' = fromIntegral y
    to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
    glTextureStorage2D to1 1 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