Simplify ceiling oclusions

src/Dodge/Render.hs

@@ -48,13 +48,9 @@ doDrawing' win pdata u = do
     checkGLError "during drawing"
     let w = _uvWorld u
         cfig = _uvConfig u
-        rot = w ^. wCam . camRot
-        camzoom = w ^. wCam . camZoom
-        trans = w ^. wCam . camCenter
-        wins = V2 (windowXFloat cfig) (windowYFloat cfig)
         (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
         lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld)
-        viewFroms@(V2 vfx vfy) = w ^. wCam . camViewFrom
+        --(V2 vfx vfy) = w ^. wCam . camViewFrom
         shadV = _pictureShaders pdata
         nFls = w ^. cWorld . numberFloorVerxs
         nchs = w ^. cWorld . numberChasmVerxs
@@ -98,7 +94,6 @@ doDrawing' win pdata u = do
             (pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
             (nCloudVs', nCloudIs')
             (V.fromList $ w ^. cWorld . lWorld . dusts)
-
     -- bind wall points, silhouette data, surface geometry
     bufferShaderLayers shadV pokeCounts
     mapM_
@@ -115,8 +110,7 @@ doDrawing' win pdata u = do
         , (_silhouetteEBO pdata, nSilIndices)
         ]
     -- set the coordinate uniform ready for drawing elements using world coordinates
-    withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $
-        glNamedBufferSubData (pdata ^. matUBO) 0 64
+    bufferPerspectiveMatrixUBO cfig (w ^. wCam) (pdata ^. matUBO)
     setViewport _graphics_world_resolution cfig
     glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
     glDepthMask GL_TRUE
@@ -131,27 +125,29 @@ doDrawing' win pdata u = do
             1 
             0
     -- draw wall occlusions from the camera's point of view
-    glDisable GL_CULL_FACE
-    glEnable GL_STENCIL_TEST
     glStencilFunc GL_NOTEQUAL 128 255
     glStencilOp GL_KEEP GL_KEEP GL_REPLACE
+    glEnable GL_CULL_FACE
+    glCullFace GL_BACK
     unless (debugOn Remove_LOS cfig) $ do
         glUseProgram (pdata ^. ceilingStencilShader . shaderUINT)
-        glProgramUniform3f
-            (pdata ^. ceilingStencilShader . shaderUINT)
-            0
-            vfx
-            vfy
-            20
-        glProgramUniform1f
-            (pdata ^. ceilingStencilShader . shaderUINT)
-            1
-            1000 -- this should be the furthest on screen distance from the viewpoint
+--        glProgramUniform3f
+--            (pdata ^. ceilingStencilShader . shaderUINT)
+--            0
+--            vfx
+--            vfy
+--            20
+--        glProgramUniform1f
+--            (pdata ^. ceilingStencilShader . shaderUINT)
+--            1
+--            1000 -- this should be the furthest on screen distance from the viewpoint
         glBindVertexArray $ pdata ^. ceilingStencilShader . shaderVAO . vaoName
+        glEnable GL_DEPTH_CLAMP
         glDrawArrays
             (_unPrimitiveMode $ pdata ^. ceilingStencilShader . shaderPrimitive)
             0
             (fromIntegral trueNWalls)
+        glDisable GL_DEPTH_CLAMP
     glStencilMask 127 -- to alter last seven bits
     glStencilOp GL_KEEP GL_KEEP GL_KEEP
     -- clear color and normals
@@ -162,7 +158,6 @@ doDrawing' win pdata u = do
     withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
         glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
     --draw walls onto base buffer
-    -- maybe cull faces? maybe do this before?
     glEnable GL_CULL_FACE
     glCullFace GL_BACK
     glUseProgram (pdata ^. wallShader . shaderUINT)
@@ -185,7 +180,7 @@ doDrawing' win pdata u = do
     glBindVertexArray $ pdata ^. chasmShader . shaderVAO . vaoName
     glDepthMask GL_FALSE
     glDrawBuffer GL_NONE
-    glStencilOp GL_INCR GL_INCR GL_INCR
+    glStencilOp GL_KEEP GL_KEEP GL_INCR
     with 0 $
         glClearNamedFramebufferiv
             (pdata ^. fboBase . _1 . unFBO)
@@ -206,11 +201,9 @@ doDrawing' win pdata u = do
         (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
         0
         (fromIntegral nFls)
-    glDisable GL_STENCIL_TEST
+    --glDisable GL_STENCIL_TEST
     glDisable GL_CULL_FACE
     glEnable GL_BLEND
-    -- reset stencil to not draw on ceilings
-    glStencilFunc GL_NOTEQUAL 128 255
     --draw lightmap into its own buffer
     createLightMap
         cfig
@@ -232,16 +225,11 @@ doDrawing' win pdata u = do
     glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
     drawShader (_fullscreenShader pdata) 4
     with GL_COLOR_ATTACHMENT0 $
-        glInvalidateNamedFramebufferData
-            (pdata ^. fboLighting . _1 . unFBO)
-            1
+        glInvalidateNamedFramebufferData (pdata ^. fboLighting . _1 . unFBO) 1
     --draw bloom onto bloom buffer
     glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
     withArray [0, 0, 0, 0] $
-        glClearNamedFramebufferfv
-            (pdata ^. fboBloom . _1 . unFBO)
-            GL_COLOR
-            0
+        glClearNamedFramebufferfv (pdata ^. fboBloom . _1 . unFBO) GL_COLOR 0
     glDepthFunc GL_LESS
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     glDepthMask GL_FALSE
@@ -251,7 +239,10 @@ doDrawing' win pdata u = do
     -- draw clouds to block bloom particles, transparency blocks some alpha
     glDepthMask GL_FALSE
     glBlendColor 0 0 0 0.1 -- using this and GL_CONSTANT_ALPHA below
-    -- can allow for some underlighting of the clouds
+    -- can allow for some bloom to bleed through underneath the clouds
+    -- note that BloomNoZWrite will always be under the clouds, this should be
+    -- rethought, either do another pass and write just the depth or even remove
+    -- the layer entirely
     glBlendFuncSeparate GL_ZERO GL_ONE GL_CONSTANT_ALPHA GL_ONE_MINUS_SRC_ALPHA
     glUseProgram (pdata ^. cloudShader . shaderUINT)
     glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
@@ -271,7 +262,8 @@ doDrawing' win pdata u = do
     glDisable GL_BLEND
     drawShader (_bloomBlurShader pdata) 4
     when (cfig ^. graphics_bloom) $ do
-        replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
+        replicateM_ 2 $ pingPongBetween 
+            (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
         glEnable GL_BLEND
     setViewport _graphics_world_resolution cfig
     --draw clouds onto cloud buffer
@@ -282,12 +274,11 @@ doDrawing' win pdata u = do
     --withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
     withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
         glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
-    withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
+    withArray [0.5, 0.5, 0.5, 0] $
         glClearNamedFramebufferfv
             (pdata ^. fboCloud . _1 . unFBO)
             GL_COLOR
             0
-            ptr
     glUseProgram (pdata ^. cloudShader . shaderUINT)
     glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
     glDrawElements
@@ -307,20 +298,11 @@ doDrawing' win pdata u = do
         glDepthFunc GL_ALWAYS
         glDisable GL_BLEND
         withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
-            -- \ptr -> glDrawBuffers 3 ptr
             glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 3
-        withArray [0, 0, 0, 0] $ \ptr ->
-            glClearNamedFramebufferfv
-                (pdata ^. fboCloud . _1 . unFBO)
-                GL_COLOR
-                1
-                ptr
-        withArray [0, 0, 0, 0] $ \ptr ->
-            glClearNamedFramebufferfv
-                (pdata ^. fboCloud . _1 . unFBO)
-                GL_COLOR
-                2
-                ptr
+        withArray [0, 0, 0, 0] $
+            glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 1
+        withArray [0, 0, 0, 0] $
+            glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 2
         glEnable GL_BLEND
         -- we sum the positions weighted by alpha, and sum the alpha
         glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
@@ -430,13 +412,19 @@ doDrawing' win pdata u = do
     renderLayer DebugLayer shadV pokeCounts
     glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
     withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
-        \ptr -> glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
+        glNamedBufferSubData (pdata ^. matUBO) 0 64
     glDepthFunc GL_GEQUAL
     glDepthMask GL_TRUE
-    with (-1) $ \ptr -> glClearNamedFramebufferfv 0 GL_DEPTH 0 ptr
+    with (-1) $ glClearNamedFramebufferfv 0 GL_DEPTH 0
     renderLayer FixedCoordLayer shadV pokeCounts
     SDL.glSwapWindow win
 
+bufferPerspectiveMatrixUBO :: Config -> Camera -> GLuint -> IO ()
+bufferPerspectiveMatrixUBO cfig cam uboid = withArray
+    (perspectiveMatrixb (cam ^. camRot) (cam ^. camZoom) (cam ^. camCenter)
+        (V2 (windowXFloat cfig) (windowYFloat cfig)) (cam ^. camViewFrom))
+      $ glNamedBufferSubData uboid 0 64
+
 getDistortions :: Config -> World -> [Distortion]
 getDistortions cfig w
     | cfig ^. graphics_distortions = w ^. cWorld . lWorld . distortions

src/MatrixHelper.hs

@@ -1,92 +1,108 @@
-module MatrixHelper
-    ( perspectiveMatrixb
-    , isoMatrix
-    , scaleMatrix
-    ) where
+module MatrixHelper (
+    perspectiveMatrixb,
+    isoMatrix,
+    scaleMatrix,
+) where
+
 import Geometry.Data
-
-import Linear.Matrix
 import Graphics.GL.Core45
+import Linear.Matrix
 
-perspectiveMatrixb 
-    :: Float        -- ^ Rotation
-    -> Float        -- ^ Zoom
-    -> Point2       -- ^ Translation
-    -> Point2       -- ^ Window size
-    -> Point2       -- ^ View froms
-    -> [GLfloat]
+perspectiveMatrixb ::
+    -- | Rotation
+    Float ->
+    -- | Zoom
+    Float ->
+    -- | Translation
+    Point2 ->
+    -- | Window size
+    Point2 ->
+    -- | View froms
+    Point2 ->
+    [GLfloat]
 perspectiveMatrixb rot zoom (V2 tranx trany) (V2 winx winy) (V2 viewFromx viewFromy) =
-    concatMap vToL 
-    . vToL
-    . lmt 
-    $ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
-        !*! rotMatr (-rot)
-        !*! transMat (V2 (viewFromx-tranx) (viewFromy-trany))
-        !*! perMat 0.4
-        !*! transMat (V2 (-viewFromx) (-viewFromy))
-        !*! vertScale (negate 0.005)
-        !*! vertTrans 20
+    concatMap vToL
+        . vToL
+        . lmt
+        $ scaleMat (V2 (2 * zoom / winx) (2 * zoom / winy))
+            !*! rotMatr (- rot)
+            !*! transMat (V2 (viewFromx - tranx) (viewFromy - trany))
+            !*! perMat 0.4
+            !*! transMat (V2 (- viewFromx) (- viewFromy))
+            !*! vertScale (negate 0.005)
+            !*! vertTrans 20
 
-isoMatrix 
-    :: Float        -- ^ Rotation
-    -> Float        -- ^ Zoom
-    -> Point2       -- ^ Translation
-    -> Point2       -- ^ Window size
-    -> [GLfloat]
-isoMatrix rot zoom (V2 tranx trany) (V2 winx winy) = concatMap vToL 
-    . vToL 
-    . lmt 
-    $ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
-        !*! rotMatr (-rot)
-        !*! transMat (V2 (-tranx) (-trany))
+isoMatrix ::
+    -- | Rotation
+    Float ->
+    -- | Zoom
+    Float ->
+    -- | Translation
+    Point2 ->
+    -- | Window size
+    Point2 ->
+    [GLfloat]
+isoMatrix rot zoom (V2 tranx trany) (V2 winx winy) =
+    concatMap vToL
+        . vToL
+        . lmt
+        $ scaleMat (V2 (2 * zoom / winx) (2 * zoom / winy))
+            !*! rotMatr (- rot)
+            !*! transMat (V2 (- tranx) (- trany))
 
 lmt :: V4 (V4 a) -> V4 (V4 a)
 lmt = Linear.Matrix.transpose
 
 vToL :: V4 a -> [a]
-vToL (V4 a b c d) = [a,b,c,d]
+vToL (V4 a b c d) = [a, b, c, d]
 
 perMat :: Float -> V4 (V4 Float)
-perMat x = V4 
-    (V4 1 0 0 0)
-    (V4 0 1 0 0)
-    (V4 0 0 1 0)
-    (V4 0 0 x 1)
+perMat x =
+    V4
+        (V4 1 0 0 0)
+        (V4 0 1 0 0)
+        (V4 0 0 1 0)
+        (V4 0 0 x 1)
 
 scaleMatrix :: Float -> Float -> [V4 Float]
 scaleMatrix x = vToL . scaleMat . V2 x
 
 scaleMat :: Point2 -> V4 (V4 Float)
-scaleMat (V2 x y) = V4
-    (V4 x 0 0 0)
-    (V4 0 y 0 0)
-    (V4 0 0 1 0) 
-    (V4 0 0 0 1)
+scaleMat (V2 x y) =
+    V4
+        (V4 x 0 0 0)
+        (V4 0 y 0 0)
+        (V4 0 0 1 0)
+        (V4 0 0 0 1)
 
 rotMatr :: Float -> V4 (V4 Float)
-rotMatr a = V4
-    (V4 (cos a) (sin (-a)) 0 0)
-    (V4 (sin a) (cos a)    0 0)
-    (V4 0       0          1 0)
-    (V4 0       0          0 1)
+rotMatr a =
+    V4
+        (V4 (cos a) (sin (- a)) 0 0)
+        (V4 (sin a) (cos a) 0 0)
+        (V4 0 0 1 0)
+        (V4 0 0 0 1)
 
 transMat :: Point2 -> V4 (V4 Float)
-transMat (V2 x y) = V4 
-    (V4 1 0 0 x)
-    (V4 0 1 0 y)
-    (V4 0 0 1 0)
-    (V4 0 0 0 1)
+transMat (V2 x y) =
+    V4
+        (V4 1 0 0 x)
+        (V4 0 1 0 y)
+        (V4 0 0 1 0)
+        (V4 0 0 0 1)
 
 vertScale :: Float -> V4 (V4 Float)
-vertScale s = V4
-    (V4 1 0 0 0)
-    (V4 0 1 0 0)
-    (V4 0 0 s 0)
-    (V4 0 0 0 1)
+vertScale s =
+    V4
+        (V4 1 0 0 0)
+        (V4 0 1 0 0)
+        (V4 0 0 s 0)
+        (V4 0 0 0 1)
 
 vertTrans :: Float -> V4 (V4 Float)
-vertTrans z = V4
-    (V4 1 0 0 0)
-    (V4 0 1 0 0)
-    (V4 0 0 1 (negate z))
-    (V4 0 0 0 1)
+vertTrans z =
+    V4
+        (V4 1 0 0 0)
+        (V4 0 1 0 0)
+        (V4 0 0 1 (negate z))
+        (V4 0 0 0 1)

src/Preload/Render.hs

@@ -5,8 +5,6 @@ module Preload.Render (
     cleanUpRenderPreload,
 ) where
 
-import Shape.Parameters
-import Shader.Parameters
 import Control.Concurrent
 import Control.Lens
 import Control.Monad
@@ -19,6 +17,8 @@ import Graphics.GL.Core45
 import Shader.AuxAddition
 import Shader.Compile
 import Shader.Data
+import Shader.Parameters
+import Shape.Parameters
 
 {- BINDING LIST:
 0   base
@@ -49,9 +49,13 @@ preloadRender = do
     shEBO <- setupEBO shPosVAO
     -- note the shape shader vao is distinct from the position vao, but they
     -- share an EBO
-    shapeshader <- makeShaderUsingVBO "shape/basic" [vert, frag] 
-        shapeVerxAttributes
-        pmTriangles shVBO
+    shapeshader <-
+        makeShaderUsingVBO
+            "shape/basic"
+            [vert, frag]
+            shapeVerxAttributes
+            pmTriangles
+            shVBO
     glVertexArrayElementBuffer (shapeshader ^. shaderVAO . vaoName) (shEBO ^. eboName)
 
     --setup silhouette edge VAO
@@ -63,8 +67,13 @@ preloadRender = do
     let wallverxstrd = 8
     wallvbo <- setupVBO (floatSize * wallverxstrd)
     winvbo <- setupVBO (floatSize * 8)
-    windowshader <- makeShaderUsingVBO 
-        "wall/window" [vert, geom, frag] (toFloatVAs [4, 4]) pmPoints winvbo
+    windowshader <-
+        makeShaderUsingVBO
+            "wall/window"
+            [vert, geom, frag]
+            (toFloatVAs [4, 4])
+            pmPoints
+            winvbo
     wallshader <- makeShaderUsingVBO "wall/basic" [vert, geom, frag] (toFloatVAs [4, 4]) pmPoints wallvbo
     putStrLn "Setup lighting shaders"
     lightingWallShadShad <-
@@ -100,7 +109,7 @@ preloadRender = do
     --initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_NEAREST GL_LINEAR
 
     putStrLn "Setup full screen shaders"
-    (_,screentexturevao) <- setupStaticVBOVAO (toFloatVAs [2,2]) (concat cornerList)
+    (_, screentexturevao) <- setupStaticVBOVAO (toFloatVAs [2, 2]) (concat cornerList)
     alphadivideshader <- makeShaderUsingVAO "texture2D/alphaDivide" [vert, frag] pmTriangleStrip screentexturevao
     fsShad <- makeShaderUsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao
     bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao
@@ -120,10 +129,14 @@ preloadRender = do
     putStrLn "Setup chasm VBO, shader"
     let chasmverxstrd = 3
     chasmvbo <- setupVBOStatic (floatSize * chasmverxstrd)
-    chasmshader <- makeShaderUsingVBO "positional/blank" [vert, frag] (toFloatVAs [3]) pmTriangles chasmvbo
-
+    chasmshader <-
+        makeShaderUsingVBO
+            "positional/blank"
+            [vert, frag]
+            (toFloatVAs [3])
+            pmTriangles
+            chasmvbo
     putStrLn "Setup cloud VBO, shader"
-    --let cloudverxsizes = [4, 4, 4, 4]
     let cloudverxsizes = [4, 4, 4]
     cloudvbo <- setupVBO (floatSize * sum cloudverxsizes)
     (cloudshader, cloudebo) <-
@@ -151,7 +164,6 @@ preloadRender = do
     -- reset to default framebuffer, ready for drawing direct to screen
     glBindFramebuffer GL_FRAMEBUFFER 0
 
-
     initializeGLState
     putStrLn "Return preload"
     return $
@@ -177,7 +189,6 @@ preloadRender = do
             , _fboHalf1 = fboHalf1Name
             , _fboHalf2 = fboHalf2Name
             , _fboLighting = fboLightingName
---            , _fboShadow = fboShadowName
             , _fboBase = fboBaseName
             , _fboCloud = fboCloudName
             , _fboBloom = fboBloomName
@@ -221,6 +232,7 @@ cornerList =
 initializeGLState :: IO ()
 initializeGLState = do
     glEnable GL_DEPTH_TEST
+    glEnable GL_STENCIL_TEST
 
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload _ = return ()

src/Render.hs

@@ -98,7 +98,7 @@ renderLightingNoShadows positiontexture normaltexture lightPoints pdata = do
             (fromIntegral (4 :: Int))
     --cleanup: may not be necessary, depending on what comes after...
     glDisable GL_CULL_FACE
-    glDisable GL_STENCIL_TEST
+--    glDisable GL_STENCIL_TEST
 
 
 renderFlatLighting :: RenderData -> IO ()
@@ -155,9 +155,8 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
     flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
         -- note that the stencil shadows rely on the depth buffer
         glDepthFunc GL_LESS
-        -- setup stencil
         glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
-        glStencilMask 127 -- so we only affect the last 7 bits
+        -- setup stencil
         with 0 $
             glClearNamedFramebufferiv
                 (pdata ^. fboLighting . _1 . unFBO)
@@ -206,16 +205,18 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
         glDisable GL_CULL_FACE
         glColorMask GL_TRUE GL_TRUE GL_TRUE GL_FALSE
         glStencilFunc GL_EQUAL 0 255
-        glUseProgram (ltextShad ^. shaderUINT) --Just (_shadProg ltextShad)
+        glUseProgram (ltextShad ^. shaderUINT)
         glUniform3f 0 x y z
         glUniform4f 1 r g b rad
-        glBindVertexArray $ ltextShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO ltextShad)
+        glBindVertexArray $ ltextShad ^. shaderVAO . vaoName
         glDrawArrays
             (_unPrimitiveMode (_shaderPrimitive ltextShad))
             0
             (fromIntegral (4 :: Int))
     --cleanup: may not be necessary, depending on what comes after...
-    glDisable GL_STENCIL_TEST
+--    glDisable GL_STENCIL_TEST
+    glStencilFunc GL_NOTEQUAL 128 255
+    glStencilOp GL_KEEP GL_KEEP GL_KEEP
     glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
 
 -- assumes that vertices have already been sent to the shader