diff options
-rw-r--r-- | Backend/GL/Backend.hs | 2 | ||||
-rw-r--r-- | Backend/GL/Input.hs | 9 | ||||
-rw-r--r-- | lambdacube-gl-ir.cabal | 2 |
3 files changed, 7 insertions, 6 deletions
diff --git a/Backend/GL/Backend.hs b/Backend/GL/Backend.hs index 4780966..d3abfad 100644 --- a/Backend/GL/Backend.hs +++ b/Backend/GL/Backend.hs | |||
@@ -233,7 +233,7 @@ compileProgram uniTrie p = do | |||
233 | lcStreams = fmap ty (toTrie $ programStreams p) | 233 | lcStreams = fmap ty (toTrie $ programStreams p) |
234 | check a m = and $ map go $ T.toList m | 234 | check a m = and $ map go $ T.toList m |
235 | where go (k,b) = case T.lookup k a of | 235 | where go (k,b) = case T.lookup k a of |
236 | Nothing -> True | 236 | Nothing -> False |
237 | Just x -> x == b | 237 | Just x -> x == b |
238 | unless (check lcUniforms uniformsType) $ do | 238 | unless (check lcUniforms uniformsType) $ do |
239 | putStrLn $ "expected: " ++ show lcUniforms | 239 | putStrLn $ "expected: " ++ show lcUniforms |
diff --git a/Backend/GL/Input.hs b/Backend/GL/Input.hs index 2b7c3d3..e1d06b7 100644 --- a/Backend/GL/Input.hs +++ b/Backend/GL/Input.hs | |||
@@ -85,7 +85,7 @@ addObject input slotName prim indices attribs uniformNames = do | |||
85 | ] | 85 | ] |
86 | 86 | ||
87 | let slotIdx = case slotName `T.lookup` slotMap input of | 87 | let slotIdx = case slotName `T.lookup` slotMap input of |
88 | Nothing -> error "internal error (slot index)" | 88 | Nothing -> error $ "internal error (slot index): " ++ show slotName |
89 | Just i -> i | 89 | Just i -> i |
90 | seed = objSeed input | 90 | seed = objSeed input |
91 | order <- newIORef 0 | 91 | order <- newIORef 0 |
@@ -194,13 +194,13 @@ createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++ | |||
194 | where | 194 | where |
195 | uniCmds = [GLSetUniform i u | (n,i) <- uniMap, let u = T.lookupWithDefault (topUni n) n objUnis] | 195 | uniCmds = [GLSetUniform i u | (n,i) <- uniMap, let u = T.lookupWithDefault (topUni n) n objUnis] |
196 | uniMap = T.toList $ inputUniforms prg | 196 | uniMap = T.toList $ inputUniforms prg |
197 | topUni n = T.lookupWithDefault (error "internal error (createObjectCommands)!") n topUnis | 197 | topUni n = T.lookupWithDefault (error $ "internal error (createObjectCommands): " ++ show n) n topUnis |
198 | objUnis = objUniSetup obj | 198 | objUnis = objUniSetup obj |
199 | texUnis = S.toList $ inputTextureUniforms prg | 199 | texUnis = S.toList $ inputTextureUniforms prg |
200 | texCmds = [ GLBindTexture (inputTypeToTextureTarget $ uniInputType u) texUnit u | 200 | texCmds = [ GLBindTexture (inputTypeToTextureTarget $ uniInputType u) texUnit u |
201 | | n <- texUnis | 201 | | n <- texUnis |
202 | , let u = T.lookupWithDefault (topUni n) n objUnis | 202 | , let u = T.lookupWithDefault (topUni n) n objUnis |
203 | , let texUnit = T.lookupWithDefault (error "internal error (createObjectCommands - Texture Unit)") n texUnitMap | 203 | , let texUnit = T.lookupWithDefault (error $ "internal error (createObjectCommands - Texture Unit): " ++ show n) n texUnitMap |
204 | ] | 204 | ] |
205 | uniInputType (GLUniform ty _) = ty | 205 | uniInputType (GLUniform ty _) = ty |
206 | 206 | ||
@@ -243,7 +243,8 @@ createObjectCommands texUnitMap topUnis obj prg = objUniCmds ++ objStreamCmds ++ | |||
243 | constAttr -> GLSetVertexAttrib i constAttr | 243 | constAttr -> GLSetVertexAttrib i constAttr |
244 | 244 | ||
245 | nullSetter :: ByteString -> String -> a -> IO () | 245 | nullSetter :: ByteString -> String -> a -> IO () |
246 | nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t | 246 | --nullSetter n t _ = return () -- Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t |
247 | nullSetter n t _ = Prelude.putStrLn $ "WARNING: unknown uniform: " ++ SB.unpack n ++ " :: " ++ t | ||
247 | 248 | ||
248 | uniformBool :: ByteString -> Trie InputSetter -> SetterFun Bool | 249 | uniformBool :: ByteString -> Trie InputSetter -> SetterFun Bool |
249 | uniformV2B :: ByteString -> Trie InputSetter -> SetterFun V2B | 250 | uniformV2B :: ByteString -> Trie InputSetter -> SetterFun V2B |
diff --git a/lambdacube-gl-ir.cabal b/lambdacube-gl-ir.cabal index 0d2600a..53144ce 100644 --- a/lambdacube-gl-ir.cabal +++ b/lambdacube-gl-ir.cabal | |||
@@ -62,7 +62,7 @@ library | |||
62 | GLFW-b >= 1.4.7, | 62 | GLFW-b >= 1.4.7, |
63 | vect >= 0.4.7, | 63 | vect >= 0.4.7, |
64 | pretty-show >=1.6 && <1.7, | 64 | pretty-show >=1.6 && <1.7, |
65 | lambdacube-compiler | 65 | lambdacube-ir |
66 | hs-source-dirs: . | 66 | hs-source-dirs: . |
67 | default-language: Haskell2010 | 67 | default-language: Haskell2010 |
68 | 68 | ||