{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}
module Graphics.GPipe.Internal.Texture where

import           Control.Exception                            (throwIO)
import           Control.Monad                                (foldM, forM_,
                                                               void, when)
import           Control.Monad.Exception                      (MonadAsyncException,
                                                               bracket)
import           Control.Monad.IO.Class                       (MonadIO, liftIO)
import           Control.Monad.Trans.Class                    (lift)
import           Data.IORef                                   (IORef, newIORef,
                                                               readIORef)
import           Data.IntMap.Polymorphic.Lazy                 (insert)
import           Data.Text.Lazy                               (Text)
import           Foreign.Marshal.Alloc                        (alloca,
                                                               allocaBytes,
                                                               free,
                                                               mallocBytes)
import           Foreign.Marshal.Utils                        (with)
import           Foreign.Ptr                                  (minusPtr,
                                                               nullPtr, plusPtr,
                                                               wordPtrToPtr)
import           Foreign.Storable                             (Storable (peek))
import           Graphics.GL.Core45
import           Graphics.GL.Ext.EXT.TextureFilterAnisotropic
import           Graphics.GL.Types                            (GLenum, GLuint)
import           Graphics.GPipe.Internal.Buffer               (Buffer (bufElementSize, bufName, bufferLength),
                                                               BufferColor,
                                                               BufferFormat (..),
                                                               BufferStartPos,
                                                               bufferWriteInternal,
                                                               makeBuffer)
import           Graphics.GPipe.Internal.Compiler             (Binding,
                                                               RenderIOState (samplerNameToRenderIO))
import           Graphics.GPipe.Internal.Context              (ContextHandler,
                                                               ContextT,
                                                               FBOKey (FBOKey),
                                                               GPipeException (GPipeException),
                                                               Render (Render),
                                                               addContextFinalizer,
                                                               addFBOTextureFinalizer,
                                                               liftNonWinContextAsyncIO,
                                                               liftNonWinContextIO,
                                                               registerRenderWriteTexture)
import           Graphics.GPipe.Internal.Expr                 (ExprM, F, FFloat,
                                                               S (..),
                                                               SType (..),
                                                               scalarS, tshow,
                                                               useSampler,
                                                               vec2S, vec3S,
                                                               vec4S)
import           Graphics.GPipe.Internal.Format               (ColorRenderable,
                                                               ColorSampleable (..),
                                                               DepthRenderable,
                                                               Format,
                                                               TextureFormat (..),
                                                               getGlInternalFormat)
import           Graphics.GPipe.Internal.IDs                  (SamplerId (..))
import           Graphics.GPipe.Internal.Shader               (Shader (..),
                                                               ShaderM,
                                                               getNewName,
                                                               modifyRenderIO)
import           Linear.V2                                    (V2 (..))
import           Linear.V3                                    (V3 (..))
import           Linear.V4                                    (V4 (..))

data Texture1D os a = Texture1D TexName Size1 MaxLevels
data Texture1DArray os a = Texture1DArray TexName Size2 MaxLevels
data Texture2D os a = Texture2D TexName Size2 MaxLevels
                    | RenderBuffer2D TexName Size2
data Texture2DArray os a = Texture2DArray TexName Size3 MaxLevels
data Texture3D os a = Texture3D TexName Size3 MaxLevels
data TextureCube os a = TextureCube TexName Size1 MaxLevels

type MaxLevels = Int

type Size1 = Int
type Size2 = V2 Int
type Size3 = V3 Int

getNewSamplerId :: ShaderM s SamplerId
getNewSamplerId :: ShaderM s SamplerId
getNewSamplerId = Int -> SamplerId
SamplerId (Int -> SamplerId) -> ShaderM s Int -> ShaderM s SamplerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShaderM s Int
forall s. ShaderM s Int
getNewName

newTexture1D :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT ctx os m (Texture1D os (Format c))
newTexture1DArray :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT ctx os m (Texture1DArray os (Format c))
newTexture2D :: forall ctx w os f c m. (ContextHandler ctx, TextureFormat c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT ctx os m (Texture2D os (Format c))
newTexture2DArray :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT ctx os m (Texture2DArray os (Format c))
newTexture3D :: forall ctx w os f c m. (ContextHandler ctx, ColorRenderable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT ctx os m (Texture3D os (Format c))
newTextureCube :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT ctx os m (TextureCube os (Format c))

newTexture1D :: Format c
-> Int -> Int -> ContextT ctx os m (Texture1D os (Format c))
newTexture1D Format c
f Int
s Int
mx | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Texture1D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture1D, negative size"
                    | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (Texture1D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture1D, non-positive MaxLevels"
                    | Bool
otherwise = do
                        Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_TEXTURE_SIZE
                        if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                          then IO (Texture1D os (Format c))
-> ContextT ctx os m (Texture1D os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture1D os (Format c))
 -> ContextT ctx os m (Texture1D os (Format c)))
-> IO (Texture1D os (Format c))
-> ContextT ctx os m (Texture1D os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture1D os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture1D os (Format c)))
-> GPipeException -> IO (Texture1D os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture1D, size larger than maximum supported by graphics driver"
                          else do
                            TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                            let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                                glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                                ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels Int
s)
                                tex :: Texture1D os (Format c)
tex = TexName -> Int -> Int -> Texture1D os (Format c)
forall os a. TexName -> Int -> Int -> Texture1D os a
Texture1D TexName
t Int
s Int
ls
                            IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                                TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
                                [(Int, GLint)] -> ((Int, GLint) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [GLint] -> [(Int, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Texture1D os (Format c) -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os (Format c)
tex) [GLint
0..]) (((Int, GLint) -> IO ()) -> IO ())
-> ((Int, GLint) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
lw, GLint
l) ->
                                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage1D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                                GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            Texture1D os (Format c)
-> ContextT ctx os m (Texture1D os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return Texture1D os (Format c)
tex
newTexture1DArray :: Format c
-> Size2 -> Int -> ContextT ctx os m (Texture1DArray os (Format c))
newTexture1DArray Format c
f s :: Size2
s@(V2 Int
w Int
sl) Int
mx
                    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Texture1DArray os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture1DArray, negative size"
                    | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (Texture1DArray os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture1DArray, non-positive MaxLevels"
                    | Bool
otherwise = do
                            Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_TEXTURE_SIZE
                            if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                              then IO (Texture1DArray os (Format c))
-> ContextT ctx os m (Texture1DArray os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture1DArray os (Format c))
 -> ContextT ctx os m (Texture1DArray os (Format c)))
-> IO (Texture1DArray os (Format c))
-> ContextT ctx os m (Texture1DArray os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture1DArray os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture1DArray os (Format c)))
-> GPipeException -> IO (Texture1DArray os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture1DArray, size larger than maximum supported by graphics driver"
                              else do
                                TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                                let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                                    glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                                    ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels Int
w)
                                    tex :: Texture1DArray os (Format c)
tex = TexName -> Size2 -> Int -> Texture1DArray os (Format c)
forall os a. TexName -> Size2 -> Int -> Texture1DArray os a
Texture1DArray TexName
t Size2
s Int
ls
                                IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                                    TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                                    [(Size2, GLint)] -> ((Size2, GLint) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Size2] -> [GLint] -> [(Size2, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Texture1DArray os (Format c) -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os (Format c)
tex) [GLint
0..]) (((Size2, GLint) -> IO ()) -> IO ())
-> ((Size2, GLint) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(V2 Int
lw Int
_, GLint
l) ->
                                        GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sl) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                                    GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                Texture1DArray os (Format c)
-> ContextT ctx os m (Texture1DArray os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return Texture1DArray os (Format c)
tex
newTexture2D :: Format c
-> Size2 -> Int -> ContextT ctx os m (Texture2D os (Format c))
newTexture2D Format c
f s :: Size2
s@(V2 Int
w Int
h) Int
mx | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Texture2D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture2D, negative size"
                             | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (Texture2D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture2D, non-positive MaxLevels"
                             | c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c) GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
forall a. (Eq a, Num a) => a
GL_STENCIL_INDEX = do
                                Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_RENDERBUFFER_SIZE
                                if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                                  then IO (Texture2D os (Format c))
-> ContextT ctx os m (Texture2D os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture2D os (Format c))
 -> ContextT ctx os m (Texture2D os (Format c)))
-> IO (Texture2D os (Format c))
-> ContextT ctx os m (Texture2D os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture2D os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture2D os (Format c)))
-> GPipeException -> IO (Texture2D os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture2D, size larger than maximum supported by graphics driver"
                                  else do
                                    TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeRenderBuff
                                    IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$
                                       GLenum -> GLenum -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> GLint -> m ()
glRenderbufferStorage GLenum
forall a. (Eq a, Num a) => a
GL_RENDERBUFFER (Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                                    Texture2D os (Format c)
-> ContextT ctx os m (Texture2D os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Texture2D os (Format c)
 -> ContextT ctx os m (Texture2D os (Format c)))
-> Texture2D os (Format c)
-> ContextT ctx os m (Texture2D os (Format c))
forall a b. (a -> b) -> a -> b
$ TexName -> Size2 -> Texture2D os (Format c)
forall os a. TexName -> Size2 -> Texture2D os a
RenderBuffer2D TexName
t Size2
s
                             | Bool
otherwise = do
                                Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_TEXTURE_SIZE
                                if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                                  then IO (Texture2D os (Format c))
-> ContextT ctx os m (Texture2D os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture2D os (Format c))
 -> ContextT ctx os m (Texture2D os (Format c)))
-> IO (Texture2D os (Format c))
-> ContextT ctx os m (Texture2D os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture2D os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture2D os (Format c)))
-> GPipeException -> IO (Texture2D os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture2D, size larger than maximum supported by graphics driver"
                                  else do
                                    TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                                    let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                                        glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                                        ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
w Int
h))
                                        tex :: Texture2D os (Format c)
tex = TexName -> Size2 -> Int -> Texture2D os (Format c)
forall os a. TexName -> Size2 -> Int -> Texture2D os a
Texture2D TexName
t Size2
s Int
ls
                                    IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                                        TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
                                        [(Size2, GLint)] -> ((Size2, GLint) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Size2] -> [GLint] -> [(Size2, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Texture2D os (Format c) -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os (Format c)
tex) [GLint
0..]) (((Size2, GLint) -> IO ()) -> IO ())
-> ((Size2, GLint) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(V2 Int
lw Int
lh, GLint
l) ->
                                            GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lh) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                                        GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                    Texture2D os (Format c)
-> ContextT ctx os m (Texture2D os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return Texture2D os (Format c)
tex

newTexture2DArray :: Format c
-> Size3 -> Int -> ContextT ctx os m (Texture2DArray os (Format c))
newTexture2DArray Format c
f s :: Size3
s@(V3 Int
w Int
h Int
sl) Int
mx
                                | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Texture2DArray os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture2DArray, negative size"
                                | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (Texture2DArray os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture2DArray, non-positive MaxLevels"
                                | Bool
otherwise = do
                    Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_TEXTURE_SIZE
                    if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                      then IO (Texture2DArray os (Format c))
-> ContextT ctx os m (Texture2DArray os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture2DArray os (Format c))
 -> ContextT ctx os m (Texture2DArray os (Format c)))
-> IO (Texture2DArray os (Format c))
-> ContextT ctx os m (Texture2DArray os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture2DArray os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture2DArray os (Format c)))
-> GPipeException -> IO (Texture2DArray os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture2DArray, size larger than maximum supported by graphics driver"
                      else do
                        TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                        let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                            glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                            ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
w Int
h))
                            tex :: Texture2DArray os (Format c)
tex = TexName -> Size3 -> Int -> Texture2DArray os (Format c)
forall os a. TexName -> Size3 -> Int -> Texture2DArray os a
Texture2DArray TexName
t Size3
s Int
ls
                        IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                            TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
                            [(Size3, GLint)] -> ((Size3, GLint) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Size3] -> [GLint] -> [(Size3, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Texture2DArray os (Format c) -> [Size3]
forall os f. Texture2DArray os f -> [Size3]
texture2DArraySizes Texture2DArray os (Format c)
tex) [GLint
0..]) (((Size3, GLint) -> IO ()) -> IO ())
-> ((Size3, GLint) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(V3 Int
lw Int
lh Int
_, GLint
l) ->
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lh) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sl) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                            GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                        Texture2DArray os (Format c)
-> ContextT ctx os m (Texture2DArray os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return Texture2DArray os (Format c)
tex

newTexture3D :: Format c
-> Size3 -> Int -> ContextT ctx os m (Texture3D os (Format c))
newTexture3D Format c
f s :: Size3
s@(V3 Int
w Int
h Int
d) Int
mx | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Texture3D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture3D, negative size"
                               | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (Texture3D os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTexture3D, non-positive MaxLevels"
                               | Bool
otherwise = do
                    Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_TEXTURE_SIZE
                    if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize Bool -> Bool -> Bool
|| Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                      then IO (Texture3D os (Format c))
-> ContextT ctx os m (Texture3D os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Texture3D os (Format c))
 -> ContextT ctx os m (Texture3D os (Format c)))
-> IO (Texture3D os (Format c))
-> ContextT ctx os m (Texture3D os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (Texture3D os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (Texture3D os (Format c)))
-> GPipeException -> IO (Texture3D os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTexture3D, size larger than maximum supported by graphics driver"
                      else do
                        TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                        let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                            glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                            ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
w (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
h Int
d)))
                            tex :: Texture3D os (Format c)
tex = TexName -> Size3 -> Int -> Texture3D os (Format c)
forall os a. TexName -> Size3 -> Int -> Texture3D os a
Texture3D TexName
t Size3
s Int
ls
                        IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                            TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
                            [(Size3, GLint)] -> ((Size3, GLint) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Size3] -> [GLint] -> [(Size3, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Texture3D os (Format c) -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os (Format c)
tex) [GLint
0..]) (((Size3, GLint) -> IO ()) -> IO ())
-> ((Size3, GLint) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(V3 Int
lw Int
lh Int
ld, GLint
l) ->
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lh) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ld) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                            GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                        Texture3D os (Format c)
-> ContextT ctx os m (Texture3D os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return Texture3D os (Format c)
tex
newTextureCube :: Format c
-> Int -> Int -> ContextT ctx os m (TextureCube os (Format c))
newTextureCube Format c
f Int
s Int
mx | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (TextureCube os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTextureCube, negative size"
                      | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> ContextT ctx os m (TextureCube os (Format c))
forall a. HasCallStack => [Char] -> a
error [Char]
"newTextureCube, non-positive MaxLevels"
                      | Bool
otherwise = do
                    Int
mxSize <- GLenum -> ContextT ctx os m Int
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
GLenum -> ContextT ctx os m Int
getGlValue GLenum
forall a. (Eq a, Num a) => a
GL_MAX_CUBE_MAP_TEXTURE_SIZE
                    if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxSize
                      then IO (TextureCube os (Format c))
-> ContextT ctx os m (TextureCube os (Format c))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TextureCube os (Format c))
 -> ContextT ctx os m (TextureCube os (Format c)))
-> IO (TextureCube os (Format c))
-> ContextT ctx os m (TextureCube os (Format c))
forall a b. (a -> b) -> a -> b
$ GPipeException -> IO (TextureCube os (Format c))
forall e a. Exception e => e -> IO a
throwIO (GPipeException -> IO (TextureCube os (Format c)))
-> GPipeException -> IO (TextureCube os (Format c))
forall a b. (a -> b) -> a -> b
$ [Char] -> GPipeException
GPipeException [Char]
"newTextureCube, size larger than maximum supported by graphics driver"
                      else do
                            TexName
t <- ContextT ctx os m TexName
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
ContextT ctx os m TexName
makeTex
                            let glintf :: GLint
glintf = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ Format c -> GLenum
forall f. Format f -> GLenum
getGlInternalFormat Format c
f
                                glf :: GLenum
glf = c -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat (c
forall a. HasCallStack => a
undefined :: c)
                                ls :: Int
ls = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mx (Int -> Int
calcMaxLevels Int
s)
                                tex :: TextureCube os (Format c)
tex = TexName -> Int -> Int -> TextureCube os (Format c)
forall os a. TexName -> Int -> Int -> TextureCube os a
TextureCube TexName
t Int
s Int
ls
                            IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                                TexName -> GLenum -> IO ()
useTexSync TexName
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP
                                [((Int, GLint), GLenum)]
-> (((Int, GLint), GLenum) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((Int, GLint)
size, CubeSide -> GLenum
getGlCubeSide CubeSide
side) | (Int, GLint)
size <- [Int] -> [GLint] -> [(Int, GLint)]
forall a b. [a] -> [b] -> [(a, b)]
zip (TextureCube os (Format c) -> [Int]
forall os f. TextureCube os f -> [Int]
textureCubeSizes TextureCube os (Format c)
tex) [GLint
0..], CubeSide
side <- [CubeSide
forall a. Bounded a => a
minBound..CubeSide
forall a. Bounded a => a
maxBound]] ((((Int, GLint), GLenum) -> IO ()) -> IO ())
-> (((Int, GLint), GLenum) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \((Int
lx, GLint
l), GLenum
side) ->
                                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexImage2D GLenum
side GLint
l GLint
glintf (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lx) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lx) GLint
0 GLenum
glf GLenum
forall a. (Eq a, Num a) => a
GL_BYTE Ptr ()
forall a. Ptr a
nullPtr
                                GLenum -> Int -> IO ()
setDefaultTexParams GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_S GLint
forall a. (Eq a, Num a) => a
GL_CLAMP_TO_EDGE
                                GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_T GLint
forall a. (Eq a, Num a) => a
GL_CLAMP_TO_EDGE
                                GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_R GLint
forall a. (Eq a, Num a) => a
GL_CLAMP_TO_EDGE
                            TextureCube os (Format c)
-> ContextT ctx os m (TextureCube os (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return TextureCube os (Format c)
tex

getGlValue :: (ContextHandler ctx, MonadIO m) =>  GLenum -> ContextT ctx os m Int
getGlValue :: GLenum -> ContextT ctx os m Int
getGlValue GLenum
enum = IO Int -> ContextT ctx os m Int
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO Int -> ContextT ctx os m Int)
-> IO Int -> ContextT ctx os m Int
forall a b. (a -> b) -> a -> b
$ (Ptr GLint -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLint
ptr -> (GLint -> Int) -> IO GLint -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLint -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLint -> m ()
glGetIntegerv GLenum
enum Ptr GLint
ptr IO () -> IO GLint -> IO GLint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLint -> IO GLint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLint
ptr))

setDefaultTexParams :: GLenum -> Int -> IO ()
setDefaultTexParams :: GLenum -> Int -> IO ()
setDefaultTexParams GLenum
t Int
ml = do
                            GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BASE_LEVEL GLint
0
                            GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_MAX_LEVEL (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ml)
                            GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_MIN_FILTER GLint
forall a. (Eq a, Num a) => a
GL_NEAREST_MIPMAP_NEAREST
                            GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_MAG_FILTER GLint
forall a. (Eq a, Num a) => a
GL_NEAREST


texture1DLevels :: Texture1D os f -> Int
texture1DArrayLevels :: Texture1DArray os f -> Int
texture2DLevels :: Texture2D os f -> Int
texture2DArrayLevels :: Texture2DArray os f -> Int
texture3DLevels :: Texture3D os f -> Int
textureCubeLevels :: TextureCube os f -> Int
texture1DLevels :: Texture1D os f -> Int
texture1DLevels (Texture1D TexName
_ Int
_ Int
ls) = Int
ls
texture1DArrayLevels :: Texture1DArray os f -> Int
texture1DArrayLevels (Texture1DArray TexName
_ Size2
_ Int
ls) = Int
ls
texture2DLevels :: Texture2D os f -> Int
texture2DLevels (Texture2D TexName
_ Size2
_ Int
ls)   = Int
ls
texture2DLevels (RenderBuffer2D TexName
_ Size2
_) = Int
1
texture2DArrayLevels :: Texture2DArray os f -> Int
texture2DArrayLevels (Texture2DArray TexName
_ Size3
_ Int
ls) = Int
ls
texture3DLevels :: Texture3D os f -> Int
texture3DLevels (Texture3D TexName
_ Size3
_ Int
ls) = Int
ls
textureCubeLevels :: TextureCube os f -> Int
textureCubeLevels (TextureCube TexName
_ Int
_ Int
ls) = Int
ls

texture1DSizes :: Texture1D os f -> [Size1]
texture1DArraySizes :: Texture1DArray os f -> [Size2]
texture2DSizes :: Texture2D os f -> [Size2]
texture2DArraySizes :: Texture2DArray os f -> [Size3]
texture3DSizes :: Texture3D os f -> [Size3]
textureCubeSizes :: TextureCube os f -> [Size1]
texture1DSizes :: Texture1D os f -> [Int]
texture1DSizes (Texture1D TexName
_ Int
w Int
ls) = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
calcLevelSize Int
w) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
texture1DArraySizes :: Texture1DArray os f -> [Size2]
texture1DArraySizes (Texture1DArray TexName
_ (V2 Int
w Int
s) Int
ls) = (Int -> Size2) -> [Int] -> [Size2]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 (Int -> Int -> Int
calcLevelSize Int
w Int
l) Int
s) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
texture2DSizes :: Texture2D os f -> [Size2]
texture2DSizes (Texture2D TexName
_ (V2 Int
w Int
h) Int
ls) = (Int -> Size2) -> [Int] -> [Size2]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 (Int -> Int -> Int
calcLevelSize Int
w Int
l) (Int -> Int -> Int
calcLevelSize Int
h Int
l)) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
texture2DSizes (RenderBuffer2D TexName
_ Size2
s) = [Size2
s]
texture2DArraySizes :: Texture2DArray os f -> [Size3]
texture2DArraySizes (Texture2DArray TexName
_ (V3 Int
w Int
h Int
s) Int
ls) = (Int -> Size3) -> [Int] -> [Size3]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Int -> Int -> Size3
forall a. a -> a -> a -> V3 a
V3 (Int -> Int -> Int
calcLevelSize Int
w Int
l) (Int -> Int -> Int
calcLevelSize Int
h Int
l) Int
s) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
texture3DSizes :: Texture3D os f -> [Size3]
texture3DSizes (Texture3D TexName
_ (V3 Int
w Int
h Int
d) Int
ls) = (Int -> Size3) -> [Int] -> [Size3]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Int -> Int -> Size3
forall a. a -> a -> a -> V3 a
V3 (Int -> Int -> Int
calcLevelSize Int
w Int
l) (Int -> Int -> Int
calcLevelSize Int
h Int
l) (Int -> Int -> Int
calcLevelSize Int
d Int
l)) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
textureCubeSizes :: TextureCube os f -> [Int]
textureCubeSizes (TextureCube TexName
_ Int
x Int
ls) = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
calcLevelSize Int
x) [Int
0..(Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

calcLevelSize :: Int -> Int -> Int
calcLevelSize :: Int -> Int -> Int
calcLevelSize Int
size0 Int
level = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
size0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
level))

calcMaxLevels :: Int -> Int
calcMaxLevels :: Int -> Int
calcMaxLevels Int
s = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2.0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s :: Double))

type TexName = IORef GLuint

makeTex :: (ContextHandler ctx, MonadIO m) => ContextT ctx os m TexName
makeTex :: ContextT ctx os m TexName
makeTex = do
    GLenum
name <- IO GLenum -> ContextT ctx os m GLenum
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO GLenum -> ContextT ctx os m GLenum)
-> IO GLenum -> ContextT ctx os m GLenum
forall a b. (a -> b) -> a -> b
$ (Ptr GLenum -> IO GLenum) -> IO GLenum
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLenum
ptr -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glGenTextures GLint
1 Ptr GLenum
ptr IO () -> IO GLenum -> IO GLenum
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLenum -> IO GLenum
forall a. Storable a => Ptr a -> IO a
peek Ptr GLenum
ptr)
    TexName
tex <- IO TexName -> ContextT ctx os m TexName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TexName -> ContextT ctx os m TexName)
-> IO TexName -> ContextT ctx os m TexName
forall a b. (a -> b) -> a -> b
$ GLenum -> IO TexName
forall a. a -> IO (IORef a)
newIORef GLenum
name
    TexName -> IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IORef a -> IO () -> ContextT ctx os m ()
addContextFinalizer TexName
tex (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ GLenum -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLenum
name (GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glDeleteTextures GLint
1)
    Bool -> TexName -> ContextT ctx os m ()
forall (m :: * -> *) ctx os.
MonadIO m =>
Bool -> TexName -> ContextT ctx os m ()
addFBOTextureFinalizer Bool
False TexName
tex
    TexName -> ContextT ctx os m TexName
forall (m :: * -> *) a. Monad m => a -> m a
return TexName
tex

makeRenderBuff :: (ContextHandler ctx, MonadIO m) => ContextT ctx os m TexName
makeRenderBuff :: ContextT ctx os m TexName
makeRenderBuff = do
    GLenum
name <- IO GLenum -> ContextT ctx os m GLenum
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO GLenum -> ContextT ctx os m GLenum)
-> IO GLenum -> ContextT ctx os m GLenum
forall a b. (a -> b) -> a -> b
$ (Ptr GLenum -> IO GLenum) -> IO GLenum
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLenum
ptr -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glGenRenderbuffers GLint
1 Ptr GLenum
ptr IO () -> IO GLenum -> IO GLenum
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLenum -> IO GLenum
forall a. Storable a => Ptr a -> IO a
peek Ptr GLenum
ptr)
    TexName
tex <- IO TexName -> ContextT ctx os m TexName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TexName -> ContextT ctx os m TexName)
-> IO TexName -> ContextT ctx os m TexName
forall a b. (a -> b) -> a -> b
$ GLenum -> IO TexName
forall a. a -> IO (IORef a)
newIORef GLenum
name
    TexName -> IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IORef a -> IO () -> ContextT ctx os m ()
addContextFinalizer TexName
tex (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ GLenum -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLenum
name (GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glDeleteRenderbuffers GLint
1)
    Bool -> TexName -> ContextT ctx os m ()
forall (m :: * -> *) ctx os.
MonadIO m =>
Bool -> TexName -> ContextT ctx os m ()
addFBOTextureFinalizer Bool
True TexName
tex
    TexName -> ContextT ctx os m TexName
forall (m :: * -> *) a. Monad m => a -> m a
return TexName
tex

useTex :: Integral a => TexName -> GLenum -> a -> IO Int
useTex :: TexName -> GLenum -> a -> IO Int
useTex TexName
texNameRef GLenum
t a
bind = do GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glActiveTexture (GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE0 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ a -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
bind)
                              GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
texNameRef
                              GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindTexture GLenum
t GLenum
n
                              Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (GLenum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
n)

useTexSync :: TexName -> GLenum -> IO ()
useTexSync :: TexName -> GLenum -> IO ()
useTexSync TexName
tn GLenum
t = do GLint
maxUnits <- (Ptr GLint -> IO GLint) -> IO GLint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr GLint
ptr -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLint -> m ()
glGetIntegerv GLenum
forall a. (Eq a, Num a) => a
GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS Ptr GLint
ptr IO () -> IO GLint -> IO GLint
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLint -> IO GLint
forall a. Storable a => Ptr a -> IO a
peek Ptr GLint
ptr)  -- Use last for all sync actions, keeping 0.. for async drawcalls
                     IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ TexName -> GLenum -> GLint -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
t (GLint
maxUnitsGLint -> GLint -> GLint
forall a. Num a => a -> a -> a
-GLint
1)


type Level = Int
data CubeSide = CubePosX | CubeNegX | CubePosY | CubeNegY | CubePosZ | CubeNegZ deriving (CubeSide -> CubeSide -> Bool
(CubeSide -> CubeSide -> Bool)
-> (CubeSide -> CubeSide -> Bool) -> Eq CubeSide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CubeSide -> CubeSide -> Bool
$c/= :: CubeSide -> CubeSide -> Bool
== :: CubeSide -> CubeSide -> Bool
$c== :: CubeSide -> CubeSide -> Bool
Eq, Int -> CubeSide
CubeSide -> Int
CubeSide -> [CubeSide]
CubeSide -> CubeSide
CubeSide -> CubeSide -> [CubeSide]
CubeSide -> CubeSide -> CubeSide -> [CubeSide]
(CubeSide -> CubeSide)
-> (CubeSide -> CubeSide)
-> (Int -> CubeSide)
-> (CubeSide -> Int)
-> (CubeSide -> [CubeSide])
-> (CubeSide -> CubeSide -> [CubeSide])
-> (CubeSide -> CubeSide -> [CubeSide])
-> (CubeSide -> CubeSide -> CubeSide -> [CubeSide])
-> Enum CubeSide
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CubeSide -> CubeSide -> CubeSide -> [CubeSide]
$cenumFromThenTo :: CubeSide -> CubeSide -> CubeSide -> [CubeSide]
enumFromTo :: CubeSide -> CubeSide -> [CubeSide]
$cenumFromTo :: CubeSide -> CubeSide -> [CubeSide]
enumFromThen :: CubeSide -> CubeSide -> [CubeSide]
$cenumFromThen :: CubeSide -> CubeSide -> [CubeSide]
enumFrom :: CubeSide -> [CubeSide]
$cenumFrom :: CubeSide -> [CubeSide]
fromEnum :: CubeSide -> Int
$cfromEnum :: CubeSide -> Int
toEnum :: Int -> CubeSide
$ctoEnum :: Int -> CubeSide
pred :: CubeSide -> CubeSide
$cpred :: CubeSide -> CubeSide
succ :: CubeSide -> CubeSide
$csucc :: CubeSide -> CubeSide
Enum, CubeSide
CubeSide -> CubeSide -> Bounded CubeSide
forall a. a -> a -> Bounded a
maxBound :: CubeSide
$cmaxBound :: CubeSide
minBound :: CubeSide
$cminBound :: CubeSide
Bounded)

type StartPos1 = Int
type StartPos2 = V2 Int
type StartPos3 = V3 Int


writeTexture1D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> [h] -> ContextT ctx os m ()
writeTexture1DArray :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()
writeTexture2D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()
writeTexture2DArray :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT ctx os m ()
writeTexture3D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT ctx os m ()
writeTextureCube    :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()

writeTexture1DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
writeTexture1DArrayFromBuffer:: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
writeTexture2DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
writeTexture2DArrayFromBuffer:: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
writeTexture3DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
writeTextureCubeFromBuffer   :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()


readTexture1D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
readTexture1DArray :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
readTexture2D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
readTexture2DArray :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
readTexture3D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
readTextureCube    :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a

readTexture1DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
readTexture1DArrayToBuffer:: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
readTexture2DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
readTexture2DArrayToBuffer:: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
readTexture3DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
readTextureCubeToBuffer   :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b-> BufferStartPos -> ContextT ctx os m ()

getGlColorFormat :: (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat :: f -> b -> GLenum
getGlColorFormat f
f b
b = let x :: GLenum
x = f -> GLenum
forall f. TextureFormat f => f -> GLenum
getGlFormat f
f in if GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL Bool -> Bool -> Bool
|| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT then GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT else b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlPaddedFormat b
b

writeTexture1D :: Texture1D os (Format c)
-> Int -> Int -> Int -> [h] -> ContextT ctx os m ()
writeTexture1D t :: Texture1D os (Format c)
t@(Texture1D TexName
texn Int
_ Int
ml) Int
l Int
x Int
w [h]
d
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1D, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1D, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1D, w out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take Int
w [h]
d)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1D, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
                                GLenum
-> GLint -> GLint -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint -> GLint -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glTexSubImage1D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where mx :: Int
mx = Texture1D os (Format c) -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l

writeTexture1DArray :: Texture1DArray os (Format c)
-> Int -> Size2 -> Size2 -> [h] -> ContextT ctx os m ()
writeTexture1DArray t :: Texture1DArray os (Format c)
t@(Texture1DArray TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) [h]
d
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArray, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArray, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArray, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArray, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, h out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h) [h]
d)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArray, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where V2 Int
mx Int
my = Texture1DArray os (Format c) -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
writeTexture2D :: Texture2D os (Format c)
-> Int -> Size2 -> Size2 -> [h] -> ContextT ctx os m ()
writeTexture2D t :: Texture2D os (Format c)
t@(Texture2D TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) [h]
d
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, h out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h) [h]
d)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2D, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where V2 Int
mx Int
my = Texture2D os (Format c) -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
writeTexture2DArray :: Texture2DArray os (Format c)
-> Int -> Size3 -> Size3 -> [h] -> ContextT ctx os m ()
writeTexture2DArray t :: Texture2DArray os (Format c)
t@(Texture2DArray TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V3 Int
w Int
h Int
d) [h]
dat
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, z out of bounds"
    | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, d out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) [h]
dat)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArray, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where V3 Int
mx Int
my Int
mz = Texture2DArray os (Format c) -> [Size3]
forall os f. Texture2DArray os f -> [Size3]
texture2DArraySizes Texture2DArray os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
writeTexture3D :: Texture3D os (Format c)
-> Int -> Size3 -> Size3 -> [h] -> ContextT ctx os m ()
writeTexture3D t :: Texture3D os (Format c)
t@(Texture3D TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V3 Int
w Int
h Int
d) [h]
dat
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, z out of bounds"
    | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, d out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) [h]
dat)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3D, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where V3 Int
mx Int
my Int
mz = Texture3D os (Format c) -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
writeTextureCube :: TextureCube os (Format c)
-> Int -> CubeSide -> Size2 -> Size2 -> [h] -> ContextT ctx os m ()
writeTextureCube t :: TextureCube os (Format c)
t@(TextureCube TexName
texn Int
_ Int
ml) Int
l CubeSide
s (V2 Int
x Int
y) (V2 Int
w Int
h) [h]
d
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, h out of bounds"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                         size :: Int
size = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ()
ptr -> do
                         Ptr ()
end <- Buffer os b -> Ptr () -> [HostFormat b] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os b
b Ptr ()
ptr (Int -> [h] -> [h]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h) [h]
d)
                         if Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size
                            then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCube, data list too short"
                            else do
                                TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP
                                GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D (CubeSide -> GLenum
getGlCubeSide CubeSide
s) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
    where mxy :: Int
mxy = TextureCube os (Format c) -> [Int]
forall os f. TextureCube os f -> [Int]
textureCubeSizes TextureCube os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l

writeTexture1DFromBuffer :: Texture1D os (Format c)
-> Int -> Int -> Int -> Buffer os b -> Int -> ContextT ctx os m ()
writeTexture1DFromBuffer t :: Texture1D os (Format c)
t@(Texture1D TexName
texn Int
_ Int
ml) Int
l Int
x Int
w Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DFromBuffer, w out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint -> GLint -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint -> GLint -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glTexSubImage1D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where mx :: Int
mx = Texture1D os (Format c) -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l
writeTexture1DArrayFromBuffer :: Texture1DArray os (Format c)
-> Int
-> Size2
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
writeTexture1DArrayFromBuffer t :: Texture1DArray os (Format c)
t@(Texture1DArray TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, h out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture1DArrayFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where V2 Int
mx Int
my = Texture1DArray os (Format c) -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
writeTexture2DFromBuffer :: Texture2D os (Format c)
-> Int
-> Size2
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
writeTexture2DFromBuffer t :: Texture2D os (Format c)
t@(Texture2D TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, h out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where V2 Int
mx Int
my = Texture2D os (Format c) -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
writeTexture2DArrayFromBuffer :: Texture2DArray os (Format c)
-> Int
-> Size3
-> Size3
-> Buffer os b
-> Int
-> ContextT ctx os m ()
writeTexture2DArrayFromBuffer t :: Texture2DArray os (Format c)
t@(Texture2DArray TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V3 Int
w Int
h Int
d) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, z out of bounds"
    | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, d out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture2DArrayFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where V3 Int
mx Int
my Int
mz = Texture2DArray os (Format c) -> [Size3]
forall os f. Texture2DArray os f -> [Size3]
texture2DArraySizes Texture2DArray os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
writeTexture3DFromBuffer :: Texture3D os (Format c)
-> Int
-> Size3
-> Size3
-> Buffer os b
-> Int
-> ContextT ctx os m ()
writeTexture3DFromBuffer t :: Texture3D os (Format c)
t@(Texture3D TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V3 Int
w Int
h Int
d) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, z out of bounds"
    | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mz = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, d out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTexture3DFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage3D GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where V3 Int
mx Int
my Int
mz = Texture3D os (Format c) -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
writeTextureCubeFromBuffer :: TextureCube os (Format c)
-> Int
-> CubeSide
-> Size2
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
writeTextureCubeFromBuffer t :: TextureCube os (Format c)
t@(TextureCube TexName
texn Int
_ Int
ml) Int
l CubeSide
s (V2 Int
x Int
y) (V2 Int
w Int
h) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, h out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeTextureCubeFromBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                    TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP
                    GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
bname
                    GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLint
-> GLint
-> GLint
-> GLint
-> GLint
-> GLenum
-> GLenum
-> Ptr ()
-> m ()
glTexSubImage2D (CubeSide -> GLenum
getGlCubeSide CubeSide
s) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                    GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_UNPACK_BUFFER GLenum
0
    where mxy :: Int
mxy = TextureCube os (Format c) -> [Int]
forall os f. TextureCube os f -> [Int]
textureCubeSizes TextureCube os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l


readTexture1D :: Texture1D os (Format c)
-> Int
-> Int
-> Int
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTexture1D t :: Texture1D os (Format c)
t@(Texture1D TexName
texn Int
_ Int
ml) Int
l Int
x Int
w a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, w out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
0 Int
0 Int
w Int
1
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where mx :: Int
mx = Texture1D os (Format c) -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l
readTexture1DArray :: Texture1DArray os (Format c)
-> Int
-> Size2
-> Int
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTexture1DArray t :: Texture1DArray os (Format c)
t@(Texture1DArray TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) Int
w a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArray, y out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
0 Int
w Int
1
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where V2 Int
mx Int
my = Texture1DArray os (Format c) -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
readTexture2D :: Texture2D os (Format c)
-> Int
-> Size2
-> Size2
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTexture2D t :: Texture2D os (Format c)
t@(Texture2D TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2D, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2D, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2D, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2D, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2D, h out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
0 Int
w Int
h
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where V2 Int
mx Int
my = Texture2D os (Format c) -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
readTexture2DArray :: Texture2DArray os (Format c)
-> Int
-> Size3
-> Size2
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTexture2DArray t :: Texture2DArray os (Format c)
t@(Texture2DArray TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V2 Int
w Int
h) a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DArray, y out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
z Int
w Int
h
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where V3 Int
mx Int
my Int
mz = Texture2DArray os (Format c) -> [Size3]
forall os f. Texture2DArray os f -> [Size3]
texture2DArraySizes Texture2DArray os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
readTexture3D :: Texture3D os (Format c)
-> Int
-> Size3
-> Size2
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTexture3D t :: Texture3D os (Format c)
t@(Texture3D TexName
texn Size3
_ Int
ml) Int
l (V3 Int
x Int
y Int
z) (V2 Int
w Int
h) a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, h out of bounds"
    | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mz = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture3D, y out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
z Int
w Int
h
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where V3 Int
mx Int
my Int
mz = Texture3D os (Format c) -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os (Format c)
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
readTextureCube :: TextureCube os (Format c)
-> Int
-> CubeSide
-> Size2
-> Size2
-> (a -> h -> ContextT ctx os m a)
-> a
-> ContextT ctx os m a
readTextureCube t :: TextureCube os (Format c)
t@(TextureCube TexName
texn Int
_ Int
ml) Int
l CubeSide
si (V2 Int
x Int
y) (V2 Int
w Int
h) a -> h -> ContextT ctx os m a
f a
s
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTextureCube, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTextureCube, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTextureCube, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mxy = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTextureCube, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mxy = [Char] -> ContextT ctx os m a
forall a. HasCallStack => [Char] -> a
error [Char]
"readTextureCube, h out of bounds"
    | Bool
otherwise =
                 let b :: Buffer os b
b = TexName -> Int -> Int -> Buffer os b
forall os b. BufferFormat b => TexName -> Int -> Int -> Buffer os b
makeBuffer TexName
forall a. HasCallStack => a
undefined Int
forall a. HasCallStack => a
undefined Int
0 :: Buffer os b
                     f' :: Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr a
a Int
off = a -> h -> ContextT ctx os m a
f a
a (h -> ContextT ctx os m a)
-> ContextT ctx os m h -> ContextT ctx os m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO h -> ContextT ctx os m h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> Ptr () -> IO (HostFormat b)
forall f. BufferFormat f => f -> Ptr () -> IO (HostFormat f)
peekPixel (b
forall a. HasCallStack => a
undefined :: b) (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off))
                 in ContextT ctx os m (Ptr ())
-> (Ptr () -> ContextT ctx os m ())
-> (Ptr () -> ContextT ctx os m a)
-> ContextT ctx os m a
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
                   (IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Ptr ()) -> ContextT ctx os m (Ptr ()))
-> IO (Ptr ()) -> ContextT ctx os m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
                     Ptr ()
ptr <- Int -> IO (Ptr ())
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr ())) -> Int -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
0 Int
w Int
h
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage (CubeSide -> GLenum
getGlCubeSide CubeSide
si) (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) Ptr ()
ptr
                     Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr)
                   (IO () -> ContextT ctx os m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT ctx os m ())
-> (Ptr () -> IO ()) -> Ptr () -> ContextT ctx os m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
forall a. Ptr a -> IO ()
free)
                   (\Ptr ()
ptr -> (a -> Int -> ContextT ctx os m a)
-> a -> [Int] -> ContextT ctx os m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ptr () -> a -> Int -> ContextT ctx os m a
f' Ptr ()
ptr) a
s [Int
0,Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
    where mxy :: Int
mxy = TextureCube os (Format c) -> [Int]
forall os f. TextureCube os f -> [Int]
textureCubeSizes TextureCube os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l

readTexture1DToBuffer :: Texture1D os (Format c)
-> Int -> Int -> Int -> Buffer os b -> Int -> ContextT ctx os m ()
readTexture1DToBuffer t :: Texture1D os (Format c)
t@(Texture1D TexName
texn Int
_ Int
ml) Int
l Int
x Int
w Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DToBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DToBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DToBuffer, w out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DToBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DToBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                     GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_PACK_BUFFER GLenum
bname
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
0 Int
0 Int
w Int
1
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                     GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_PACK_BUFFER GLenum
0
    where mx :: Int
mx = Texture1D os (Format c) -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os (Format c)
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l
readTexture1DArrayToBuffer :: Texture1DArray os (Format c)
-> Int
-> Size2
-> Int
-> Buffer os b
-> Int
-> ContextT ctx os m ()
readTexture1DArrayToBuffer t :: Texture1DArray os (Format c)
t@(Texture1DArray TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) Int
w Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, y out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture1DArrayToBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> TexName
forall os b. Buffer os b -> TexName
bufName Buffer os b
b
                     GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_PACK_BUFFER GLenum
bname
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
0 Int
w Int
1
                     TexName -> GLenum -> IO ()
useTexSync TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                     GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLenum -> Ptr () -> m ()
glGetTexImage GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) (c -> b -> GLenum
forall f b. (TextureFormat f, BufferFormat b) => f -> b -> GLenum
getGlColorFormat (c
forall a. HasCallStack => a
undefined :: c) (b
forall a. HasCallStack => a
undefined :: b)) (b -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType (b
forall a. HasCallStack => a
undefined :: b)) (WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ()) -> WordPtr -> Ptr ()
forall a b. (a -> b) -> a -> b
$ Int -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordPtr) -> Int -> WordPtr
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
b)
                     GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_PIXEL_PACK_BUFFER GLenum
0
    where V2 Int
mx Int
my = Texture1DArray os (Format c) -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os (Format c)
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
readTexture2DToBuffer :: Texture2D os (Format c)
-> Int
-> Size2
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
readTexture2DToBuffer t :: Texture2D os (Format c)
t@(Texture2D TexName
texn Size2
_ Int
ml) Int
l (V2 Int
x Int
y) (V2 Int
w Int
h) Buffer os b
b Int
i
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ml = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, level out of bounds"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, x out of bounds"
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, w out of bounds"
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, y out of bounds"
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
my = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, h out of bounds"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, i out of bounds"
    | Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"readTexture2DToBuffer, buffer data too small"
    | Bool
otherwise = IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
IO () -> ContextT ctx os m ()
liftNonWinContextAsyncIO (IO () -> ContextT ctx os m ()) -> IO () -> ContextT ctx os m ()
forall a b. (a -> b) -> a -> b
$ do
                     GLenum
bname <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef (TexName -> IO GLenum) -> TexName -> IO GLenum
forall a b. (a -> b) -> a -> b