Tweak fullscreen texture shaders

src/Picture/Preload.hs

@@ -26,6 +26,7 @@ data RenderData = RenderData
     , _backgroundShader         :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader         :: FullShader ()
     , _boxBlurShader            :: FullShader ()
+    , _grayscaleShader          :: FullShader ()
     , _pictureShaders           :: [FullShader RenderType]
     , _spareFBO                 :: FramebufferObject
     , _fboTexture               :: TextureObject
@@ -58,22 +59,29 @@ preloadRender = do
                                 [(0,3),(1,4),(2,3)] Points pokeCharStrat
                   >>= addTexture "data/texture/charMap.png"
 
--- fullscreen shader
-    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
+-- texture shaders, no textures attached
+    fsShad <- makeShader "texture/simple" [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
+    boxBlurShad <- makeShader "texture/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
+    grayscaleShad <- makeShader "texture/grayscale" [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 grayscaleShad) [()] -- fix fullscreen vertex positions now
+
 
 -- background shader
     bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
@@ -107,6 +115,7 @@ preloadRender = do
         , _backgroundShader         = bgShad
         , _fullscreenShader         = fsShad
         , _boxBlurShader            = boxBlurShad
+        , _grayscaleShader          = grayscaleShad
         , _spareFBO                 = fbo
         , _fboTexture               = fboTO
         , _fboRenderbufferObject    = fboRBO
@@ -161,6 +170,11 @@ setupFramebuffer = do
     generateMipmap' Texture2D
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
 
+    fboRBO <- genObjectName
+    bindRenderbuffer Renderbuffer $= fboRBO
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 600 600)
+    framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
+
     fboStatus <- framebufferStatus Framebuffer
     print fboStatus
 

src/Picture/Render.hs

@@ -63,10 +63,10 @@ createLightMap
     -> IO ()
 createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat = do
 
+-- get viewport size so we can reset it later
     (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
@@ -132,54 +132,57 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat =
         uniform (fromJust (_shaderCustomUnis $ _lightingWallShader pdata) !! 2)
             $= Vector2 r lum
         drawShader (_lightingWallShader pdata) nWallLights
-    depthMask $= Enabled
     cullFace $= Nothing
     stencilTest $= Disabled
     blend $= Disabled
 
 -- set the viewport size to that of the window
     viewport $= (vppos, vpsize)
+-- always want to draw lightmap
+    depthFunc $= Just Always
+-- draw the lightmap on a full size fbo
     bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
     colorMask $= Color4 Disabled Disabled Disabled Enabled
     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
+-- interpolation, we get a poor mans blur, not sure about performance
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
--- not sure about the performance implications ^^^
     drawShader (_boxBlurShader pdata) 4
 
+-- ping pong blur between the two buffers as many times as desired
+    replicateM_ 3 $ pingPongBlur pdata
+
+-- draw the lightmap to the screen
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    drawShader (_boxBlurShader pdata) 4
+
+    colorMask $= Color4 Enabled Enabled Enabled Enabled
+    depthMask $= Enabled
+    blend $= Enabled
+
+{- |
+Blur between two framebuffers.
+Assumes no depth testing is done (depthFunc %= Just Always).
+ -}
+pingPongBlur :: RenderData -> IO ()
+pingPongBlur pdata = do
     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