Remove unnecessary uniforms

2021-06-10 18:07:26 +02:00
parent 95f8e57e45
commit 02511afa80
10 changed files with 69 additions and 93 deletions
@@ -138,7 +138,7 @@ renderBlankWalls pdata wps pmat = do
    n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps
    bindShaderBuffers [_wallBlankShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
-    uniform (head ( _shaderCustomUnis $ _wallBlankShader pdata) )
+    uniform (( _shaderMatrixUniform $ _wallBlankShader pdata) )
        $= pmat
    cullFace $= Just Back
    drawShader (_wallBlankShader pdata) n
@@ -153,7 +153,7 @@ renderTextureWalls pdata wps pmat = do
    n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps
    bindShaderBuffers [_wallTextureShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
-    uniform (head ( _shaderCustomUnis $ _wallTextureShader pdata) )
+    uniform (( _shaderMatrixUniform $ _wallTextureShader pdata) )
        $= pmat
    cullFace $= Just Back
    drawShader (_wallTextureShader pdata) n
@@ -1,5 +1,6 @@
 module MatrixHelper
    ( perspectiveMatrix
+    , isoMatrix
    ) where
 import Geometry

@@ -25,11 +26,6 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
                (V4 (sin rot) (cos rot)    0 0)
                (V4 0             0        1 0)
                (V4 0             0        0 1)
-        --tranMat3 = Linear.Matrix.transpose $
-        --    V4 (V4 1        0        0 0)
-        --        (V4 0        1        0 0)
-        --        (V4 0        0        1 0)
-        --        (V4 (-tranx) (-trany) 0 1)
        tranMat2 = Linear.Matrix.transpose $
            V4 (V4 1        0        0 0)
                (V4 0        1        0 0)
@@ -48,3 +44,30 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
        wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
        vToL (V4 a b c d) = [a,b,c,d]
    in concatMap vToL $ vToL wmat
+{- | A matrix that gives a top down view with no perspective. -}
+isoMatrix
+    :: Float        -- ^ Rotation
+    -> Float        -- ^ Zoom
+    -> Point2       -- ^ Translation
+    -> Point2       -- ^ Window size
+    -> Point2       -- ^ View froms
+    -> [GLfloat]
+isoMatrix rot czoom (tranx,trany) (winx,winy) _ =
+    let scalMat = Linear.Matrix.transpose $
+            V4 (V4 (2*czoom/winx) 0             0 (0::GLfloat))
+                (V4 0             (2*czoom/winy) 0 0)
+                (V4 0             0             1 0)
+                (V4 0             0             0 1)
+        rotMat = Linear.Matrix.transpose $
+            V4 (V4 (cos rot) (sin (-rot)) 0 0)
+                (V4 (sin rot) (cos rot)    0 0)
+                (V4 0             0        1 0)
+                (V4 0             0        0 1)
+        tranMat = Linear.Matrix.transpose $
+            V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (-tranx) (-trany) 0 1)
+        wmat = scalMat !*! rotMat !*! tranMat
+        vToL (V4 a b c d) = [a,b,c,d]
+    in concatMap vToL $ vToL wmat
@@ -40,10 +40,10 @@ preloadRender = do
    lsShad <- makeShader "lighting/floor" [vert,geom,frag] [(0,4)] Points 
                    (return . return . flat4)
    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [(0,4)] Points pokeWPStrat
-                >>= addUniforms ["lightPos","perpMat","facesToDraw"]
+                >>= addUniforms ["lightPos"]
    wlLightShad 
         <- makeShader "lighting/wall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
-                >>= addUniforms ["lightPos","perpMat","radLum"]
+                >>= addUniforms ["lightPos","radLum"]
 -- 2D draw shaders
    bslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
    lslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
@@ -82,12 +82,9 @@ preloadRender = do
 --                >>= addTexture "data/texture/smudgedDirt.png"
 -- blank wallShader
    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
--                >>= addTexture "data/texture/grayscaleDirt.png"
-                >>= addUniforms ["perpMat"]
 -- textured wallShader
    wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
                >>= addTexture "data/texture/grayscaleDirt.png"
-                >>= addUniforms ["perpMat"]
 -- framebuffer for lighting
    (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
    framebuf2 <- setupFramebufferWithStencil
@@ -38,12 +38,11 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]

    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
-    uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
+    -- reseting this uniform appears to be necessary
+    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
            $= Vector2 viewFromx viewFromy  
-    uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
-            $= pmat
-    uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
-            $= (0 :: Float)
+--    uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata))
+--            $= pmat
 --    cullFace $= Just Front
    drawShader (_lightingOccludeShader pdata) nWalls
    colorMask $= Color4 Enabled Enabled Enabled Enabled
@@ -81,7 +80,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 -- set uniforms for shader that draws lights
    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
-    uniform ( (_shaderCustomUnis $ _lightingWallShader pdata) !! 1)
+    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
            $= pmat
 -- clear buffer to full alpha and furthest depth
    clearColor $= Color4 0 0 0 1
@@ -93,10 +92,8 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
            $= Vector2 viewFromx viewFromy  
-    uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
+    uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata))
            $= pmat
-    uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
-            $= (0 :: Float)
    cullFace $= Just Back
    drawShader (_lightingOccludeShader pdata) nWalls

@@ -142,7 +139,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
        currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
        uniform (head $  _shaderCustomUnis $ _lightingWallShader pdata)
            $= Vector2 x y  
-        uniform ((_shaderCustomUnis $ _lightingWallShader pdata) !! 2)
+        uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
            $= Vector2 r lum
        drawShader (_lightingWallShader pdata) nWallLights
    cullFace $= Nothing
@@ -37,7 +37,7 @@ import Linear.Matrix
 import Linear.V4

 extractProgAndUnis :: FullShader a -> (Program,UniformLocation)
-extractProgAndUnis s = (_shaderProgram s, _shaderUniform s)
+extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s)

 pokeShaders :: [FullShader a] -> F.FoldM IO a [Int]
 pokeShaders = traverse pokeShader
@@ -124,7 +124,7 @@ makeShader s shaderlist alocs pm renStrat = do
    (prog,unis)  <- makeSourcedShader s shaderlist
    vaob        <- setupVAO alocs
    return $ FullShader { _shaderProgram = prog
-                        , _shaderUniform = unis
+                        , _shaderMatrixUniform = unis
                        , _shaderVAO = vaob
                        , _shaderPokeStrategy = renStrat
                        , _shaderDrawPrimitive = pm
@@ -184,7 +184,6 @@ addUniforms uniStrings shad = do
    uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings
    return $ shad & shaderCustomUnis %~ (++ uniLocs)

-
 shaderTypeExt :: ShaderType -> String
 shaderTypeExt VertexShader   = ".vert"
 shaderTypeExt GeometryShader = ".geom"
@@ -202,7 +201,6 @@ makeShaderProgram str sources = do
    unless linkingSuccess $ do
        infoLog <- get (programInfoLog theShaderProgram)
        putStrLn $ str ++ ": Program Linking" ++ infoLog
-
    return theShaderProgram

 compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
@@ -217,8 +215,8 @@ compileAndCheckShader str (theShaderType,sourceCode) = do
    return theShader

 resetShaderUniforms :: [(Program, UniformLocation)] -> IO ()
-resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2)
 {-# INLINE resetShaderUniforms #-}
+resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2)

 setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [(Program,UniformLocation)] -> IO ()
 {-# INLINE setShaderUniforms #-}
@@ -257,7 +255,7 @@ setPerpMatUniform
 setPerpMatUniform rot czoom trans wins vFrom shad = do
    pmat <- (newMatrix RowMajor $ perspectiveMatrix rot czoom trans wins vFrom) :: IO (GLmatrix GLfloat)
    currentProgram $= Just (_shaderProgram shad)
-    uniform (_shaderUniform shad) $= pmat
+    uniform (_shaderMatrixUniform shad) $= pmat
    return ()

 freeShaderPointers :: FullShader a -> IO ()
@@ -11,7 +11,7 @@ module Shader.Data
    , vaoBufferTargets

    , shaderProgram
-    , shaderUniform
+    , shaderMatrixUniform
    , shaderVAO
    , shaderPokeStrategy
    , shaderDrawPrimitive
@@ -32,7 +32,7 @@ data VAO = VAO
 {- | Datatype containing the necessary information for a single shader.  -}
 data FullShader a = FullShader
    { _shaderProgram :: Program
-    , _shaderUniform :: UniformLocation
+    , _shaderMatrixUniform :: UniformLocation
    , _shaderVAO :: VAO
    , _shaderPokeStrategy :: a -> [[[Float]]]-- -> F.FoldM IO RenderType Int
    , _shaderDrawPrimitive :: PrimitiveMode