From 8c0aa6062a30160f0655d1be767d7ee77b4809ce Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Tue, 18 Sep 2018 01:14:11 +0300 Subject: types: introduce GLOutput into GLRenderer --- src/LambdaCube/GL/Type.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'src/LambdaCube') diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs index 49491ed..bd3f827 100644 --- a/src/LambdaCube/GL/Type.hs +++ b/src/LambdaCube/GL/Type.hs @@ -152,6 +152,7 @@ data GLRenderer , glTextures :: Vector GLTexture , glSamplers :: Vector GLSampler , glTargets :: Vector GLRenderTarget + , glOutputs :: [GLOutput] , glCommands :: [GLCommand] , glSlotPrograms :: Vector [ProgramName] -- programs depend on a slot , glInput :: IORef (Maybe InputConnection) @@ -177,6 +178,16 @@ data GLRenderTarget , framebufferDrawbuffers :: Maybe [GLenum] } deriving Eq +data GLOutput + = GLOutputDrawBuffer + { glOutputFBO :: GLuint + , glOutputDrawBuffer :: GLenum + } + | GLOutputRenderTexture + { glOutputFBO :: GLuint + , glOutputRenderTexture :: GLTexture + } + type GLTextureUnit = Int type GLUniformBinding = GLint -- cgit v1.2.3 From 23937046e4771c32fda6c46e80c593009ce9b769 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Tue, 18 Sep 2018 01:15:09 +0300 Subject: compileRenderTarget/allocRenderer: fill the glOutputs of a GLRenderer --- src/LambdaCube/GL/Backend.hs | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) (limited to 'src/LambdaCube') 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 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName] } +renderTargetOutputs :: Vector GLTexture -> RenderTarget -> GLRenderTarget -> [GLOutput] +renderTargetOutputs glTexs (RenderTarget targetItems) (GLRenderTarget fbo bufs) = + let isFB (Framebuffer _) = True + isFB _ = False + images = [img | TargetItem _ (Just img) <- V.toList targetItems] + in case all isFB images of + True -> fromMaybe [] $ (GLOutputDrawBuffer fbo <$>) <$> bufs + False -> (\(TextureImage texIdx _ _)-> GLOutputRenderTexture fbo $ glTexs ! texIdx) <$> images + compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget compileRenderTarget texs glTexs (RenderTarget targets) = do let isFB (Framebuffer _) = True @@ -488,16 +497,25 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s -- constant generic attribute constAttr -> GLSetVertexAttrib i constAttr +outputIsRenderTexture :: GLOutput -> Bool +outputIsRenderTexture GLOutputRenderTexture{..} = True +outputIsRenderTexture _ = False + allocRenderer :: Pipeline -> IO GLRenderer allocRenderer p = do smps <- V.mapM compileSampler $ samplers p texs <- V.mapM compileTexture $ textures p - trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p + let cmds = V.toList $ commands p + finalRenderTargetIdx = head [i | SetRenderTarget i <- reverse $ cmds] + trgs <- traverse (compileRenderTarget (textures p) texs) $ targets p + let finalRenderTarget = targets p ! finalRenderTargetIdx + finalGLRenderTarget = trgs ! finalRenderTargetIdx + outs = renderTargetOutputs texs finalRenderTarget finalGLRenderTarget prgs <- V.mapM compileProgram $ programs p -- texture unit mapping ioref trie -- texUnitMapRefs :: Map UniformName (IORef TextureUnit) texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (Set.toList $ Set.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p) - let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) (V.toList $ commands p)) initCGState + let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) cmds) initCGState input <- newIORef Nothing -- default Vertex Array Object vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao @@ -515,6 +533,7 @@ allocRenderer p = do , glCommands = reverse $ drawCommands st , glSlotPrograms = V.map (V.toList . slotPrograms) $ IR.slots p , glInput = input + , glOutputs = outs , glSlotNames = V.map slotName $ IR.slots p , glVAO = vao , glTexUnitMapping = texUnitMapRefs @@ -895,4 +914,4 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of case IM.lookup tu tb of Nothing -> fail "internal error (GenerateMipMap)!" Just tex -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) --} \ No newline at end of file +-} -- cgit v1.2.3 From 5d0c09aeddd4856758480d48dc33f5eac2ac673e Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:16:43 +0300 Subject: clearRenderTarget: render textures need format-specific treatment --- src/LambdaCube/GL/Backend.hs | 58 ++++++++++++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 16 deletions(-) (limited to 'src/LambdaCube') diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs index 90cb014..0584a34 100644 --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs @@ -126,7 +126,7 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops glDepthFunc $! comparisonFunctionToGLType df glDepthMask (cvtBool dm) cvtC 0 xs - cvt xs = do + cvt xs = do glDisable GL_DEPTH_TEST glDisable GL_STENCIL_TEST cvtC 0 xs @@ -169,8 +169,8 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops cvtBool True = 1 cvtBool False = 0 -clearRenderTarget :: [ClearImage] -> IO () -clearRenderTarget values = do +clearRenderTarget :: GLRenderTarget -> [ClearImage] -> IO () +clearRenderTarget GLRenderTarget{..} values = do let setClearValue (m,i) value = case value of ClearImage Depth (VFloat v) -> do glDepthMask 1 @@ -180,20 +180,46 @@ clearRenderTarget values = do glClearStencil $ fromIntegral v return (m .|. GL_STENCIL_BUFFER_BIT, i) ClearImage Color c -> do - let (r,g,b,a) = case c of - VFloat r -> (realToFrac r, 0, 0, 1) - VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1) - VV3F (V3 r g b) -> (realToFrac r, realToFrac g, realToFrac b, 1) - VV4F (V4 r g b a) -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a) - _ -> (0,0,0,1) glColorMask 1 1 1 1 - glClearColor r g b a - return (m .|. GL_COLOR_BUFFER_BIT, i+1) + if framebufferObject == 0 + then + clearDefaultFB >> + pure (m .|. GL_COLOR_BUFFER_BIT, i+1) + else + clearFBColorAttachment >> + pure (m, i+1) + where + clearDefaultFB = do + let (r,g,b,a) = case c of + VFloat r -> (realToFrac r, 0, 0, 1) + VV2F (V2 r g) -> (realToFrac r, realToFrac g, 0, 1) + VV3F (V3 r g b) -> (realToFrac r, realToFrac g, realToFrac b, 1) + VV4F (V4 r g b a) -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a) + _ -> (0,0,0,1) + glClearColor r g b a + clearFBColorAttachment = do + let buf = GL_COLOR + case c of -- there must be some clever way to extract the generality here, I'm sure.. + VFloat r -> with (V4 r 0 0 1) $ glClearBufferfv buf i . castPtr + VV2F (V2 r g) -> with (V4 r g 0 1) $ glClearBufferfv buf i . castPtr + VV3F (V3 r g b) -> with (V4 r g b 1) $ glClearBufferfv buf i . castPtr + VV4F (V4 r g b a) -> with (V4 r g b a) $ glClearBufferfv buf i . castPtr + + VInt r -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr + VV2I (V2 r g) -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr + VV3I (V3 r g b) -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr + VV4I (V4 r g b a) -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr + + VWord r -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr + VV2U (V2 r g) -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr + VV3U (V3 r g b) -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr + VV4U (V4 r g b a) -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr + _ -> error $ "internal error: unsupported color attachment format: " <> show c + _ -> error "internal error (clearRenderTarget)" (mask,_) <- foldM setClearValue (0,0) values glClear $ fromIntegral mask - printGLStatus = checkGL >>= print printFBOStatus = checkFBO >>= print @@ -353,7 +379,7 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do | n > 1 -> attachArray | otherwise -> attach2D TextureBuffer _ -> fail "internalError (compileRenderTarget/TextureBuffer)!" - + go a (TargetItem Stencil (Just img)) = do fail "Stencil support is not implemented yet!" return a @@ -462,7 +488,7 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s -- object attribute stream commands streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs] - where + where attrMap = inputStreams prg attrCmd i s = case s of Stream ty (Buffer arrs bo) arrIdx start len -> case ty of @@ -592,7 +618,7 @@ isSubTrie eqFun universe subset = and [isMember a (Map.lookup n universe) | (n,a when (sPrim /= (primitiveToFetchPrimitive prim)) $ throw $ userError $ "Primitive mismatch for slot (" ++ show slotName ++ ") expected " ++ show sPrim ++ " but got " ++ show prim let sType = fmap streamToStreamType attribs - when (sType /= sAttrs) $ throw $ userError $ unlines $ + when (sType /= sAttrs) $ throw $ userError $ unlines $ [ "Attribute stream mismatch for slot (" ++ show slotName ++ ") expected " , show sAttrs , " but got " @@ -809,7 +835,7 @@ renderFrame GLRenderer{..} = do case cmd of GLClearRenderTarget rt vals -> do setupRenderTarget glInput rt - clearRenderTarget vals + clearRenderTarget rt vals modifyIORef glDrawContextRef $ \ctx -> ctx {glRenderTarget = rt} GLRenderStream ctx streamIdx progIdx -> do -- cgit v1.2.3 From 4735792a761d8c352985eb4eb123b100a2da2e2f Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:49:51 +0300 Subject: textureDataTypeToGLType: switch to 8-bit components for integer RGBA textures --- src/LambdaCube/GL/Util.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src/LambdaCube') diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs index bba322b..7885860 100644 --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -403,6 +403,8 @@ blendingFactorToGLType a = case a of SrcColor -> GL_SRC_COLOR Zero -> GL_ZERO +-- XXX: we need to extend IR.TextureDescriptor to carry component bit depth +-- if we want to avoid making arbitrary decisions here textureDataTypeToGLType :: ImageSemantic -> TextureDataType -> GLenum textureDataTypeToGLType Color a = case a of FloatT Red -> GL_R32F @@ -412,8 +414,8 @@ textureDataTypeToGLType Color a = case a of IntT RG -> GL_RG32I WordT RG -> GL_RG32UI FloatT RGBA -> GL_RGBA32F - IntT RGBA -> GL_RGBA32I - WordT RGBA -> GL_RGBA32UI + IntT RGBA -> GL_RGBA8I + WordT RGBA -> GL_RGBA8UI a -> error $ "FIXME: This texture format is not yet supported" ++ show a textureDataTypeToGLType Depth a = case a of FloatT Red -> GL_DEPTH_COMPONENT32F -- cgit v1.2.3 From b0505615355a8e6b91de431ff7ac080b12349c6a Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Thu, 20 Sep 2018 22:52:00 +0300 Subject: textureDataTypeToGLArityType: fix translation for integer textures --- src/LambdaCube/GL/Util.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/LambdaCube') diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs index 7885860..b267c7f 100644 --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -427,14 +427,14 @@ textureDataTypeToGLType Stencil a = case a of textureDataTypeToGLArityType :: ImageSemantic -> TextureDataType -> GLenum textureDataTypeToGLArityType Color a = case a of FloatT Red -> GL_RED - IntT Red -> GL_RED - WordT Red -> GL_RED + IntT Red -> GL_RED_INTEGER + WordT Red -> GL_RED_INTEGER FloatT RG -> GL_RG - IntT RG -> GL_RG - WordT RG -> GL_RG + IntT RG -> GL_RG_INTEGER + WordT RG -> GL_RG_INTEGER FloatT RGBA -> GL_RGBA - IntT RGBA -> GL_RGBA - WordT RGBA -> GL_RGBA + IntT RGBA -> GL_RGBA_INTEGER + WordT RGBA -> GL_RGBA_INTEGER a -> error $ "FIXME: This texture format is not yet supported" ++ show a textureDataTypeToGLArityType Depth a = case a of FloatT Red -> GL_DEPTH_COMPONENT -- cgit v1.2.3