Enable more control of bloom using hdr

src/Framebuffer/Setup.hs

@@ -1,6 +1,8 @@
+{- | For initialising framebuffers.
+ -}
 module Framebuffer.Setup
     ( setupTextureFramebuffer
-    , newFramebufferGivenStencil
+    , setupFramebufferGivenStencil
     ) where
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
@@ -23,11 +25,11 @@ setupTextureFramebuffer x y = do
     print fboStatus
     return (fboName, fboTO)
 
-newFramebufferGivenStencil 
+setupFramebufferGivenStencil 
     :: RenderbufferObject 
     -> IO (FramebufferObject, TextureObject)
-{-# INLINE newFramebufferGivenStencil #-}
-newFramebufferGivenStencil rboName = do
+{-# INLINE setupFramebufferGivenStencil #-}
+setupFramebufferGivenStencil rboName = do
     fboName <- genObjectName
     bindFramebuffer Framebuffer $= fboName
     toName <- genObjectName

src/Framebuffer/Update.hs

@@ -24,10 +24,10 @@ sizeFBOs
 sizeFBOs xsize ysize xfull yfull rdata = do
     resizeRBO (_rboBaseBloom rdata) xsize ysize
     resizeRBO (_rboLighting rdata)  xsize ysize
-    rdata' <- foldM (updateFBOTO xsize ysize minMagFilter) rdata [fboBase, fboColor,fboLighting]
-    rdata'' <- updateFBOTO xsize ysize minMagFilter rdata' fboBloom
-    rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter) rdata'' [fbo2, fbo3]
-    foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter) rdata''' [fboFourth1,fboFourth2]
+    rdata' <- foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8) rdata [fboBase, fboColor,fboLighting]
+    rdata'' <- updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F rdata' fboBloom
+    rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' [fbo2, fbo3]
+    foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' [fboFourth1,fboFourth2]
 
 resizeRBO
     :: RenderbufferObject
@@ -44,11 +44,12 @@ updateFBOTO
     :: Int
     -> Int
     -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
+    -> GLenum
     -> RenderData
     -> ALens' RenderData (FramebufferObject, TextureObject)
     -> IO (RenderData)
-updateFBOTO xsize ysize mmfilt pdata target = do
-    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt
+updateFBOTO xsize ysize mmfilt inFormat pdata target = do
+    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
     return $ storing target newfbo2 pdata
 
 resizeFBOTO
@@ -56,15 +57,16 @@ resizeFBOTO
     -> Int
     -> Int
     -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
+    -> GLenum
     -> IO (FramebufferObject, TextureObject)
-resizeFBOTO (fboName,toOld) xsize ysize mmfilt = do
+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 GL_RGBA8 xsize' ysize'
+    glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
     textureFilter Texture2D $= mmfilt
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
     fboStatus <- framebufferStatus Framebuffer