Enable more control of bloom using hdr

shader/texture/bloomBlur.frag

@@ -41,10 +41,8 @@ void main()
     {
         sumFive += vec4(texture(screenTexture, vTexPos + fiveOff[i]));
     }
-    // divinding by 4 is not ideal, because it adds extra alpha
-    // but has more juice than dividing by 5
-    fColor = max(texture(screenTexture,vTexPos), sumFive / 4);   
-    //fColor = sumFive / 4;   
+    //fColor = max(texture(screenTexture,vTexPos), sumFive / 5);   
+    fColor = vec4 ( (sumFive / 5).rgb, max((sumFive/5).a,texture(screenTexture,vTexPos).a) );   
 //    vec4 sampleTex[9];
 //    for(int i=0; i<9; i++)
 //    {

src/Dodge/Particle/Bullet/Spawn.hs

@@ -19,7 +19,7 @@ aGenBulAt maycid pos vel hiteff width = Bul'
     { _ptDraw = drawBul
     , _ptUpdate' = mvGenBullet
     , _btVel' = vel
-    , _btColor' = white
+    , _btColor' = V4 100 100 50 1.5
     , _btTrail' = [pos]
     , _btPassThrough' = maycid
     , _btWidth' = width

src/Dodge/Render.hs

@@ -112,7 +112,7 @@ doDrawing pdata w = do
     textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
     blend $= Disabled
     drawShader (_bloomBlurShader pdata) 4
-    replicateM_ 3 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
+    replicateM_ 2 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
     blend $= Enabled
     viewport $= (Position 0 0
         , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))

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

src/Preload/Render.hs

@@ -101,15 +101,15 @@ preloadRender = do
     rboLightingName <- genObjectName
     bindRenderbuffer Renderbuffer $= rboLightingName
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
-    fboLightingName <- newFramebufferGivenStencil rboLightingName
+    fboLightingName <- setupFramebufferGivenStencil rboLightingName
 
     rboBaseBloomName <- genObjectName
     bindRenderbuffer Renderbuffer $= rboBaseBloomName
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
 
-    fboBaseName <- newFramebufferGivenStencil rboBaseBloomName
-    fboBloomName <- newFramebufferGivenStencil rboBaseBloomName
-    fboColorName <- newFramebufferGivenStencil rboBaseBloomName
+    fboBaseName  <- setupFramebufferGivenStencil rboBaseBloomName
+    fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName
+    fboColorName <- setupFramebufferGivenStencil rboBaseBloomName
 
     fboFourth1Name <- setupTextureFramebuffer 300 300
     fboFourth2Name <- setupTextureFramebuffer 300 300