130 lines
4.8 KiB
Haskell
130 lines
4.8 KiB
Haskell
{-# 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'''
|
|
[fboHalf1,fboHalf2,fboHalf3]
|
|
|
|
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
|
|
case fboStatus of
|
|
Complete -> return ()
|
|
_ -> putStrLn $ "after resize, resizeFBOTO2 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
|
|
case fboStatus of
|
|
Complete -> return ()
|
|
_ -> putStrLn $ "after resize, resizeFBOTO 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')
|