From d9c85874d3b11253415ee4ea0f2d5b4c52f3489b Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Mon, 8 Feb 2016 14:26:15 +0100 Subject: implement sampler support --- src/LambdaCube/GL/Backend.hs | 11 +++----- src/LambdaCube/GL/Type.hs | 2 +- src/LambdaCube/GL/Util.hs | 67 ++++++++++++++++++++++++++++++++++---------- 3 files changed, 57 insertions(+), 23 deletions(-) (limited to 'src/LambdaCube') diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs index a5507f3..7c2c3fb 100644 --- a/src/LambdaCube/GL/Backend.hs +++ b/src/LambdaCube/GL/Backend.hs @@ -267,9 +267,6 @@ compileProgram uniTrie p = do , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName] } -compileSampler :: SamplerDescriptor -> IO GLSampler -compileSampler s = return $ GLSampler {} -- TODO - compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget compileRenderTarget texs glTexs (RenderTarget targets) = do let isFB (Framebuffer _) = True @@ -514,6 +511,8 @@ disposeRenderer p = do withArray (map framebufferObject $ V.toList targets) $ (glDeleteFramebuffers $ fromIntegral $ V.length targets) let textures = glTextures p withArray (map glTextureObject $ V.toList textures) $ (glDeleteTextures $ fromIntegral $ V.length textures) + let samplers = glSamplers p + withArray (map glSamplerObject $ V.toList samplers) $ (glDeleteSamplers . fromIntegral . V.length $ glSamplers p) with (glVAO p) $ (glDeleteVertexArrays 1) {- @@ -730,6 +729,7 @@ renderFrame glp = do GLSetProgram p -> glUseProgram p GLSetSamplerUniform i tu ref -> glUniform1i i tu >> writeIORef ref tu GLSetTexture tu target tx -> glActiveTexture tu >> glBindTexture target tx + GLSetSampler tu s -> glBindSampler tu s GLClearRenderTarget vals -> clearRenderTarget vals GLGenerateMipMap tu target -> glActiveTexture tu >> glGenerateMipmap target GLRenderStream streamIdx progIdx -> do @@ -790,10 +790,7 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of let tex = textures ! t modify (\s -> s {textureBinding = IM.insert tu tex $ textureBinding s}) return $ GLSetTexture (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) (glTextureObject tex) -{- - SetSampler tu s -> liftIO $ do - glBindSampler (fromIntegral tu) (samplerObject $ glSamplers glp ! s) --} + SetSampler tu s -> return $ GLSetSampler (GL_TEXTURE0 + fromIntegral tu) (maybe 0 (glSamplerObject . (samplers !)) s) RenderSlot slot -> do smpUnis <- samplerUniforms <$> get p <- currentProgram <$> get diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs index 376fdf1..5a9117d 100644 --- a/src/LambdaCube/GL/Type.hs +++ b/src/LambdaCube/GL/Type.hs @@ -163,7 +163,7 @@ data GLRenderer data GLSampler = GLSampler - { samplerObject :: GLuint + { glSamplerObject :: GLuint } data GLRenderTarget diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs index c5c6608..ab8350f 100644 --- a/src/LambdaCube/GL/Util.hs +++ b/src/LambdaCube/GL/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module LambdaCube.GL.Util ( queryUniforms, queryStreams, @@ -23,6 +24,7 @@ module LambdaCube.GL.Util ( glGetIntegerv1, setSampler, checkFBO, + compileSampler, compileTexture, primitiveToFetchPrimitive, primitiveToGLType, @@ -503,21 +505,48 @@ edgeModeToGLType a = case a of ClampToEdge -> GL_CLAMP_TO_EDGE ClampToBorder -> GL_CLAMP_TO_BORDER +data ParameterSetup + = ParameterSetup + { setParameteri :: GLenum -> GLint -> IO () + , setParameterfv :: GLenum -> Ptr GLfloat -> IO () + , setParameterIiv :: GLenum -> Ptr GLint -> IO () + , setParameterIuiv :: GLenum -> Ptr GLuint -> IO () + , setParameterf :: GLenum -> GLfloat -> IO () + } + setTextureSamplerParameters :: GLenum -> SamplerDescriptor -> IO () -setTextureSamplerParameters t s = do - glTexParameteri t GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s +setTextureSamplerParameters target = setParameters $ ParameterSetup + { setParameteri = glTexParameteri target + , setParameterfv = glTexParameterfv target + , setParameterIiv = glTexParameterIiv target + , setParameterIuiv = glTexParameterIuiv target + , setParameterf = glTexParameterf target + } + +setSamplerParameters :: GLuint -> SamplerDescriptor -> IO () +setSamplerParameters samplerObj = setParameters $ ParameterSetup + { setParameteri = glSamplerParameteri samplerObj + , setParameterfv = glSamplerParameterfv samplerObj + , setParameterIiv = glSamplerParameterIiv samplerObj + , setParameterIuiv = glSamplerParameterIuiv samplerObj + , setParameterf = glSamplerParameterf samplerObj + } + +setParameters :: ParameterSetup -> SamplerDescriptor -> IO () +setParameters ParameterSetup{..} s = do + setParameteri GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s case samplerWrapT s of Nothing -> return () - Just a -> glTexParameteri t GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a + Just a -> setParameteri GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a case samplerWrapR s of Nothing -> return () - Just a -> glTexParameteri t GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a - glTexParameteri t GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s - glTexParameteri t GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s + Just a -> setParameteri GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a + setParameteri GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s + setParameteri GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s - let setBColorV4F a = with a $ \p -> glTexParameterfv t GL_TEXTURE_BORDER_COLOR $ castPtr p - setBColorV4I a = with a $ \p -> glTexParameterIiv t GL_TEXTURE_BORDER_COLOR $ castPtr p - setBColorV4U a = with a $ \p -> glTexParameterIuiv t GL_TEXTURE_BORDER_COLOR $ castPtr p + let setBColorV4F a = with a $ \p -> setParameterfv GL_TEXTURE_BORDER_COLOR $ castPtr p + setBColorV4I a = with a $ \p -> setParameterIiv GL_TEXTURE_BORDER_COLOR $ castPtr p + setBColorV4U a = with a $ \p -> setParameterIuiv GL_TEXTURE_BORDER_COLOR $ castPtr p case samplerBorderColor s of -- float, word, int, red, rg, rgb, rgba VFloat a -> setBColorV4F $ V4 a 0 0 0 @@ -538,16 +567,24 @@ setTextureSamplerParameters t s = do case samplerMinLod s of Nothing -> return () - Just a -> glTexParameterf t GL_TEXTURE_MIN_LOD $ realToFrac a + Just a -> setParameterf GL_TEXTURE_MIN_LOD $ realToFrac a case samplerMaxLod s of Nothing -> return () - Just a -> glTexParameterf t GL_TEXTURE_MAX_LOD $ realToFrac a - glTexParameterf t GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s + Just a -> setParameterf GL_TEXTURE_MAX_LOD $ realToFrac a + setParameterf GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s case samplerCompareFunc s of - Nothing -> glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE + Nothing -> setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE Just a -> do - glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE - glTexParameteri t GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a + setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE + setParameteri GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a + +compileSampler :: SamplerDescriptor -> IO GLSampler +compileSampler s = do + so <- alloca $! \po -> glGenSamplers 1 po >> peek po + setSamplerParameters so s + return $ GLSampler + { glSamplerObject = so + } compileTexture :: TextureDescriptor -> IO GLTexture compileTexture txDescriptor = do -- cgit v1.2.3