Downsample when blurring bloom

src/Framebuffer/Update.hs

@@ -23,10 +23,11 @@ sizeFBOs
     -> IO (RenderData)
 sizeFBOs xsize ysize xfull yfull rdata = do
     resizeRBO (_rboBaseBloom rdata) xsize ysize
-    resizeRBO (_rboLighting rdata)   xsize ysize
-    rdata' <- foldM (updateFBOTO xsize ysize) rdata [fboBase, fboBloom, fboColor,fboFourth1,fboFourth2]
-    rdata'' <- foldM (updateFBOTO xfull yfull) rdata' [fbo2, fbo3]
-    updateFBOTO xsize ysize rdata'' fboLighting
+    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]
 
 resizeRBO
     :: RenderbufferObject
@@ -42,19 +43,21 @@ resizeRBO rboName xsize ysize = do
 updateFBOTO
     :: Int
     -> Int
+    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
     -> RenderData
     -> ALens' RenderData (FramebufferObject, TextureObject)
     -> IO (RenderData)
-updateFBOTO xsize ysize pdata target = do
-    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize
+updateFBOTO xsize ysize mmfilt pdata target = do
+    newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt
     return $ storing target newfbo2 pdata
 
 resizeFBOTO
     :: (FramebufferObject , TextureObject)
     -> Int
     -> Int
+    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
     -> IO (FramebufferObject, TextureObject)
-resizeFBOTO (fboName,toOld) xsize ysize = do
+resizeFBOTO (fboName,toOld) xsize ysize mmfilt = do
     bindFramebuffer Framebuffer $= fboName
     let xsize' = fromIntegral xsize
         ysize' = fromIntegral ysize
@@ -62,7 +65,7 @@ resizeFBOTO (fboName,toOld) xsize ysize = do
     toName <- genObjectName
     textureBinding Texture2D $= Just toName
     glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 xsize' ysize'
-    textureFilter Texture2D $= minMagFilter
+    textureFilter Texture2D $= mmfilt
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
     fboStatus <- framebufferStatus Framebuffer
     putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
@@ -71,3 +74,5 @@ resizeFBOTO (fboName,toOld) xsize ysize = do
 minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
 minMagFilter = ((Nearest,Nothing),Nearest)
 
+linMinMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
+linMinMagFilter = ((Linear',Nothing),Linear')