92 lines
3.3 KiB
Haskell
92 lines
3.3 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)
|
|
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 (_rboBaseBloom rdata) xfull yfull
|
|
resizeFBOTO (_fboBase rdata) xfull yfull
|
|
resizeFBOTO (_fboBloom rdata) xfull yfull
|
|
resizeFBOTO (_fboColor 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)
|
|
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)
|
|
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
|
|
|