summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/LambdaCube/GL/Backend.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 324b3e6..90cb014 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -283,6 +283,15 @@ compileProgram p = do
283 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName] 283 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName]
284 } 284 }
285 285
286renderTargetOutputs :: Vector GLTexture -> RenderTarget -> GLRenderTarget -> [GLOutput]
287renderTargetOutputs glTexs (RenderTarget targetItems) (GLRenderTarget fbo bufs) =
288 let isFB (Framebuffer _) = True
289 isFB _ = False
290 images = [img | TargetItem _ (Just img) <- V.toList targetItems]
291 in case all isFB images of
292 True -> fromMaybe [] $ (GLOutputDrawBuffer fbo <$>) <$> bufs
293 False -> (\(TextureImage texIdx _ _)-> GLOutputRenderTexture fbo $ glTexs ! texIdx) <$> images
294
286compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget 295compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget
287compileRenderTarget texs glTexs (RenderTarget targets) = do 296compileRenderTarget texs glTexs (RenderTarget targets) = do
288 let isFB (Framebuffer _) = True 297 let isFB (Framebuffer _) = True
@@ -488,16 +497,25 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
488 -- constant generic attribute 497 -- constant generic attribute
489 constAttr -> GLSetVertexAttrib i constAttr 498 constAttr -> GLSetVertexAttrib i constAttr
490 499
500outputIsRenderTexture :: GLOutput -> Bool
501outputIsRenderTexture GLOutputRenderTexture{..} = True
502outputIsRenderTexture _ = False
503
491allocRenderer :: Pipeline -> IO GLRenderer 504allocRenderer :: Pipeline -> IO GLRenderer
492allocRenderer p = do 505allocRenderer p = do
493 smps <- V.mapM compileSampler $ samplers p 506 smps <- V.mapM compileSampler $ samplers p
494 texs <- V.mapM compileTexture $ textures p 507 texs <- V.mapM compileTexture $ textures p
495 trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p 508 let cmds = V.toList $ commands p
509 finalRenderTargetIdx = head [i | SetRenderTarget i <- reverse $ cmds]
510 trgs <- traverse (compileRenderTarget (textures p) texs) $ targets p
511 let finalRenderTarget = targets p ! finalRenderTargetIdx
512 finalGLRenderTarget = trgs ! finalRenderTargetIdx
513 outs = renderTargetOutputs texs finalRenderTarget finalGLRenderTarget
496 prgs <- V.mapM compileProgram $ programs p 514 prgs <- V.mapM compileProgram $ programs p
497 -- texture unit mapping ioref trie 515 -- texture unit mapping ioref trie
498 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) 516 -- texUnitMapRefs :: Map UniformName (IORef TextureUnit)
499 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (Set.toList $ Set.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p) 517 texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (Set.toList $ Set.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p)
500 let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) (V.toList $ commands p)) initCGState 518 let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) cmds) initCGState
501 input <- newIORef Nothing 519 input <- newIORef Nothing
502 -- default Vertex Array Object 520 -- default Vertex Array Object
503 vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao 521 vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao
@@ -515,6 +533,7 @@ allocRenderer p = do
515 , glCommands = reverse $ drawCommands st 533 , glCommands = reverse $ drawCommands st
516 , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p 534 , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p
517 , glInput = input 535 , glInput = input
536 , glOutputs = outs
518 , glSlotNames = V.map slotName $ IR.slots p 537 , glSlotNames = V.map slotName $ IR.slots p
519 , glVAO = vao 538 , glVAO = vao
520 , glTexUnitMapping = texUnitMapRefs 539 , glTexUnitMapping = texUnitMapRefs
@@ -895,4 +914,4 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of
895 case IM.lookup tu tb of 914 case IM.lookup tu tb of
896 Nothing -> fail "internal error (GenerateMipMap)!" 915 Nothing -> fail "internal error (GenerateMipMap)!"
897 Just tex -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) 916 Just tex -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex)
898-} \ No newline at end of file 917-}