Add blurring of lightmap (and refactoring)

src/Picture/Preload.hs

@@ -25,10 +25,13 @@ data RenderData = RenderData
     , _wallTextureShader        :: FullShader ((Point2,Point2),Point4)
     , _backgroundShader         :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader         :: FullShader ()
+    , _boxBlurShader            :: FullShader ()
     , _pictureShaders           :: [FullShader RenderType]
     , _spareFBO                 :: FramebufferObject
     , _fboTexture               :: TextureObject
     , _fboRenderbufferObject    :: RenderbufferObject
+    , _fbo2                     :: (FramebufferObject, TextureObject)
+    , _fbo3                     :: (FramebufferObject, TextureObject)
     }
 
 makeLenses ''RenderData
@@ -56,14 +59,21 @@ preloadRender = do
                   >>= addTexture "data/texture/charMap.png"
 
 -- fullscreen shader
-    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
-                                (const [[[-1, 1],[0,1]]
-                                       ,[[ 1, 1],[1,1]]
-                                       ,[[-1,-1],[0,0]]
-                                       ,[[ 1,-1],[1,0]]
-                                       ]
-                                 )
-    n <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
+    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
+        [[[-1, 1],[0,1]]
+        ,[[ 1, 1],[1,1]]
+        ,[[-1,-1],[0,0]]
+        ,[[ 1,-1],[1,0]]
+        ]
+    _ <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
+-- box blur shader
+    boxBlurShad <- makeShader "boxBlur" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
+        [[[-1, 1],[0,1]]
+        ,[[ 1, 1],[1,1]]
+        ,[[-1,-1],[0,0]]
+        ,[[ 1,-1],[1,0]]
+        ]
+    _ <- F.foldM (pokeShader boxBlurShad) [()] -- fix fullscreen vertex positions now
 
 -- background shader
     bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
@@ -79,7 +89,10 @@ preloadRender = do
                 >>= addUniforms ["perpMat"]
 
 -- framebuffer for lighting
-    (fbo,fboTO,fboRBO) <- setupFramebuffer
+    (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
+
+    framebuf2 <- setupFramebuffer
+    framebuf3 <- setupFramebuffer
 
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
@@ -93,9 +106,12 @@ preloadRender = do
         , _wallTextureShader        = wlTexture
         , _backgroundShader         = bgShad
         , _fullscreenShader         = fsShad
+        , _boxBlurShader            = boxBlurShad
         , _spareFBO                 = fbo
         , _fboTexture               = fboTO
         , _fboRenderbufferObject    = fboRBO
+        , _fbo2                     = framebuf2
+        , _fbo3                     = framebuf3
         }
 
 -- potential drawing setup
@@ -111,15 +127,14 @@ preloadRender = do
 
 --------------------end preloadRender
 
-setupFramebuffer :: IO (FramebufferObject, TextureObject,RenderbufferObject)
-setupFramebuffer = do
+setupFramebufferWithStencil :: IO (FramebufferObject, TextureObject,RenderbufferObject)
+setupFramebufferWithStencil = do
     fboName <- genObjectName
     bindFramebuffer Framebuffer $= fboName
 
     fboTO <- genObjectName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
-    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
@@ -134,6 +149,23 @@ setupFramebuffer = do
 
     return (fboName, fboTO, fboRBO)
 
+setupFramebuffer :: IO (FramebufferObject, TextureObject)
+setupFramebuffer = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+
+    fboTO <- genObjectName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 600 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+
+    fboStatus <- framebufferStatus Framebuffer
+    print fboStatus
+
+    return (fboName, fboTO)
+
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _pictureShaders pd

src/Picture/Render.hs

@@ -61,13 +61,14 @@ createLightMap
     -> (Float,Float)        -- View from position
     -> GLmatrix GLfloat 
     -> IO ()
-createLightMap pdata resDiv wallPoints lightPoints
-                    (viewFromx,viewFromy) pmat = do
+createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat = do
 
     (vppos,vpsize) <- get viewport
+-- set the viewport size to that of the render buffer
     viewport $= (vppos, divideSize resDiv vpsize)
 
     bindFramebuffer Framebuffer $= _spareFBO pdata
+
 -- store wall and light positions into buffer
     nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) wallPoints
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
@@ -84,7 +85,6 @@ createLightMap pdata resDiv wallPoints lightPoints
     depthFunc $= Just Less
 -- draw walls from your point of view in order to set z buffer
     colorMask $= Color4 Disabled Disabled Disabled Disabled
---    let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
     uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
@@ -136,20 +136,51 @@ createLightMap pdata resDiv wallPoints lightPoints
     cullFace $= Nothing
     stencilTest $= Disabled
     blend $= Disabled
+
+-- set the viewport size to that of the window
     viewport $= (vppos, vpsize)
-    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
     colorMask $= Color4 Disabled Disabled Disabled Enabled
-    bindShaderBuffers [_fullscreenShader pdata] [4]
+    bindShaderBuffers [_boxBlurShader pdata] [4]
+    textureBinding Texture2D $= Just (_fboTexture pdata)
 -- by upscaling the shadowmap texture and using Linear' magnification
 -- interpolation, we get a poor mans blur
-    textureBinding Texture2D $= Just (_fboTexture pdata)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
--- not sure about the perforamnce implications ^^^
     generateMipmap' Texture2D
-    drawShader (_fullscreenShader pdata) 4
+-- not sure about the performance implications ^^^
+    drawShader (_boxBlurShader pdata) 4
+
+    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
+    replicateM_ 2 $ pingPongBlur pdata
+
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     blend $= Enabled
 
+pingPongBlur :: RenderData -> IO ()
+pingPongBlur pdata = do
+    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
+    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
+    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
 renderBackground 
     :: RenderData 
     -> Float            -- Rotation