--------------------------------------------------------------------------------
-- |
-- 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