diff options
author | Csaba Hruska <csaba.hruska@gmail.com> | 2015-04-30 15:32:06 +0200 |
---|---|---|
committer | Csaba Hruska <csaba.hruska@gmail.com> | 2015-05-18 14:50:52 +0200 |
commit | 6c9ebf718fa388df8772cd023352eed575dc3668 (patch) | |
tree | e8a36a77fa543f6fa2045c63b486806483c14a3a | |
parent | 91f82aca82dc282d5630c1bddd8dc773c679cc76 (diff) |
fix
-rw-r--r-- | Backend/GL/Backend.hs | 14 | ||||
-rw-r--r-- | Backend/GL/Input.hs | 2 |
2 files changed, 8 insertions, 8 deletions
diff --git a/Backend/GL/Backend.hs b/Backend/GL/Backend.hs index 7e6a9d4..9adff30 100644 --- a/Backend/GL/Backend.hs +++ b/Backend/GL/Backend.hs | |||
@@ -351,12 +351,12 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do | |||
351 | allocPipeline :: Pipeline -> IO GLPipeline | 351 | allocPipeline :: Pipeline -> IO GLPipeline |
352 | allocPipeline p = do | 352 | allocPipeline p = do |
353 | let uniTrie = uniforms $ schemaFromPipeline p | 353 | let uniTrie = uniforms $ schemaFromPipeline p |
354 | smps <- V.mapM compileSampler $ samplers p | 354 | smps <- V.mapM compileSampler $ V.fromList $ samplers p |
355 | texs <- V.mapM compileTexture $ textures p | 355 | texs <- V.mapM compileTexture $ V.fromList $ textures p |
356 | trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p | 356 | trgs <- V.mapM (compileRenderTarget (V.fromList $ textures p) texs) $ V.fromList $ targets p |
357 | prgs <- V.mapM (compileProgram uniTrie) $ programs p | 357 | prgs <- V.mapM (compileProgram uniTrie) $ V.fromList $ programs p |
358 | -- texture unit mapping ioref trie | 358 | -- texture unit mapping ioref trie |
359 | texUnitMapRefs <- T.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (T.keys . toTrie . programInTextures) $ programs p) | 359 | texUnitMapRefs <- T.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (T.keys . toTrie . programInTextures) $ V.fromList $ programs p) |
360 | let (cmds,st) = runState (mapM (compileCommand texUnitMapRefs smps texs trgs prgs) $ commands p) initCGState | 360 | let (cmds,st) = runState (mapM (compileCommand texUnitMapRefs smps texs trgs prgs) $ commands p) initCGState |
361 | input <- newIORef Nothing | 361 | input <- newIORef Nothing |
362 | -- default Vertex Array Object | 362 | -- default Vertex Array Object |
@@ -367,9 +367,9 @@ allocPipeline p = do | |||
367 | , glSamplers = smps | 367 | , glSamplers = smps |
368 | , glTargets = trgs | 368 | , glTargets = trgs |
369 | , glCommands = cmds | 369 | , glCommands = cmds |
370 | , glSlotPrograms = V.map slotPrograms $ IR.slots p | 370 | , glSlotPrograms = V.map slotPrograms $ V.fromList $ IR.slots p |
371 | , glInput = input | 371 | , glInput = input |
372 | , glSlotNames = V.map (pack . slotName) $ IR.slots p | 372 | , glSlotNames = V.map (pack . slotName) $ V.fromList $ IR.slots p |
373 | , glVAO = vao | 373 | , glVAO = vao |
374 | , glTexUnitMapping = texUnitMapRefs | 374 | , glTexUnitMapping = texUnitMapRefs |
375 | } | 375 | } |
diff --git a/Backend/GL/Input.hs b/Backend/GL/Input.hs index 6d4f40f..9d217ad 100644 --- a/Backend/GL/Input.hs +++ b/Backend/GL/Input.hs | |||
@@ -30,7 +30,7 @@ import qualified IR as IR | |||
30 | schemaFromPipeline :: IR.Pipeline -> PipelineSchema | 30 | schemaFromPipeline :: IR.Pipeline -> PipelineSchema |
31 | schemaFromPipeline a = PipelineSchema (T.fromList sl) (foldl T.unionL T.empty ul) | 31 | schemaFromPipeline a = PipelineSchema (T.fromList sl) (foldl T.unionL T.empty ul) |
32 | where | 32 | where |
33 | (sl,ul) = unzip [((pack n,SlotSchema p (fmap cvt (toTrie s))),toTrie u) | IR.Slot n u s p _ <- V.toList $ IR.slots a] | 33 | (sl,ul) = unzip [((pack n,SlotSchema p (fmap cvt (toTrie s))),toTrie u) | IR.Slot n u s p _ <- IR.slots a] |
34 | cvt a = case toStreamType a of | 34 | cvt a = case toStreamType a of |
35 | Just v -> v | 35 | Just v -> v |
36 | Nothing -> error "internal error (schemaFromPipeline)" | 36 | Nothing -> error "internal error (schemaFromPipeline)" |