Files
loop/src/Preload/Update.hs
T
2021-07-05 00:06:04 +02:00

99 lines
3.7 KiB
Haskell

module Preload.Update
( resizeSpareFBO
)
where
import Data.Preload
import Data.Preload.Render
import Graphics.Rendering.OpenGL
import Foreign
resizeSpareFBO
:: Int -- ^ Lightmap width
-> Int -- ^ Lightmap height
-> Int -- ^ Full width
-> Int -- ^ Full height
-> PreloadData a
-> IO (PreloadData a)
resizeSpareFBO xsize ysize xfull yfull pdata = do
-- I am unsure how much of this needs to be bound...
let rdata = _renderData pdata
fboName = _spareFBO rdata
fboTO = _fboTexture rdata
fboRBO = _fboRenderbufferObject rdata
xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
bindFramebuffer Framebuffer $= fboName
textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
generateMipmap' Texture2D
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
bindRenderbuffer Renderbuffer $= fboRBO
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
fboStatus <- framebufferStatus Framebuffer
putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
resizeTextureFBO (_fbo2 rdata) xfull yfull
resizeTextureFBO (_fbo3 rdata) xfull yfull
resizeRBO (snd $ _fbos rdata) xfull yfull
mapM_ (\p -> resizeFBOTO p xfull yfull) (fst $ _fbos rdata)
resizeRBO (_rboBaseBloom rdata) xfull yfull
resizeFBOTO (_fboBase rdata) xfull yfull
resizeFBOTO (_fboBloom rdata) xfull yfull
resizeRBO (_rboLighting rdata) xsize ysize
resizeFBOTO (_fboLighting rdata) xsize ysize
return pdata
resizeTextureFBO
:: (FramebufferObject , TextureObject, RenderbufferObject)
-> Int
-> Int
-> IO ()
resizeTextureFBO (fboName,fboTO,fboRBO) xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
bindFramebuffer Framebuffer $= fboName
textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
generateMipmap' Texture2D
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
bindRenderbuffer Renderbuffer $= fboRBO
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
fboStatus <- framebufferStatus Framebuffer
putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
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')
resizeFBOTO
:: (FramebufferObject , TextureObject)
-> Int
-> Int
-> IO ()
resizeFBOTO (fboName,fboTO) xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
bindFramebuffer Framebuffer $= fboName
textureBinding Texture2D $= Just fboTO
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
generateMipmap' Texture2D
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
fboStatus <- framebufferStatus Framebuffer
putStrLn $ "after resize, framebuffer status:" ++ show fboStatus