diff options
Diffstat (limited to 'Backend')
-rw-r--r-- | Backend/GL/Backend.hs | 2 | ||||
-rw-r--r-- | Backend/GL/Input.hs | 9 |
2 files changed, 6 insertions, 5 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 |