lambdacube-gl 0.5.0.3 → 0.5.0.4

raw patch · 2 files changed

+17/−2 lines, 2 files

Files

• lambdacube-gl.cabal +1/−1
• src/LambdaCube/GL/Backend.hs +16/−1

@@ -1,5 +1,5 @@ name:                lambdacube-gl-version:             0.5.0.3+version:             0.5.0.4 synopsis:            OpenGL 3.3 Core Profile backend for LambdaCube 3D description:         OpenGL 3.3 Core Profile backend for LambdaCube 3D homepage:            http://lambdacube3d.com

@@ -247,6 +247,21 @@         inTextureNames = programInTextures p         inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms         texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)]+    let prgInTextures = Map.keys inTextureNames+        uniInTextures = map fst inTextures+    {-+    unless (S.fromList prgInTextures == S.fromList uniInTextures) $ fail $ unlines+      [ "shader program uniform texture input mismatch!"+      , "expected: " ++ show prgInTextures+      , "actual: " ++ show uniInTextures+      , "vertex shader:"+      , vertexShader p+      , "geometry shader:"+      , fromMaybe "" (geometryShader p)+      , "fragment shader:"+      , fragmentShader p+      ]+    -}     --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie)     --putStrLn $ "inUniNames: " ++ show inUniNames     --putStrLn $ "inUniforms: " ++ show inUniforms@@ -775,7 +790,7 @@     SetSamplerUniform n tu      -> do                                     p <- currentProgram <$> get                                     case Map.lookup n (inputTextures $ programs ! p) of-                                        Nothing -> fail $ "internal error (SetSamplerUniform)! - " ++ show cmd+                                        Nothing -> return (GLSetProgram (programObject $ programs ! p) {-HACK!!! we have to emit something-}) -- TODO: some drivers does heavy cross stage (vertex/fragment) dead code elimination; fail $ "internal error (SetSamplerUniform)! - " ++ show cmd                                         Just i  -> case Map.lookup n texUnitMap of                                             Nothing -> fail $ "internal error (SetSamplerUniform - IORef)! - " ++ show cmd                                             Just r  -> return $ GLSetSamplerUniform i (fromIntegral tu) r