{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
ScopedTypeVariables, TypeFamilies, FlexibleContexts #-}
module Graphics.GLUtil.Textures where
import Control.Monad (forM_)
import Graphics.Rendering.OpenGL
import qualified Graphics.Rendering.OpenGL.GL.VertexArrays as GL
import Data.Array.Storable (StorableArray, withStorableArray)
import Data.ByteString.Internal (ByteString, toForeignPtr)
import Data.Vector.Storable (Vector, unsafeWith)
import Data.Word (Word8, Word16)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, plusPtr, castPtr, nullPtr)
import Foreign.Marshal.Array (withArray)
import Graphics.GLUtil.TypeMapping (HasGLType(..))
data TexColor = TexMono | TexRG | TexRGB | TexBGR | TexRGBA
data TexInfo a = TexInfo { TexInfo a -> GLsizei
texWidth :: GLsizei
, TexInfo a -> GLsizei
texHeight :: GLsizei
, TexInfo a -> TexColor
texColor :: TexColor
, TexInfo a -> a
texData :: a }
texInfo :: Int -> Int -> TexColor -> a -> TexInfo a
texInfo :: Int -> Int -> TexColor -> a -> TexInfo a
texInfo w :: Int
w h :: Int
h = GLsizei -> GLsizei -> TexColor -> a -> TexInfo a
forall a. GLsizei -> GLsizei -> TexColor -> a -> TexInfo a
TexInfo (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
class HasGLType (Elem a) => IsPixelData a where
type Elem a
withPixels :: a -> (Ptr (Elem a) -> IO c) -> IO c
instance HasGLType b => IsPixelData [b] where
type Elem [b] = b
withPixels :: [b] -> (Ptr (Elem [b]) -> IO c) -> IO c
withPixels = [b] -> (Ptr (Elem [b]) -> IO c) -> IO c
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray
instance HasGLType b => IsPixelData (Ptr b) where
type Elem (Ptr b) = b
withPixels :: Ptr b -> (Ptr (Elem (Ptr b)) -> IO c) -> IO c
withPixels = ((Ptr b -> IO c) -> Ptr b -> IO c)
-> Ptr b -> (Ptr b -> IO c) -> IO c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ptr b -> IO c) -> Ptr b -> IO c
forall a b. (a -> b) -> a -> b
($)
instance HasGLType b => IsPixelData (ForeignPtr b) where
type Elem (ForeignPtr b) = b
withPixels :: ForeignPtr b -> (Ptr (Elem (ForeignPtr b)) -> IO c) -> IO c
withPixels = ForeignPtr b -> (Ptr (Elem (ForeignPtr b)) -> IO c) -> IO c
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
instance HasGLType b => IsPixelData (StorableArray i b) where
type Elem (StorableArray i b) = b
withPixels :: StorableArray i b
-> (Ptr (Elem (StorableArray i b)) -> IO c) -> IO c
withPixels = StorableArray i b
-> (Ptr (Elem (StorableArray i b)) -> IO c) -> IO c
forall i e a. StorableArray i e -> (Ptr e -> IO a) -> IO a
withStorableArray
instance HasGLType b => IsPixelData (Vector b) where
type Elem (Vector b) = b
withPixels :: Vector b -> (Ptr (Elem (Vector b)) -> IO c) -> IO c
withPixels = Vector b -> (Ptr (Elem (Vector b)) -> IO c) -> IO c
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith
instance IsPixelData ByteString where
type Elem ByteString = Word8
withPixels :: ByteString -> (Ptr (Elem ByteString) -> IO c) -> IO c
withPixels b :: ByteString
b m :: Ptr (Elem ByteString) -> IO c
m = (ForeignPtr Word8, Int, Int) -> IO c
aux ((ForeignPtr Word8, Int, Int) -> IO c)
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString
-> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (ByteString -> IO c) -> ByteString -> IO c
forall a b. (a -> b) -> a -> b
$ ByteString
b
where aux :: (ForeignPtr Word8, Int, Int) -> IO c
aux (fp :: ForeignPtr Word8
fp,o :: Int
o,_) = ForeignPtr Word8 -> (Ptr Word8 -> IO c) -> IO c
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO c) -> IO c) -> (Ptr Word8 -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
Ptr (Elem ByteString) -> IO c
m (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
o)
newtype ShortString = ShortString ByteString
instance IsPixelData ShortString where
type Elem ShortString = Word16
withPixels :: ShortString -> (Ptr (Elem ShortString) -> IO c) -> IO c
withPixels (ShortString b :: ByteString
b) m :: Ptr (Elem ShortString) -> IO c
m = (ForeignPtr Word8, Int, Int) -> IO c
aux((ForeignPtr Word8, Int, Int) -> IO c)
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString
-> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (ByteString -> IO c) -> ByteString -> IO c
forall a b. (a -> b) -> a -> b
$ ByteString
b
where aux :: (ForeignPtr Word8, Int, Int) -> IO c
aux (fp :: ForeignPtr Word8
fp,o :: Int
o,_) = ForeignPtr Word8 -> (Ptr Word8 -> IO c) -> IO c
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO c) -> IO c) -> (Ptr Word8 -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
Ptr (Elem ShortString) -> IO c
m (Ptr Word16 -> Int -> Ptr Word16
forall a b. Ptr a -> Int -> Ptr b
plusPtr (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p :: Ptr Word16) Int
o)
freshTexture :: forall a proxy. HasGLType a
=> Int -> Int -> TexColor -> proxy a -> IO TextureObject
freshTexture :: Int -> Int -> TexColor -> proxy a -> IO TextureObject
freshTexture w :: Int
w h :: Int
h c :: TexColor
c _ = TexInfo (Ptr a) -> IO TextureObject
forall a. IsPixelData a => TexInfo a -> IO TextureObject
loadTexture (TexInfo (Ptr a) -> IO TextureObject)
-> TexInfo (Ptr a) -> IO TextureObject
forall a b. (a -> b) -> a -> b
$ Int -> Int -> TexColor -> Ptr a -> TexInfo (Ptr a)
forall a. Int -> Int -> TexColor -> a -> TexInfo a
texInfo Int
w Int
h TexColor
c (Ptr a
forall a. Ptr a
nullPtr::Ptr a)
freshTextureWord8 :: Int -> Int -> TexColor -> IO TextureObject
freshTextureWord8 :: Int -> Int -> TexColor -> IO TextureObject
freshTextureWord8 w :: Int
w h :: Int
h c :: TexColor
c = TexInfo (Ptr Word8) -> IO TextureObject
forall a. IsPixelData a => TexInfo a -> IO TextureObject
loadTexture (TexInfo (Ptr Word8) -> IO TextureObject)
-> TexInfo (Ptr Word8) -> IO TextureObject
forall a b. (a -> b) -> a -> b
$ Int -> Int -> TexColor -> Ptr Word8 -> TexInfo (Ptr Word8)
forall a. Int -> Int -> TexColor -> a -> TexInfo a
texInfo Int
w Int
h TexColor
c (Ptr Word8
forall a. Ptr a
nullPtr::Ptr Word8)
freshTextureFloat :: Int -> Int -> TexColor -> IO TextureObject
freshTextureFloat :: Int -> Int -> TexColor -> IO TextureObject
freshTextureFloat w :: Int
w h :: Int
h c :: TexColor
c = TexInfo (Ptr GLfloat) -> IO TextureObject
forall a. IsPixelData a => TexInfo a -> IO TextureObject
loadTexture (TexInfo (Ptr GLfloat) -> IO TextureObject)
-> TexInfo (Ptr GLfloat) -> IO TextureObject
forall a b. (a -> b) -> a -> b
$ Int -> Int -> TexColor -> Ptr GLfloat -> TexInfo (Ptr GLfloat)
forall a. Int -> Int -> TexColor -> a -> TexInfo a
texInfo Int
w Int
h TexColor
c (Ptr GLfloat
forall a. Ptr a
nullPtr::Ptr GLfloat)
loadTexture :: IsPixelData a => TexInfo a -> IO TextureObject
loadTexture :: TexInfo a -> IO TextureObject
loadTexture tex :: TexInfo a
tex = do [obj :: TextureObject
obj] <- Int -> IO [TextureObject]
forall a (m :: * -> *).
(GeneratableObjectName a, MonadIO m) =>
Int -> m [a]
genObjectNames 1
TextureObject -> TexInfo a -> IO ()
forall a. IsPixelData a => TextureObject -> TexInfo a -> IO ()
reloadTexture TextureObject
obj TexInfo a
tex
TextureObject -> IO TextureObject
forall (m :: * -> *) a. Monad m => a -> m a
return TextureObject
obj
reloadTexture :: forall a. IsPixelData a =>
TextureObject -> TexInfo a -> IO ()
reloadTexture :: TextureObject -> TexInfo a -> IO ()
reloadTexture obj :: TextureObject
obj tex :: TexInfo a
tex = do TextureTarget2D -> StateVar (Maybe TextureObject)
forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding TextureTarget2D
Texture2D StateVar (Maybe TextureObject) -> Maybe TextureObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= TextureObject -> Maybe TextureObject
forall a. a -> Maybe a
Just TextureObject
obj
TexColor -> IO ()
loadTex (TexColor -> IO ()) -> TexColor -> IO ()
forall a b. (a -> b) -> a -> b
$ TexInfo a -> TexColor
forall a. TexInfo a -> TexColor
texColor TexInfo a
tex
where loadTex :: TexColor -> IO ()
loadTex TexMono = case DataType
pixelType of
GL.UnsignedShort -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
Luminance16 PixelFormat
Luminance
GL.Float -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
R32F PixelFormat
Red
GL.HalfFloat -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
R16F PixelFormat
Red
GL.UnsignedByte -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
R8 PixelFormat
Red
_ -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
Luminance' PixelFormat
Luminance
loadTex TexRG = case DataType
pixelType of
GL.UnsignedShort -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG16 PixelFormat
RGInteger
GL.Float -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG32F PixelFormat
RG
GL.HalfFloat -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG16F PixelFormat
RG
GL.UnsignedByte -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG8UI PixelFormat
RGInteger
GL.Byte -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG8I PixelFormat
RGInteger
GL.Int -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG32I PixelFormat
RGInteger
GL.UnsignedInt -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RG32UI PixelFormat
RGInteger
_ -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error "Unknown pixelType for TexRG"
loadTex TexRGB = PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA' PixelFormat
RGB
loadTex TexBGR = PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA' PixelFormat
BGR
loadTex TexRGBA = case DataType
pixelType of
GL.UnsignedShort -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA16 PixelFormat
RGBA
GL.Float -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA32F PixelFormat
RGBA
GL.HalfFloat -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA16F PixelFormat
RGBA
GL.Int -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA32I PixelFormat
RGBAInteger
GL.UnsignedInt -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA32UI PixelFormat
RGBAInteger
_ -> PixelInternalFormat -> PixelFormat -> IO ()
loadAux PixelInternalFormat
RGBA' PixelFormat
RGBA
sz :: TextureSize2D
sz = GLsizei -> GLsizei -> TextureSize2D
TextureSize2D (TexInfo a -> GLsizei
forall a. TexInfo a -> GLsizei
texWidth TexInfo a
tex) (TexInfo a -> GLsizei
forall a. TexInfo a -> GLsizei
texHeight TexInfo a
tex)
pixelType :: DataType
pixelType = Elem a -> DataType
forall a. HasGLType a => a -> DataType
glType (Elem a
forall a. HasCallStack => a
undefined::Elem a)
loadAux :: PixelInternalFormat -> PixelFormat -> IO ()
loadAux i :: PixelInternalFormat
i e :: PixelFormat
e = a -> (Ptr (Elem a) -> IO ()) -> IO ()
forall a c. IsPixelData a => a -> (Ptr (Elem a) -> IO c) -> IO c
withPixels (TexInfo a -> a
forall a. TexInfo a -> a
texData TexInfo a
tex) ((Ptr (Elem a) -> IO ()) -> IO ())
-> (Ptr (Elem a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
(TextureTarget2D
-> Proxy
-> GLsizei
-> PixelInternalFormat
-> TextureSize2D
-> GLsizei
-> PixelData (Elem a)
-> IO ()
forall t a.
TwoDimensionalTextureTarget t =>
t
-> Proxy
-> GLsizei
-> PixelInternalFormat
-> TextureSize2D
-> GLsizei
-> PixelData a
-> IO ()
texImage2D TextureTarget2D
Texture2D Proxy
NoProxy 0 PixelInternalFormat
i TextureSize2D
sz 0 (PixelData (Elem a) -> IO ())
-> (Ptr (Elem a) -> PixelData (Elem a)) -> Ptr (Elem a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PixelFormat -> DataType -> Ptr (Elem a) -> PixelData (Elem a)
forall a. PixelFormat -> DataType -> Ptr a -> PixelData a
PixelData PixelFormat
e DataType
pixelType)
texture2DWrap :: StateVar (Repetition, Clamping)
texture2DWrap :: StateVar (Repetition, Clamping)
texture2DWrap = IO (Repetition, Clamping)
-> ((Repetition, Clamping) -> IO ())
-> StateVar (Repetition, Clamping)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (StateVar (Repetition, Clamping) -> IO (Repetition, Clamping)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (TextureTarget2D
-> TextureCoordName -> StateVar (Repetition, Clamping)
forall t.
ParameterizedTextureTarget t =>
t -> TextureCoordName -> StateVar (Repetition, Clamping)
textureWrapMode TextureTarget2D
Texture2D TextureCoordName
S))
([TextureCoordName] -> (TextureCoordName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TextureCoordName
S,TextureCoordName
T] ((TextureCoordName -> IO ()) -> IO ())
-> ((Repetition, Clamping) -> TextureCoordName -> IO ())
-> (Repetition, Clamping)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repetition, Clamping) -> TextureCoordName -> IO ()
forall (m :: * -> *).
MonadIO m =>
(Repetition, Clamping) -> TextureCoordName -> m ()
aux)
where aux :: (Repetition, Clamping) -> TextureCoordName -> m ()
aux x :: (Repetition, Clamping)
x d :: TextureCoordName
d = TextureTarget2D
-> TextureCoordName -> StateVar (Repetition, Clamping)
forall t.
ParameterizedTextureTarget t =>
t -> TextureCoordName -> StateVar (Repetition, Clamping)
textureWrapMode TextureTarget2D
Texture2D TextureCoordName
d StateVar (Repetition, Clamping) -> (Repetition, Clamping) -> m ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (Repetition, Clamping)
x
texture3DWrap :: StateVar (Repetition, Clamping)
texture3DWrap :: StateVar (Repetition, Clamping)
texture3DWrap = IO (Repetition, Clamping)
-> ((Repetition, Clamping) -> IO ())
-> StateVar (Repetition, Clamping)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (StateVar (Repetition, Clamping) -> IO (Repetition, Clamping)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (TextureTarget2D
-> TextureCoordName -> StateVar (Repetition, Clamping)
forall t.
ParameterizedTextureTarget t =>
t -> TextureCoordName -> StateVar (Repetition, Clamping)
textureWrapMode TextureTarget2D
Texture2D TextureCoordName
S))
([TextureCoordName] -> (TextureCoordName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TextureCoordName
S,TextureCoordName
T,TextureCoordName
R] ((TextureCoordName -> IO ()) -> IO ())
-> ((Repetition, Clamping) -> TextureCoordName -> IO ())
-> (Repetition, Clamping)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repetition, Clamping) -> TextureCoordName -> IO ()
forall (m :: * -> *).
MonadIO m =>
(Repetition, Clamping) -> TextureCoordName -> m ()
aux)
where aux :: (Repetition, Clamping) -> TextureCoordName -> m ()
aux x :: (Repetition, Clamping)
x d :: TextureCoordName
d = TextureTarget2D
-> TextureCoordName -> StateVar (Repetition, Clamping)
forall t.
ParameterizedTextureTarget t =>
t -> TextureCoordName -> StateVar (Repetition, Clamping)
textureWrapMode TextureTarget2D
Texture2D TextureCoordName
d StateVar (Repetition, Clamping) -> (Repetition, Clamping) -> m ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= (Repetition, Clamping)
x
withTextures :: BindableTextureTarget t => t -> [TextureObject] -> IO a -> IO a
withTextures :: t -> [TextureObject] -> IO a -> IO a
withTextures tt :: t
tt ts :: [TextureObject]
ts m :: IO a
m = do ((TextureObject, GLuint) -> IO ())
-> [(TextureObject, GLuint)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TextureObject, GLuint) -> IO ()
aux ([TextureObject] -> [GLuint] -> [(TextureObject, GLuint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TextureObject]
ts [0..])
a
r <- IO a
m
GLuint -> [TextureObject] -> IO ()
cleanup 0 [TextureObject]
ts
StateVar TextureUnit
activeTexture StateVar TextureUnit -> TextureUnit -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLuint -> TextureUnit
TextureUnit 0
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
where aux :: (TextureObject, GLuint) -> IO ()
aux (t :: TextureObject
t,i :: GLuint
i) = do StateVar TextureUnit
activeTexture StateVar TextureUnit -> TextureUnit -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLuint -> TextureUnit
TextureUnit GLuint
i
t -> StateVar (Maybe TextureObject)
forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding t
tt StateVar (Maybe TextureObject) -> Maybe TextureObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= TextureObject -> Maybe TextureObject
forall a. a -> Maybe a
Just TextureObject
t
cleanup :: GLuint -> [TextureObject] -> IO ()
cleanup _ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cleanup i :: GLuint
i (_:ts' :: [TextureObject]
ts') = do StateVar TextureUnit
activeTexture StateVar TextureUnit -> TextureUnit -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLuint -> TextureUnit
TextureUnit GLuint
i
t -> StateVar (Maybe TextureObject)
forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding t
tt StateVar (Maybe TextureObject) -> Maybe TextureObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Maybe TextureObject
forall a. Maybe a
Nothing
GLuint -> [TextureObject] -> IO ()
cleanup (GLuint
iGLuint -> GLuint -> GLuint
forall a. Num a => a -> a -> a
+1) [TextureObject]
ts'
withTextures2D :: [TextureObject] -> IO a -> IO a
withTextures2D :: [TextureObject] -> IO a -> IO a
withTextures2D = TextureTarget2D -> [TextureObject] -> IO a -> IO a
forall t a.
BindableTextureTarget t =>
t -> [TextureObject] -> IO a -> IO a
withTextures TextureTarget2D
Texture2D
withTexturesAt :: BindableTextureTarget t
=> t -> [(TextureObject,GLuint)] -> IO a -> IO a
withTexturesAt :: t -> [(TextureObject, GLuint)] -> IO a -> IO a
withTexturesAt tt :: t
tt ts :: [(TextureObject, GLuint)]
ts m :: IO a
m = do ((TextureObject, GLuint) -> IO ())
-> [(TextureObject, GLuint)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TextureObject, GLuint) -> IO ()
aux [(TextureObject, GLuint)]
ts
a
r <- IO a
m
((TextureObject, GLuint) -> IO ())
-> [(TextureObject, GLuint)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GLuint -> IO ()
cleanup (GLuint -> IO ())
-> ((TextureObject, GLuint) -> GLuint)
-> (TextureObject, GLuint)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextureObject, GLuint) -> GLuint
forall a b. (a, b) -> b
snd) [(TextureObject, GLuint)]
ts
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
where aux :: (TextureObject, GLuint) -> IO ()
aux (t :: TextureObject
t,i :: GLuint
i) = do StateVar TextureUnit
activeTexture StateVar TextureUnit -> TextureUnit -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLuint -> TextureUnit
TextureUnit GLuint
i
t -> StateVar (Maybe TextureObject)
forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding t
tt StateVar (Maybe TextureObject) -> Maybe TextureObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= TextureObject -> Maybe TextureObject
forall a. a -> Maybe a
Just TextureObject
t
cleanup :: GLuint -> IO ()
cleanup i :: GLuint
i = do StateVar TextureUnit
activeTexture StateVar TextureUnit -> TextureUnit -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLuint -> TextureUnit
TextureUnit GLuint
i
t -> StateVar (Maybe TextureObject)
forall t.
BindableTextureTarget t =>
t -> StateVar (Maybe TextureObject)
textureBinding t
tt StateVar (Maybe TextureObject) -> Maybe TextureObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Maybe TextureObject
forall a. Maybe a
Nothing