summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lambdacube-gl.cabal2
-rw-r--r--src/LambdaCube/GL/Backend.hs11
-rw-r--r--src/LambdaCube/GL/Type.hs2
-rw-r--r--src/LambdaCube/GL/Util.hs67
4 files changed, 58 insertions, 24 deletions
diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal
index 1952980..3130003 100644
--- a/lambdacube-gl.cabal
+++ b/lambdacube-gl.cabal
@@ -1,5 +1,5 @@
1name: lambdacube-gl 1name: lambdacube-gl
2version: 0.4.0.2 2version: 0.5.0.0
3synopsis: OpenGL 3.3 Core Profile backend for LambdaCube 3D 3synopsis: OpenGL 3.3 Core Profile backend for LambdaCube 3D
4description: OpenGL 3.3 Core Profile backend for LambdaCube 3D 4description: OpenGL 3.3 Core Profile backend for LambdaCube 3D
5homepage: http://lambdacube3d.com 5homepage: http://lambdacube3d.com
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
267 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName] 267 , inputStreams = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let Just attrName = Map.lookup n lcStreamName]
268 } 268 }
269 269
270compileSampler :: SamplerDescriptor -> IO GLSampler
271compileSampler s = return $ GLSampler {} -- TODO
272
273compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget 270compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget
274compileRenderTarget texs glTexs (RenderTarget targets) = do 271compileRenderTarget texs glTexs (RenderTarget targets) = do
275 let isFB (Framebuffer _) = True 272 let isFB (Framebuffer _) = True
@@ -514,6 +511,8 @@ disposeRenderer p = do
514 withArray (map framebufferObject $ V.toList targets) $ (glDeleteFramebuffers $ fromIntegral $ V.length targets) 511 withArray (map framebufferObject $ V.toList targets) $ (glDeleteFramebuffers $ fromIntegral $ V.length targets)
515 let textures = glTextures p 512 let textures = glTextures p
516 withArray (map glTextureObject $ V.toList textures) $ (glDeleteTextures $ fromIntegral $ V.length textures) 513 withArray (map glTextureObject $ V.toList textures) $ (glDeleteTextures $ fromIntegral $ V.length textures)
514 let samplers = glSamplers p
515 withArray (map glSamplerObject $ V.toList samplers) $ (glDeleteSamplers . fromIntegral . V.length $ glSamplers p)
517 with (glVAO p) $ (glDeleteVertexArrays 1) 516 with (glVAO p) $ (glDeleteVertexArrays 1)
518 517
519{- 518{-
@@ -730,6 +729,7 @@ renderFrame glp = do
730 GLSetProgram p -> glUseProgram p 729 GLSetProgram p -> glUseProgram p
731 GLSetSamplerUniform i tu ref -> glUniform1i i tu >> writeIORef ref tu 730 GLSetSamplerUniform i tu ref -> glUniform1i i tu >> writeIORef ref tu
732 GLSetTexture tu target tx -> glActiveTexture tu >> glBindTexture target tx 731 GLSetTexture tu target tx -> glActiveTexture tu >> glBindTexture target tx
732 GLSetSampler tu s -> glBindSampler tu s
733 GLClearRenderTarget vals -> clearRenderTarget vals 733 GLClearRenderTarget vals -> clearRenderTarget vals
734 GLGenerateMipMap tu target -> glActiveTexture tu >> glGenerateMipmap target 734 GLGenerateMipMap tu target -> glActiveTexture tu >> glGenerateMipmap target
735 GLRenderStream streamIdx progIdx -> do 735 GLRenderStream streamIdx progIdx -> do
@@ -790,10 +790,7 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of
790 let tex = textures ! t 790 let tex = textures ! t
791 modify (\s -> s {textureBinding = IM.insert tu tex $ textureBinding s}) 791 modify (\s -> s {textureBinding = IM.insert tu tex $ textureBinding s})
792 return $ GLSetTexture (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) (glTextureObject tex) 792 return $ GLSetTexture (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) (glTextureObject tex)
793{- 793 SetSampler tu s -> return $ GLSetSampler (GL_TEXTURE0 + fromIntegral tu) (maybe 0 (glSamplerObject . (samplers !)) s)
794 SetSampler tu s -> liftIO $ do
795 glBindSampler (fromIntegral tu) (samplerObject $ glSamplers glp ! s)
796-}
797 RenderSlot slot -> do 794 RenderSlot slot -> do
798 smpUnis <- samplerUniforms <$> get 795 smpUnis <- samplerUniforms <$> get
799 p <- currentProgram <$> get 796 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
163 163
164data GLSampler 164data GLSampler
165 = GLSampler 165 = GLSampler
166 { samplerObject :: GLuint 166 { glSamplerObject :: GLuint
167 } 167 }
168 168
169data GLRenderTarget 169data 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 @@
1{-# LANGUAGE RecordWildCards #-}
1module LambdaCube.GL.Util ( 2module LambdaCube.GL.Util (
2 queryUniforms, 3 queryUniforms,
3 queryStreams, 4 queryStreams,
@@ -23,6 +24,7 @@ module LambdaCube.GL.Util (
23 glGetIntegerv1, 24 glGetIntegerv1,
24 setSampler, 25 setSampler,
25 checkFBO, 26 checkFBO,
27 compileSampler,
26 compileTexture, 28 compileTexture,
27 primitiveToFetchPrimitive, 29 primitiveToFetchPrimitive,
28 primitiveToGLType, 30 primitiveToGLType,
@@ -503,21 +505,48 @@ edgeModeToGLType a = case a of
503 ClampToEdge -> GL_CLAMP_TO_EDGE 505 ClampToEdge -> GL_CLAMP_TO_EDGE
504 ClampToBorder -> GL_CLAMP_TO_BORDER 506 ClampToBorder -> GL_CLAMP_TO_BORDER
505 507
508data ParameterSetup
509 = ParameterSetup
510 { setParameteri :: GLenum -> GLint -> IO ()
511 , setParameterfv :: GLenum -> Ptr GLfloat -> IO ()
512 , setParameterIiv :: GLenum -> Ptr GLint -> IO ()
513 , setParameterIuiv :: GLenum -> Ptr GLuint -> IO ()
514 , setParameterf :: GLenum -> GLfloat -> IO ()
515 }
516
506setTextureSamplerParameters :: GLenum -> SamplerDescriptor -> IO () 517setTextureSamplerParameters :: GLenum -> SamplerDescriptor -> IO ()
507setTextureSamplerParameters t s = do 518setTextureSamplerParameters target = setParameters $ ParameterSetup
508 glTexParameteri t GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s 519 { setParameteri = glTexParameteri target
520 , setParameterfv = glTexParameterfv target
521 , setParameterIiv = glTexParameterIiv target
522 , setParameterIuiv = glTexParameterIuiv target
523 , setParameterf = glTexParameterf target
524 }
525
526setSamplerParameters :: GLuint -> SamplerDescriptor -> IO ()
527setSamplerParameters samplerObj = setParameters $ ParameterSetup
528 { setParameteri = glSamplerParameteri samplerObj
529 , setParameterfv = glSamplerParameterfv samplerObj
530 , setParameterIiv = glSamplerParameterIiv samplerObj
531 , setParameterIuiv = glSamplerParameterIuiv samplerObj
532 , setParameterf = glSamplerParameterf samplerObj
533 }
534
535setParameters :: ParameterSetup -> SamplerDescriptor -> IO ()
536setParameters ParameterSetup{..} s = do
537 setParameteri GL_TEXTURE_WRAP_S $ fromIntegral $ edgeModeToGLType $ samplerWrapS s
509 case samplerWrapT s of 538 case samplerWrapT s of
510 Nothing -> return () 539 Nothing -> return ()
511 Just a -> glTexParameteri t GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a 540 Just a -> setParameteri GL_TEXTURE_WRAP_T $ fromIntegral $ edgeModeToGLType a
512 case samplerWrapR s of 541 case samplerWrapR s of
513 Nothing -> return () 542 Nothing -> return ()
514 Just a -> glTexParameteri t GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a 543 Just a -> setParameteri GL_TEXTURE_WRAP_R $ fromIntegral $ edgeModeToGLType a
515 glTexParameteri t GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s 544 setParameteri GL_TEXTURE_MIN_FILTER $ fromIntegral $ filterToGLType $ samplerMinFilter s
516 glTexParameteri t GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s 545 setParameteri GL_TEXTURE_MAG_FILTER $ fromIntegral $ filterToGLType $ samplerMagFilter s
517 546
518 let setBColorV4F a = with a $ \p -> glTexParameterfv t GL_TEXTURE_BORDER_COLOR $ castPtr p 547 let setBColorV4F a = with a $ \p -> setParameterfv GL_TEXTURE_BORDER_COLOR $ castPtr p
519 setBColorV4I a = with a $ \p -> glTexParameterIiv t GL_TEXTURE_BORDER_COLOR $ castPtr p 548 setBColorV4I a = with a $ \p -> setParameterIiv GL_TEXTURE_BORDER_COLOR $ castPtr p
520 setBColorV4U a = with a $ \p -> glTexParameterIuiv t GL_TEXTURE_BORDER_COLOR $ castPtr p 549 setBColorV4U a = with a $ \p -> setParameterIuiv GL_TEXTURE_BORDER_COLOR $ castPtr p
521 case samplerBorderColor s of 550 case samplerBorderColor s of
522 -- float, word, int, red, rg, rgb, rgba 551 -- float, word, int, red, rg, rgb, rgba
523 VFloat a -> setBColorV4F $ V4 a 0 0 0 552 VFloat a -> setBColorV4F $ V4 a 0 0 0
@@ -538,16 +567,24 @@ setTextureSamplerParameters t s = do
538 567
539 case samplerMinLod s of 568 case samplerMinLod s of
540 Nothing -> return () 569 Nothing -> return ()
541 Just a -> glTexParameterf t GL_TEXTURE_MIN_LOD $ realToFrac a 570 Just a -> setParameterf GL_TEXTURE_MIN_LOD $ realToFrac a
542 case samplerMaxLod s of 571 case samplerMaxLod s of
543 Nothing -> return () 572 Nothing -> return ()
544 Just a -> glTexParameterf t GL_TEXTURE_MAX_LOD $ realToFrac a 573 Just a -> setParameterf GL_TEXTURE_MAX_LOD $ realToFrac a
545 glTexParameterf t GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s 574 setParameterf GL_TEXTURE_LOD_BIAS $ realToFrac $ samplerLodBias s
546 case samplerCompareFunc s of 575 case samplerCompareFunc s of
547 Nothing -> glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE 576 Nothing -> setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_NONE
548 Just a -> do 577 Just a -> do
549 glTexParameteri t GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE 578 setParameteri GL_TEXTURE_COMPARE_MODE $ fromIntegral GL_COMPARE_REF_TO_TEXTURE
550 glTexParameteri t GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a 579 setParameteri GL_TEXTURE_COMPARE_FUNC $ fromIntegral $ comparisonFunctionToGLType a
580
581compileSampler :: SamplerDescriptor -> IO GLSampler
582compileSampler s = do
583 so <- alloca $! \po -> glGenSamplers 1 po >> peek po
584 setSamplerParameters so s
585 return $ GLSampler
586 { glSamplerObject = so
587 }
551 588
552compileTexture :: TextureDescriptor -> IO GLTexture 589compileTexture :: TextureDescriptor -> IO GLTexture
553compileTexture txDescriptor = do 590compileTexture txDescriptor = do