diff options
-rw-r--r-- | src/LambdaCube/GL/Backend.hs | 25 |
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 | ||
286 | renderTargetOutputs :: Vector GLTexture -> RenderTarget -> GLRenderTarget -> [GLOutput] | ||
287 | renderTargetOutputs 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 | |||
286 | compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget | 295 | compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget |
287 | compileRenderTarget texs glTexs (RenderTarget targets) = do | 296 | compileRenderTarget 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 | ||
500 | outputIsRenderTexture :: GLOutput -> Bool | ||
501 | outputIsRenderTexture GLOutputRenderTexture{..} = True | ||
502 | outputIsRenderTexture _ = False | ||
503 | |||
491 | allocRenderer :: Pipeline -> IO GLRenderer | 504 | allocRenderer :: Pipeline -> IO GLRenderer |
492 | allocRenderer p = do | 505 | allocRenderer 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 | -} |