{-# 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 Graphics.Rendering.OpenGL
import Graphics.GL.Core43
--import Foreign
import Control.Lens
import Control.Monad

sizeFBOs 
    :: Int  -- ^ Scaled width
    -> Int  -- ^ Scaled height
    -> Int  -- ^ Full width
    -> Int  -- ^ Full height
    -> RenderData
    -> 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))
            [fboColor,fboLighting,fboLightingHigh]
    rdata'' <- foldM (updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F) rdata' 
        [fboBloom, fboPos]
    rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' 
        [fbo2, fbo3]
    foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' 
        [fboFourth1,fboFourth2]

resizeRBO
    :: RenderbufferObject
    -> Int
    -> Int
    -> IO ()
resizeRBO rboName xsize ysize = do
    let xsize' = fromIntegral xsize
        ysize' = fromIntegral ysize
    bindRenderbuffer Renderbuffer $= rboName
    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
updateFBOTO
    :: Int
    -> Int
    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
    -> GLenum   -- ^ internal color format
    -> RenderData
    -> ALens' RenderData (FramebufferObject, TextureObject)
    -> IO RenderData
updateFBOTO xsize ysize mmfilt inFormat pdata target = do
    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
    return $ storing target newfbo2 pdata

updateFBOTO2
    :: Int
    -> Int
    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
    -> GLenum   -- ^ internal color format texture1
    -> GLenum   -- ^ internal color format texture2
    -> RenderData
    -> ALens' RenderData (FramebufferObject, (TextureObject,TextureObject))
    -> IO RenderData
updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
    newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
    return $ storing target newfbo2 pdata

resizeFBOTO2
    :: (FramebufferObject , (TextureObject,TextureObject))
    -> Int
    -> Int
    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
    -> GLenum   -- ^ internal color format1
    -> GLenum   -- ^ internal color format2
    -> IO (FramebufferObject, (TextureObject,TextureObject))
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do
    bindFramebuffer Framebuffer $= 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
    framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0
    drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
    fboStatus <- framebufferStatus Framebuffer
    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
    return (fboName, (toName1,toName2))

resizeFBOTO
    :: (FramebufferObject , TextureObject)
    -> Int
    -> Int
    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
    -> GLenum   -- ^ internal color format
    -> IO (FramebufferObject, TextureObject)
resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
    bindFramebuffer Framebuffer $= 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
    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
    fboStatus <- framebufferStatus Framebuffer
    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
    return (fboName, toName)

minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
minMagFilter = ((Nearest,Nothing),Nearest)

linMinMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
linMinMagFilter = ((Linear',Nothing),Linear')