diff options
-rw-r--r-- | lambdacube-gl.cabal | 2 | ||||
-rw-r--r-- | src/LambdaCube/GL/Backend.hs | 13 |
2 files changed, 14 insertions, 1 deletions
diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal index e36721f..66d0852 100644 --- a/lambdacube-gl.cabal +++ b/lambdacube-gl.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | name: lambdacube-gl | 1 | name: lambdacube-gl |
2 | version: 0.5.0.3 | 2 | version: 0.5.0.4 |
3 | synopsis: OpenGL 3.3 Core Profile backend for LambdaCube 3D | 3 | synopsis: OpenGL 3.3 Core Profile backend for LambdaCube 3D |
4 | description: OpenGL 3.3 Core Profile backend for LambdaCube 3D | 4 | description: OpenGL 3.3 Core Profile backend for LambdaCube 3D |
5 | homepage: http://lambdacube3d.com | 5 | homepage: http://lambdacube3d.com |
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs index 282c281..f14d105 100644 --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs | |||
@@ -247,6 +247,19 @@ compileProgram p = do | |||
247 | inTextureNames = programInTextures p | 247 | inTextureNames = programInTextures p |
248 | inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms | 248 | inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms |
249 | texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)] | 249 | texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)] |
250 | let prgInTextures = Map.keys inTextureNames | ||
251 | uniInTextures = map fst inTextures | ||
252 | unless (S.fromList prgInTextures == S.fromList uniInTextures) $ fail $ unlines | ||
253 | [ "shader program uniform texture input mismatch!" | ||
254 | , "expected: " ++ show prgInTextures | ||
255 | , "actual: " ++ show uniInTextures | ||
256 | , "vertex shader:" | ||
257 | , vertexShader p | ||
258 | , "geometry shader:" | ||
259 | , fromMaybe "" (geometryShader p) | ||
260 | , "fragment shader:" | ||
261 | , fragmentShader p | ||
262 | ] | ||
250 | --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie) | 263 | --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie) |
251 | --putStrLn $ "inUniNames: " ++ show inUniNames | 264 | --putStrLn $ "inUniNames: " ++ show inUniNames |
252 | --putStrLn $ "inUniforms: " ++ show inUniforms | 265 | --putStrLn $ "inUniforms: " ++ show inUniforms |