Remove unnecessary uniforms

src/Shader.hs

@@ -36,8 +36,8 @@ import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Linear.Matrix
 import Linear.V4
 
-extractProgAndUnis :: FullShader a -> (Program,[UniformLocation])
+extractProgAndUnis :: FullShader a -> (Program,UniformLocation)
-extractProgAndUnis s = (_shaderProgram s, _shaderUniforms s)
+extractProgAndUnis s = (_shaderProgram s, _shaderUniform 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
-                        , _shaderUniforms = unis
+                        , _shaderUniform = unis
                         , _shaderVAO = vaob
                         , _shaderPokeStrategy = renStrat
                         , _shaderDrawPrimitive = pm
@@ -172,12 +172,11 @@ setupArrayBuffer (aloc,i) = do
 -- | 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.
-makeSourcedShader :: String -> [ShaderType] -> IO (Program, [UniformLocation])
+makeSourcedShader :: String -> [ShaderType] -> IO (Program, UniformLocation)
 makeSourcedShader s sts = do
     sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
     prog <- makeShaderProgram s $ zip sts sources
-    uniformLocations <- forM ["winSize","zoom","rotation","translation","worldMat"]
+    uniformLocations <- uniformLocation prog "worldMat"
-                    $ \uniString -> uniformLocation prog uniString
     return (prog,uniformLocations)
 
 addUniforms :: [String] -> FullShader a -> IO (FullShader a)
@@ -217,11 +216,11 @@ compileAndCheckShader str (theShaderType,sourceCode) = do
         putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " : " ++ show infoLog
     return theShader
 
-resetShaderUniforms :: [(Program, [UniformLocation])] -> IO ()
+resetShaderUniforms :: [(Program, UniformLocation)] -> IO ()
 resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2)
 {-# INLINE resetShaderUniforms #-}
 
-setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [(Program,[UniformLocation])] -> IO ()
+setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [(Program,UniformLocation)] -> IO ()
 {-# INLINE setShaderUniforms #-}
 setShaderUniforms rot czoom (tranx,trany) (winx,winy) fss = do
     let scalMat = Linear.Matrix.transpose $
@@ -245,11 +244,7 @@ setShaderUniforms rot czoom (tranx,trany) (winx,winy) fss = do
 -- set common uniforms
     forM_ fss $ \shad -> do
         currentProgram $= Just (fst shad)
-        uniform (snd shad !! 0) $= Vector2 winx winy
+        uniform (snd shad) $= wmata
-        uniform (snd shad !! 1) $= czoom
-        uniform (snd shad !! 2) $= rot
-        uniform (snd shad !! 3) $= Vector2 tranx trany
-        uniform (snd shad !! 4) $= wmata
 
 setPerpMatUniform 
     :: Float -- ^ rotation
@@ -262,7 +257,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 (_shaderUniforms shad !! 4) $= pmat
+    uniform (_shaderUniform shad) $= pmat
     return ()
 
 freeShaderPointers :: FullShader a -> IO ()

src/Shader/Data.hs

@@ -11,7 +11,7 @@ module Shader.Data
     , vaoBufferTargets
 
     , shaderProgram
-    , shaderUniforms 
+    , shaderUniform
     , 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
-    , _shaderUniforms :: [UniformLocation]
+    , _shaderUniform :: UniformLocation
     , _shaderVAO :: VAO
     , _shaderPokeStrategy :: a -> [[[Float]]]-- -> F.FoldM IO RenderType Int
     , _shaderDrawPrimitive :: PrimitiveMode