    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Objects
    -- Copyright   :  (c) Sven Panne 2002-2019
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- This module corresponds to section 3.8.12 (Texture Objects) of the OpenGL 2.1
    -- specs.
    --
    --------------------------------------------------------------------------------

    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 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)
              return $ if o == defaultTextureObject then Nothing else Just 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
             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 unmarshalGLboolean allResident
                then return (texObjs, [])
                else do
                   tr <- fmap (zip texObjs) $ peekArray len residentBuf
                   let (resident, nonResident) = partition (unmarshalGLboolean . snd) tr
                   return (map fst resident, map fst 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

    --------------------------------------------------------------------------------

    -- | Generate mipmaps for the specified texture target. Note that from OpenGL
    -- 3.1 onwards you should use this function instead of the texture parameter
    -- 'Graphics.Rendering.OpenGL.GL.Texturing.Parameters.generateMipmap'.

    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