module Graphics.Caramia.Texture.Internal where
import Control.Monad.Catch
import Control.Monad.IO.Class
import qualified Graphics.Caramia.Buffer.Internal as Buf
import Graphics.Caramia.ImageFormats
import Graphics.Caramia.Internal.OpenGLCApi
import Graphics.Caramia.OpenGLResource
import Graphics.Caramia.Prelude
import Graphics.Caramia.Resource
data Texture = Texture
{ resource :: !(Resource Texture_)
, ordIndex :: !Unique
, viewSpecification :: !TextureSpecification }
deriving ( Typeable )
instance OpenGLResource GLuint Texture where
getRaw tex = do
Texture_ name <- getRaw (WrappedOpenGLResource $ resource tex)
return name
touch tex = touch (WrappedOpenGLResource $ resource tex)
newtype Texture_ = Texture_ GLuint
type TextureUnit = Int
instance Eq Texture where
tex1 == tex2 = resource tex1 == resource tex2
instance Ord Texture where
tex1 `compare` tex2 = ordIndex tex1 `compare` ordIndex tex2
data TextureSpecification = TextureSpecification
{ topology :: Topology
, imageFormat :: ImageFormat
, mipmapLevels :: Int
}
deriving ( Eq, Typeable )
data Topology =
Tex1D { width1D :: !Int }
| Tex2D { width2D :: !Int
, height2D :: !Int }
| Tex3D { width3D :: !Int
, height3D :: !Int
, depth3D :: !Int }
| Tex1DArray
{ width1DArray :: !Int
, layers1D :: !Int }
| Tex2DArray
{ width2DArray :: !Int
, height2DArray :: !Int
, layers2D :: !Int }
| Tex2DMultisample
{ width2DMS :: !Int
, height2DMS :: !Int
, samples2DMS :: !Int
, fixedSampleLocations2DMS :: !Bool }
| Tex2DMultisampleArray
{ width2DMSArray :: !Int
, height2DMSArray :: !Int
, layers2DMS :: !Int
, samples2DMSArray :: !Int
, fixedSampleLocations2DMSArray :: !Bool }
| TexCube { widthCube :: Int }
| TexBuffer { texBuffer :: !Buf.Buffer }
deriving ( Eq, Show, Typeable )
withBinding :: (MonadIO m, MonadMask m) => GLenum -> GLenum -> GLuint -> m a -> m a
withBinding tex tex_binding tex_name action = do
old <- gi tex_binding
finally
(glBindTexture tex tex_name >>
action)
(glBindTexture tex old)
bindingQueryPoint :: GLenum -> GLenum
bindingQueryPoint x =
if | x == GL_TEXTURE_1D -> GL_TEXTURE_BINDING_1D
| x == GL_TEXTURE_2D -> GL_TEXTURE_BINDING_2D
| x == GL_TEXTURE_3D -> GL_TEXTURE_BINDING_3D
| x == GL_TEXTURE_1D_ARRAY -> GL_TEXTURE_BINDING_1D_ARRAY
| x == GL_TEXTURE_2D_ARRAY -> GL_TEXTURE_BINDING_2D_ARRAY
| x == GL_TEXTURE_2D_MULTISAMPLE -> GL_TEXTURE_BINDING_2D_MULTISAMPLE
| x == GL_TEXTURE_2D_MULTISAMPLE_ARRAY -> GL_TEXTURE_BINDING_2D_MULTISAMPLE_ARRAY
| x == GL_TEXTURE_CUBE_MAP -> GL_TEXTURE_BINDING_CUBE_MAP
| x == GL_TEXTURE_BUFFER -> GL_TEXTURE_BINDING_BUFFER
| otherwise ->
error $ "bindingQueryPoint: unknown texture target: " <> show x
getTopologyBindPoints :: Topology -> (GLenum, GLenum)
getTopologyBindPoints = \case
Tex1D {..} -> (GL_TEXTURE_1D, GL_TEXTURE_BINDING_1D)
Tex2D {..} -> (GL_TEXTURE_2D, GL_TEXTURE_BINDING_2D)
Tex3D {..} -> (GL_TEXTURE_3D, GL_TEXTURE_BINDING_3D)
Tex1DArray {..} -> (GL_TEXTURE_1D_ARRAY, GL_TEXTURE_BINDING_1D_ARRAY)
Tex2DArray {..} -> (GL_TEXTURE_2D_ARRAY, GL_TEXTURE_BINDING_2D_ARRAY)
Tex2DMultisample {..} ->
(GL_TEXTURE_2D_MULTISAMPLE
,GL_TEXTURE_BINDING_2D_MULTISAMPLE)
Tex2DMultisampleArray {..} ->
(GL_TEXTURE_2D_MULTISAMPLE_ARRAY
,GL_TEXTURE_BINDING_2D_MULTISAMPLE_ARRAY)
TexCube {..} ->
(GL_TEXTURE_CUBE_MAP
,GL_TEXTURE_BINDING_CUBE_MAP)
TexBuffer {} ->
(GL_TEXTURE_BUFFER
,GL_TEXTURE_BINDING_BUFFER)
withBindingByTopology :: (MonadIO m, MonadMask m) => Texture -> (GLenum -> m a) -> m a
withBindingByTopology tex action =
withResource (resource tex) $ \(Texture_ name) ->
let (bind_target, bind_query) = getTopologyBindPoints topo
in withBinding bind_target bind_query name $ action bind_target
where
topo = topology $ viewSpecification tex
withTextureBinding :: (MonadIO m, MonadMask m) => Texture -> TextureUnit -> m a -> m a
withTextureBinding tex unit action = do
old_active <- gi GL_ACTIVE_TEXTURE
glActiveTexture (GL_TEXTURE0 + fromIntegral unit)
finally (withBindingByTopology tex $ const action) $
glActiveTexture old_active