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 =
IO (Maybe TextureObject)
-> (Maybe TextureObject -> IO ()) -> StateVar (Maybe TextureObject)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(do TextureObject
o <- (GLuint -> TextureObject) -> PName1I -> IO TextureObject
forall p a. GetPName1I p => (GLuint -> a) -> p -> IO a
forall a. (GLuint -> a) -> PName1I -> IO a
getEnum1 (GLuint -> TextureObject
TextureObject (GLuint -> TextureObject)
-> (GLuint -> GLuint) -> GLuint -> TextureObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLuint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (t -> PName1I
forall t. BindableTextureTarget t => t -> PName1I
marshalBindableTextureTargetPName1I t
t)
Maybe TextureObject -> IO (Maybe TextureObject)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TextureObject -> IO (Maybe TextureObject))
-> Maybe TextureObject -> IO (Maybe TextureObject)
forall a b. (a -> b) -> a -> b
$ if TextureObject
o TextureObject -> TextureObject -> Bool
forall a. Eq a => a -> a -> Bool
== TextureObject
defaultTextureObject then Maybe TextureObject
forall a. Maybe a
Nothing else TextureObject -> Maybe TextureObject
forall a. a -> Maybe a
Just TextureObject
o)
(GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindTexture (t -> GLuint
forall t. BindableTextureTarget t => t -> GLuint
marshalBindableTextureTarget t
t) (GLuint -> IO ())
-> (Maybe TextureObject -> GLuint) -> Maybe TextureObject -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureObject -> GLuint
textureID (TextureObject -> GLuint)
-> (Maybe TextureObject -> TextureObject)
-> Maybe TextureObject
-> GLuint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextureObject -> Maybe TextureObject -> TextureObject
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 =
GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$
(GLsizei -> Bool) -> t -> TexParameter -> GettableStateVar Bool
forall t a.
ParameterizedTextureTarget t =>
(GLsizei -> a) -> t -> TexParameter -> IO a
getTexParameteri GLsizei -> Bool
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
[GLuint]
-> (Int -> Ptr GLuint -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject])
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((TextureObject -> GLuint) -> [TextureObject] -> [GLuint]
forall a b. (a -> b) -> [a] -> [b]
map TextureObject -> GLuint
textureID [TextureObject]
texObjs) ((Int -> Ptr GLuint -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject]))
-> (Int -> Ptr GLuint -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject])
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr GLuint
texObjsBuf ->
Int
-> (Ptr GLboolean -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len ((Ptr GLboolean -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject]))
-> (Ptr GLboolean -> IO ([TextureObject], [TextureObject]))
-> IO ([TextureObject], [TextureObject])
forall a b. (a -> b) -> a -> b
$ \Ptr GLboolean
residentBuf -> do
GLboolean
allResident <-
GLsizei -> Ptr GLuint -> Ptr GLboolean -> IO GLboolean
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Ptr GLuint -> Ptr GLboolean -> m GLboolean
glAreTexturesResident (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr GLuint
texObjsBuf Ptr GLboolean
residentBuf
if GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GLboolean
allResident
then ([TextureObject], [TextureObject])
-> IO ([TextureObject], [TextureObject])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TextureObject]
texObjs, [])
else do
[(TextureObject, GLboolean)]
tr <- ([GLboolean] -> [(TextureObject, GLboolean)])
-> IO [GLboolean] -> IO [(TextureObject, GLboolean)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TextureObject] -> [GLboolean] -> [(TextureObject, GLboolean)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TextureObject]
texObjs) (IO [GLboolean] -> IO [(TextureObject, GLboolean)])
-> IO [GLboolean] -> IO [(TextureObject, GLboolean)]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr GLboolean -> IO [GLboolean]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr GLboolean
residentBuf
let ([(TextureObject, GLboolean)]
resident, [(TextureObject, GLboolean)]
nonResident) = ((TextureObject, GLboolean) -> Bool)
-> [(TextureObject, GLboolean)]
-> ([(TextureObject, GLboolean)], [(TextureObject, GLboolean)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean (GLboolean -> Bool)
-> ((TextureObject, GLboolean) -> GLboolean)
-> (TextureObject, GLboolean)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextureObject, GLboolean) -> GLboolean
forall a b. (a, b) -> b
snd) [(TextureObject, GLboolean)]
tr
([TextureObject], [TextureObject])
-> IO ([TextureObject], [TextureObject])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (((TextureObject, GLboolean) -> TextureObject)
-> [(TextureObject, GLboolean)] -> [TextureObject]
forall a b. (a -> b) -> [a] -> [b]
map (TextureObject, GLboolean) -> TextureObject
forall a b. (a, b) -> a
fst [(TextureObject, GLboolean)]
resident, ((TextureObject, GLboolean) -> TextureObject)
-> [(TextureObject, GLboolean)] -> [TextureObject]
forall a b. (a -> b) -> [a] -> [b]
map (TextureObject, GLboolean) -> TextureObject
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 = (TexturePriority -> TexturePriority)
-> (TexturePriority -> TexturePriority)
-> TexParameter
-> t
-> StateVar TexturePriority
forall t a.
ParameterizedTextureTarget t =>
(TexturePriority -> a)
-> (a -> TexturePriority) -> TexParameter -> t -> StateVar a
texParamf TexturePriority -> TexturePriority
forall a b. (Real a, Fractional b) => a -> b
realToFrac TexturePriority -> TexturePriority
forall a b. (Real a, Fractional b) => a -> b
realToFrac TexParameter
TexturePriority
prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()
prioritizeTextures :: [(TextureObject, TexturePriority)] -> IO ()
prioritizeTextures [(TextureObject, TexturePriority)]
tps =
[GLuint] -> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (((TextureObject, TexturePriority) -> GLuint)
-> [(TextureObject, TexturePriority)] -> [GLuint]
forall a b. (a -> b) -> [a] -> [b]
map (TextureObject -> GLuint
textureID (TextureObject -> GLuint)
-> ((TextureObject, TexturePriority) -> TextureObject)
-> (TextureObject, TexturePriority)
-> GLuint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextureObject, TexturePriority) -> TextureObject
forall a b. (a, b) -> a
fst) [(TextureObject, TexturePriority)]
tps) ((Int -> Ptr GLuint -> IO ()) -> IO ())
-> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr GLuint
texObjsBuf ->
[TexturePriority] -> (Ptr TexturePriority -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (((TextureObject, TexturePriority) -> TexturePriority)
-> [(TextureObject, TexturePriority)] -> [TexturePriority]
forall a b. (a -> b) -> [a] -> [b]
map (TextureObject, TexturePriority) -> TexturePriority
forall a b. (a, b) -> b
snd [(TextureObject, TexturePriority)]
tps) ((Ptr TexturePriority -> IO ()) -> IO ())
-> (Ptr TexturePriority -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
GLsizei -> Ptr GLuint -> Ptr TexturePriority -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLsizei -> Ptr GLuint -> Ptr TexturePriority -> m ()
glPrioritizeTextures (Int -> GLsizei
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' = GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glGenerateMipmap (GLuint -> IO ()) -> (t -> GLuint) -> t -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> GLuint
forall t. ParameterizedTextureTarget t => t -> GLuint
marshalParameterizedTextureTarget