module Graphics.Rendering.OpenGL.GL.Texturing.Objects (
TextureObject(TextureObject), textureBinding,
textureResident, areTexturesResident,
TexturePriority, texturePriority, prioritizeTextures,
generateMipmap'
) where
import Data.List
import Data.Maybe (fromMaybe)
import Data.StateVar
import Foreign.Marshal.Array
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject
import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
import Graphics.GL
textureBinding :: BindableTextureTarget t => t -> StateVar (Maybe TextureObject)
textureBinding :: forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding t
t =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(do TextureObject
o <- forall p a. GetPName1I p => (GLuint -> a) -> p -> IO a
getEnum1 (GLuint -> TextureObject
TextureObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall t. BindableTextureTarget t => t -> PName1I
marshalBindableTextureTargetPName1I t
t)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if TextureObject
o forall a. Eq a => a -> a -> Bool
== TextureObject
defaultTextureObject then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just TextureObject
o)
(forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindTexture (forall t. BindableTextureTarget t => t -> GLuint
marshalBindableTextureTarget t
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureObject -> GLuint
textureID forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe TextureObject
defaultTextureObject))
defaultTextureObject :: TextureObject
defaultTextureObject :: TextureObject
defaultTextureObject = GLuint -> TextureObject
TextureObject GLuint
0
textureResident :: ParameterizedTextureTarget t => t -> GettableStateVar Bool
textureResident :: forall t.
ParameterizedTextureTarget t =>
t -> GettableStateVar Bool
textureResident t
t =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
forall t a.
ParameterizedTextureTarget t =>
(GLsizei -> a) -> t -> TexParameter -> IO a
getTexParameteri forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean t
t TexParameter
TextureResident
areTexturesResident :: [TextureObject] -> IO ([TextureObject],[TextureObject])
areTexturesResident :: [TextureObject] -> IO ([TextureObject], [TextureObject])
areTexturesResident [TextureObject]
texObjs = do
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map TextureObject -> GLuint
textureID [TextureObject]
texObjs) forall a b. (a -> b) -> a -> b
$ \Int
len Ptr GLuint
texObjsBuf ->
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len forall a b. (a -> b) -> a -> b
$ \Ptr GLboolean
residentBuf -> do
GLboolean
allResident <-
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Ptr GLuint -> Ptr GLboolean -> m GLboolean
glAreTexturesResident (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr GLuint
texObjsBuf Ptr GLboolean
residentBuf
if forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GLboolean
allResident
then forall (m :: * -> *) a. Monad m => a -> m a
return ([TextureObject]
texObjs, [])
else do
[(TextureObject, GLboolean)]
tr <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. [a] -> [b] -> [(a, b)]
zip [TextureObject]
texObjs) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr GLboolean
residentBuf
let ([(TextureObject, GLboolean)]
resident, [(TextureObject, GLboolean)]
nonResident) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(TextureObject, GLboolean)]
tr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TextureObject, GLboolean)]
resident, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TextureObject, GLboolean)]
nonResident)
type TexturePriority = GLclampf
texturePriority :: ParameterizedTextureTarget t => t -> StateVar TexturePriority
texturePriority :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar TexturePriority
texturePriority = forall t a.
ParameterizedTextureTarget t =>
(TexturePriority -> a)
-> (a -> TexturePriority) -> TexParameter -> t -> StateVar a
texParamf forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (Real a, Fractional b) => a -> b
realToFrac TexParameter
TexturePriority
prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()
prioritizeTextures :: [(TextureObject, TexturePriority)] -> IO ()
prioritizeTextures [(TextureObject, TexturePriority)]
tps =
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map (TextureObject -> GLuint
textureID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(TextureObject, TexturePriority)]
tps) forall a b. (a -> b) -> a -> b
$ \Int
len Ptr GLuint
texObjsBuf ->
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(TextureObject, TexturePriority)]
tps) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Ptr GLuint -> Ptr TexturePriority -> m ()
glPrioritizeTextures (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr GLuint
texObjsBuf
generateMipmap' :: ParameterizedTextureTarget t => t -> IO ()
generateMipmap' :: forall t. ParameterizedTextureTarget t => t -> IO ()
generateMipmap' = forall (m :: * -> *). MonadIO m => GLuint -> m ()
glGenerateMipmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ParameterizedTextureTarget t => t -> GLuint
marshalParameterizedTextureTarget