summaryrefslogtreecommitdiff
path: root/src/LambdaCube/GL/Backend.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/LambdaCube/GL/Backend.hs')
-rw-r--r--src/LambdaCube/GL/Backend.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 29acbb8..40abc6d 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -196,8 +196,8 @@ clearRenderTarget values = do
196printGLStatus = checkGL >>= print 196printGLStatus = checkGL >>= print
197printFBOStatus = checkFBO >>= print 197printFBOStatus = checkFBO >>= print
198 198
199compileProgram :: Map String InputType -> Program -> IO GLProgram 199compileProgram :: Program -> IO GLProgram
200compileProgram uniTrie p = do 200compileProgram p = do
201 po <- glCreateProgram 201 po <- glCreateProgram
202 --putStrLn $ "compile program: " ++ show po 202 --putStrLn $ "compile program: " ++ show po
203 let createAndAttach src t = do 203 let createAndAttach src t = do
@@ -245,7 +245,7 @@ compileProgram uniTrie p = do
245 inUniforms = L.filter (\(n,v) -> Map.member n inUniNames) $ Map.toList $ uniforms 245 inUniforms = L.filter (\(n,v) -> Map.member n inUniNames) $ Map.toList $ uniforms
246 inTextureNames = programInTextures p 246 inTextureNames = programInTextures p
247 inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms 247 inTextures = L.filter (\(n,v) -> Map.member n inTextureNames) $ Map.toList $ uniforms
248 texUnis = [n | (n,_) <- inTextures, Map.member n uniTrie] 248 texUnis = [n | (n,_) <- inTextures, Map.member n (programUniforms p)]
249 --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie) 249 --putStrLn $ "uniTrie: " ++ show (Map.keys uniTrie)
250 --putStrLn $ "inUniNames: " ++ show inUniNames 250 --putStrLn $ "inUniNames: " ++ show inUniNames
251 --putStrLn $ "inUniforms: " ++ show inUniforms 251 --putStrLn $ "inUniforms: " ++ show inUniforms
@@ -474,11 +474,10 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
474 474
475allocRenderer :: Pipeline -> IO GLRenderer 475allocRenderer :: Pipeline -> IO GLRenderer
476allocRenderer p = do 476allocRenderer p = do
477 let uniTrie = uniforms $ schemaFromPipeline p
478 smps <- V.mapM compileSampler $ samplers p 477 smps <- V.mapM compileSampler $ samplers p
479 texs <- V.mapM compileTexture $ textures p 478 texs <- V.mapM compileTexture $ textures p
480 trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p 479 trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p
481 prgs <- V.mapM (compileProgram uniTrie) $ programs p 480 prgs <- V.mapM compileProgram $ programs p
482 -- texture unit mapping ioref trie 481 -- texture unit mapping ioref trie
483 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) 482 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit)
484 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p) 483 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p)