72 lines
2.1 KiB
Haskell
72 lines
2.1 KiB
Haskell
{-# 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)
|
|
|