{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureObject
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module for handling texture objects.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Texturing.TextureObject (
   TextureObject(..)
) where

import Control.Monad.IO.Class
import Data.ObjectName
import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )
import Graphics.Rendering.OpenGL.GL.DebugOutput
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL

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

newtype TextureObject = TextureObject { TextureObject -> GLuint
textureID :: GLuint }
   deriving ( TextureObject -> TextureObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureObject -> TextureObject -> Bool
$c/= :: TextureObject -> TextureObject -> Bool
== :: TextureObject -> TextureObject -> Bool
$c== :: TextureObject -> TextureObject -> Bool
Eq, Eq TextureObject
TextureObject -> TextureObject -> Bool
TextureObject -> TextureObject -> Ordering
TextureObject -> TextureObject -> TextureObject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TextureObject -> TextureObject -> TextureObject
$cmin :: TextureObject -> TextureObject -> TextureObject
max :: TextureObject -> TextureObject -> TextureObject
$cmax :: TextureObject -> TextureObject -> TextureObject
>= :: TextureObject -> TextureObject -> Bool
$c>= :: TextureObject -> TextureObject -> Bool
> :: TextureObject -> TextureObject -> Bool
$c> :: TextureObject -> TextureObject -> Bool
<= :: TextureObject -> TextureObject -> Bool
$c<= :: TextureObject -> TextureObject -> Bool
< :: TextureObject -> TextureObject -> Bool
$c< :: TextureObject -> TextureObject -> Bool
compare :: TextureObject -> TextureObject -> Ordering
$ccompare :: TextureObject -> TextureObject -> Ordering
Ord, Int -> TextureObject -> ShowS
[TextureObject] -> ShowS
TextureObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureObject] -> ShowS
$cshowList :: [TextureObject] -> ShowS
show :: TextureObject -> String
$cshow :: TextureObject -> String
showsPrec :: Int -> TextureObject -> ShowS
$cshowsPrec :: Int -> TextureObject -> ShowS
Show )

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

instance ObjectName TextureObject where
   isObjectName :: forall (m :: * -> *). MonadIO m => TextureObject -> m Bool
isObjectName = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => GLuint -> m GLboolean
glIsTexture forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureObject -> GLuint
textureID

   deleteObjectNames :: forall (m :: * -> *). MonadIO m => [TextureObject] -> m ()
deleteObjectNames [TextureObject]
textureObjects =
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
textureObjects) forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLuint -> m ()
glDeleteTextures forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance GeneratableObjectName TextureObject where
   genObjectNames :: forall (m :: * -> *). MonadIO m => Int -> m [TextureObject]
genObjectNames Int
n =
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n forall a b. (a -> b) -> a -> b
$ \Ptr GLuint
buf -> do
        forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLuint -> m ()
glGenTextures (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Ptr GLuint
buf
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map GLuint -> TextureObject
TextureObject) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr GLuint
buf

instance CanBeLabeled TextureObject where
   objectLabel :: TextureObject -> StateVar (Maybe String)
objectLabel = GLuint -> GLuint -> StateVar (Maybe String)
objectNameLabel GLuint
GL_TEXTURE forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureObject -> GLuint
textureID