Tweak fullscreen texture shaders

shader/texture/grayscale.frag

@@ -0,0 +1,12 @@
+#version 430 core
+in vec2 vTexPos;
+out vec4 fColor;
+
+uniform sampler2D screenTexture;
+
+void main()
+{
+    fColor = texture(screenTexture, vTexPos);
+    float av = (fColor.r + fColor.g + fColor.b) / 3.0;
+    fColor = vec4(av,av,av,1.0);
+}

shader/texture/simple.vert

@@ -0,0 +1,10 @@
+#version 430 core
+layout (location = 0) in vec2 pos;
+layout (location = 1) in vec2 texPos;
+out vec2 vTexPos;
+
+void main()
+{
+  gl_Position = vec4(pos,0,1);
+  vTexPos = texPos;
+}

src/Dodge/Creature/Inanimate.hs

@@ -22,7 +22,7 @@ defaultInanimate = defaultCreature & crState . crIsAnimate .~ False
 lamp :: Creature
 lamp = defaultInanimate
     { _crUpdate = initialiseLamp
-    , _crHP = 500
+    , _crHP = 100
     , _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3
     , _crRad = 3
     }

src/Dodge/Render.hs

@@ -76,6 +76,16 @@ doDrawing pdata w = do
     depthMask $= Disabled
     renderBlankWalls pdata windowPoints pmat
     depthMask $= Enabled
+
+---- draw the lightmap to the screen
+--    bindFramebuffer Framebuffer $= defaultFramebufferObject
+--    clear [DepthBuffer]
+--    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+--    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+--    generateMipmap' Texture2D
+--    bindShaderBuffers [_fullscreenShader pdata] [4]
+--    drawShader (_fullscreenShader pdata) 4
+
     resetShaderUniforms (map extractProgAndUnis $ _pictureShaders pdata)
 ----------------------
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)

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 

src/Shader.hs

@@ -120,7 +120,17 @@ addTexture texturePath shad = do
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
     return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
 
-makeShader :: String -> [ShaderType] -> [(GLuint,Int)] -> PrimitiveMode -> (a -> [[[Float]]]) -> IO (FullShader a)
+{- | 
+Compiles a full shader found within the shader directory.
+The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
+-}
+makeShader 
+    :: String       -- ^ First part of the name of the shader
+    -> [ShaderType] -- ^ Filetype extensions
+    -> [(GLuint,Int)]   -- ^ The shaders input vertices (location, size)
+    -> PrimitiveMode
+    -> (a -> [[[Float]]])   -- ^ Poke strategy: method for creating a list of vertex data to be bound
+    -> IO (FullShader a)
 makeShader s shaderlist alocs pm renStrat = do
     (prog,unis)  <- makeSourcedShader s shaderlist
     vao        <- setupVAO alocs
@@ -170,9 +180,9 @@ setupArrayBuffer (aloc,i) = do
     vertexAttribArray (AttribLocation aloc) $= Enabled
     return vbo
 
--- compile shader and get its uniform locations
+-- | Compile shader and get its uniform locations.
 -- supposes the shader code is in the shader folder, with the string names
--- followed by .vert/.geom/.frag
+-- followed by .vert/.geom/.frag.
 makeSourcedShader :: String -> [ShaderType] -> IO (Program, [UniformLocation])
 makeSourcedShader s sts = do
     sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)