module Graphics.Caramia.Texture.Internal where
import Graphics.Caramia.Prelude
import Graphics.Caramia.Resource
import Graphics.Caramia.Internal.OpenGLCApi
import qualified Graphics.Caramia.Buffer.Internal as Buf
import Graphics.Caramia.ImageFormats
import System.IO.Unsafe
import Control.Exception
data Texture = Texture
{ resource :: !(Resource Texture_)
, ordIndex :: !Int
, viewSpecification :: !TextureSpecification }
deriving ( Typeable )
newtype Texture_ = Texture_ GLuint
type TextureUnit = Int
ordIndices :: IORef Int
ordIndices = unsafePerformIO $ newIORef 0
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, Typeable )
withBinding :: GLenum -> GLenum -> GLuint -> IO a -> IO a
withBinding tex tex_binding tex_name action = do
old <- gi tex_binding
finally
(glBindTexture tex tex_name *>
action)
(glBindTexture tex old)
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 :: Texture -> (GLenum -> IO a) -> IO 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 :: Texture -> TextureUnit -> IO a -> IO 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