{-# LANGUAGE NoMonomorphismRestriction #-}
module Preload.Update
    ( sizeFBOs
    )
where
import Data.Preload
import Data.Preload.Render

import Graphics.Rendering.OpenGL
import Graphics.GL.Core43
--import Foreign
import Control.Lens
import Control.Monad

sizeFBOs 
    :: Int  -- ^ Lightmap width
    -> Int  -- ^ Lightmap height
    -> Int  -- ^ Full width
    -> Int  -- ^ Full height
    -> PreloadData a
    -> IO (PreloadData a)
sizeFBOs xsize ysize xfull yfull pdata = do
    let rdata   = _renderData pdata
    resizeRBO (_rboBaseBloom rdata) xfull yfull
    resizeRBO (_rboLighting rdata)   xsize ysize
    pdata' <- foldM (updateFBOTO xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
    updateFBOTO xsize ysize pdata' fboLighting

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
    -> PreloadData a
    -> ALens' RenderData (FramebufferObject, TextureObject)
    -> IO (PreloadData a)
updateFBOTO xsize ysize pdata target = do
    newfbo2 <- resizeFBOTO (pdata ^# renderData . target) xsize ysize
    return $ storing (renderData . target) newfbo2 pdata

resizeFBOTO
    :: (FramebufferObject , TextureObject)
    -> Int
    -> Int
    -> IO (FramebufferObject, TextureObject)
resizeFBOTO (fboName,toOld) xsize ysize = do
    bindFramebuffer Framebuffer $= fboName
    let xsize' = fromIntegral xsize
        ysize' = fromIntegral ysize
    deleteObjectName toOld
    toName <- genObjectName
    textureBinding Texture2D $= Just toName
    glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 xsize' ysize'
    textureFilter Texture2D $= minMagFilter
    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)