{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, ScopedTypeVariables, AllowAmbiguousTypes, EmptyDataDecls #-}
module Graphics.GPipe.Internal.Texture where

import Graphics.GPipe.Internal.Format
import Graphics.GPipe.Internal.Expr
import Graphics.GPipe.Internal.Context
import Graphics.GPipe.Internal.Shader
import Graphics.GPipe.Internal.Compiler
import Graphics.GPipe.Internal.Buffer
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.IntMap.Lazy (insert)

import Graphics.GL.Core45
import Graphics.GL.Types
import Graphics.GL.Ext.EXT.TextureFilterAnisotropic

import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Control.Monad
import Data.IORef
import Control.Monad.Exception (bracket, MonadAsyncException)
import Linear.V4
import Linear.V3
import Linear.V2
import Control.Exception (throwIO)
import Control.Monad.Trans.Class (lift)

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

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
$ 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
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)) (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 = 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
readTexture2DArrayToBuffer :: Texture2DArray os (Format c)
-> Int
-> Size3
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
readTexture2DArrayToBuffer 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) 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, z 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]
"readTexture2DArrayToBuffer, 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]
"readTexture2DArrayToBuffer, 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
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)) (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 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
readTexture3DToBuffer :: Texture3D os (Format c)
-> Int
-> Size3
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
readTexture3DToBuffer 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) 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, z 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]
"readTexture3DToBuffer, 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]
"readTexture3DToBuffer, 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
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)) (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 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
readTextureCubeToBuffer :: TextureCube os (Format c)
-> Int
-> CubeSide
-> Size2
-> Size2
-> Buffer os b
-> Int
-> ContextT ctx os m ()
readTextureCubeToBuffer 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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]
"readTextureCubeToBuffer, 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
                     Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
0 Int
w Int
h
                     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
                     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
s) (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 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

setGlPixelStoreRange :: Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange :: Int -> Int -> Int -> Int -> Int -> IO ()
setGlPixelStoreRange Int
x Int
y Int
z Int
w Int
h = do
        GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei GLenum
forall a. (Eq a, Num a) => a
GL_PACK_SKIP_PIXELS (GLint -> IO ()) -> GLint -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
        GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei GLenum
forall a. (Eq a, Num a) => a
GL_PACK_SKIP_ROWS (GLint -> IO ()) -> GLint -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y
        GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei GLenum
forall a. (Eq a, Num a) => a
GL_PACK_SKIP_IMAGES (GLint -> IO ()) -> GLint -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z
        GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei GLenum
forall a. (Eq a, Num a) => a
GL_PACK_ROW_LENGTH (GLint -> IO ()) -> GLint -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei GLenum
forall a. (Eq a, Num a) => a
GL_PACK_IMAGE_HEIGHT (GLint -> IO ()) -> GLint -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h


generateTexture1DMipmap :: (ContextHandler ctx, MonadIO m) => Texture1D os f -> ContextT ctx os m ()
generateTexture1DArrayMipmap :: (ContextHandler ctx, MonadIO m) => Texture1DArray os f -> ContextT ctx os m ()
generateTexture2DMipmap :: (ContextHandler ctx, MonadIO m) => Texture2D os f -> ContextT ctx os m ()
generateTexture2DArrayMipmap :: (ContextHandler ctx, MonadIO m) => Texture2DArray os f -> ContextT ctx os m ()
generateTexture3DMipmap :: (ContextHandler ctx, MonadIO m) => Texture3D os f -> ContextT ctx os m ()
generateTextureCubeMipmap :: (ContextHandler ctx, MonadIO m) => TextureCube os f -> ContextT ctx os m ()

genMips :: TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
target = 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
target
                     GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glGenerateMipmap GLenum
target

generateTexture1DMipmap :: Texture1D os f -> ContextT ctx os m ()
generateTexture1DMipmap (Texture1D TexName
texn Int
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
generateTexture1DArrayMipmap :: Texture1DArray os f -> ContextT ctx os m ()
generateTexture1DArrayMipmap (Texture1DArray TexName
texn Size2
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
generateTexture2DMipmap :: Texture2D os f -> ContextT ctx os m ()
generateTexture2DMipmap (Texture2D TexName
texn Size2
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
generateTexture2DMipmap Texture2D os f
_ = () -> ContextT ctx os m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Only one level for renderbuffers
generateTexture2DArrayMipmap :: Texture2DArray os f -> ContextT ctx os m ()
generateTexture2DArrayMipmap (Texture2DArray TexName
texn Size3
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
generateTexture3DMipmap :: Texture3D os f -> ContextT ctx os m ()
generateTexture3DMipmap (Texture3D TexName
texn Size3
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
generateTextureCubeMipmap :: TextureCube os f -> ContextT ctx os m ()
generateTextureCubeMipmap (TextureCube TexName
texn Int
_ Int
_) = TexName -> GLenum -> ContextT ctx os m ()
forall ctx (m :: * -> *) os.
(ContextHandler ctx, MonadIO m) =>
TexName -> GLenum -> ContextT ctx os m ()
genMips TexName
texn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP

----------------------------------------------------------------------
-- Samplers

data Filter = Nearest | Linear  deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq, Int -> Filter
Filter -> Int
Filter -> [Filter]
Filter -> Filter
Filter -> Filter -> [Filter]
Filter -> Filter -> Filter -> [Filter]
(Filter -> Filter)
-> (Filter -> Filter)
-> (Int -> Filter)
-> (Filter -> Int)
-> (Filter -> [Filter])
-> (Filter -> Filter -> [Filter])
-> (Filter -> Filter -> [Filter])
-> (Filter -> Filter -> Filter -> [Filter])
-> Enum Filter
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 :: Filter -> Filter -> Filter -> [Filter]
$cenumFromThenTo :: Filter -> Filter -> Filter -> [Filter]
enumFromTo :: Filter -> Filter -> [Filter]
$cenumFromTo :: Filter -> Filter -> [Filter]
enumFromThen :: Filter -> Filter -> [Filter]
$cenumFromThen :: Filter -> Filter -> [Filter]
enumFrom :: Filter -> [Filter]
$cenumFrom :: Filter -> [Filter]
fromEnum :: Filter -> Int
$cfromEnum :: Filter -> Int
toEnum :: Int -> Filter
$ctoEnum :: Int -> Filter
pred :: Filter -> Filter
$cpred :: Filter -> Filter
succ :: Filter -> Filter
$csucc :: Filter -> Filter
Enum)
data EdgeMode = Repeat | Mirror | ClampToEdge | ClampToBorder deriving (EdgeMode -> EdgeMode -> Bool
(EdgeMode -> EdgeMode -> Bool)
-> (EdgeMode -> EdgeMode -> Bool) -> Eq EdgeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeMode -> EdgeMode -> Bool
$c/= :: EdgeMode -> EdgeMode -> Bool
== :: EdgeMode -> EdgeMode -> Bool
$c== :: EdgeMode -> EdgeMode -> Bool
Eq, Int -> EdgeMode
EdgeMode -> Int
EdgeMode -> [EdgeMode]
EdgeMode -> EdgeMode
EdgeMode -> EdgeMode -> [EdgeMode]
EdgeMode -> EdgeMode -> EdgeMode -> [EdgeMode]
(EdgeMode -> EdgeMode)
-> (EdgeMode -> EdgeMode)
-> (Int -> EdgeMode)
-> (EdgeMode -> Int)
-> (EdgeMode -> [EdgeMode])
-> (EdgeMode -> EdgeMode -> [EdgeMode])
-> (EdgeMode -> EdgeMode -> [EdgeMode])
-> (EdgeMode -> EdgeMode -> EdgeMode -> [EdgeMode])
-> Enum EdgeMode
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 :: EdgeMode -> EdgeMode -> EdgeMode -> [EdgeMode]
$cenumFromThenTo :: EdgeMode -> EdgeMode -> EdgeMode -> [EdgeMode]
enumFromTo :: EdgeMode -> EdgeMode -> [EdgeMode]
$cenumFromTo :: EdgeMode -> EdgeMode -> [EdgeMode]
enumFromThen :: EdgeMode -> EdgeMode -> [EdgeMode]
$cenumFromThen :: EdgeMode -> EdgeMode -> [EdgeMode]
enumFrom :: EdgeMode -> [EdgeMode]
$cenumFrom :: EdgeMode -> [EdgeMode]
fromEnum :: EdgeMode -> Int
$cfromEnum :: EdgeMode -> Int
toEnum :: Int -> EdgeMode
$ctoEnum :: Int -> EdgeMode
pred :: EdgeMode -> EdgeMode
$cpred :: EdgeMode -> EdgeMode
succ :: EdgeMode -> EdgeMode
$csucc :: EdgeMode -> EdgeMode
Enum)
type BorderColor c = Color c (ColorElement c)
type Anisotropy = Maybe Float

type MinFilter = Filter
type MagFilter = Filter
type LodFilter = Filter

-- | A GADT for sample filters, where 'SamplerFilter' cannot be used for integer textures.
data SamplerFilter c where
    SamplerFilter :: (ColorElement c ~ Float) => MagFilter -> MinFilter -> LodFilter -> Anisotropy -> SamplerFilter c
    SamplerNearest :: SamplerFilter c

type EdgeMode2 = V2 EdgeMode
type EdgeMode3 = V3 EdgeMode

data ComparisonFunction =
     Never
   | Less
   | Equal
   | Lequal
   | Greater
   | Notequal
   | Gequal
   | Always
   deriving ( ComparisonFunction -> ComparisonFunction -> Bool
(ComparisonFunction -> ComparisonFunction -> Bool)
-> (ComparisonFunction -> ComparisonFunction -> Bool)
-> Eq ComparisonFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComparisonFunction -> ComparisonFunction -> Bool
$c/= :: ComparisonFunction -> ComparisonFunction -> Bool
== :: ComparisonFunction -> ComparisonFunction -> Bool
$c== :: ComparisonFunction -> ComparisonFunction -> Bool
Eq, Eq ComparisonFunction
Eq ComparisonFunction
-> (ComparisonFunction -> ComparisonFunction -> Ordering)
-> (ComparisonFunction -> ComparisonFunction -> Bool)
-> (ComparisonFunction -> ComparisonFunction -> Bool)
-> (ComparisonFunction -> ComparisonFunction -> Bool)
-> (ComparisonFunction -> ComparisonFunction -> Bool)
-> (ComparisonFunction -> ComparisonFunction -> ComparisonFunction)
-> (ComparisonFunction -> ComparisonFunction -> ComparisonFunction)
-> Ord ComparisonFunction
ComparisonFunction -> ComparisonFunction -> Bool
ComparisonFunction -> ComparisonFunction -> Ordering
ComparisonFunction -> ComparisonFunction -> ComparisonFunction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComparisonFunction -> ComparisonFunction -> ComparisonFunction
$cmin :: ComparisonFunction -> ComparisonFunction -> ComparisonFunction
max :: ComparisonFunction -> ComparisonFunction -> ComparisonFunction
$cmax :: ComparisonFunction -> ComparisonFunction -> ComparisonFunction
>= :: ComparisonFunction -> ComparisonFunction -> Bool
$c>= :: ComparisonFunction -> ComparisonFunction -> Bool
> :: ComparisonFunction -> ComparisonFunction -> Bool
$c> :: ComparisonFunction -> ComparisonFunction -> Bool
<= :: ComparisonFunction -> ComparisonFunction -> Bool
$c<= :: ComparisonFunction -> ComparisonFunction -> Bool
< :: ComparisonFunction -> ComparisonFunction -> Bool
$c< :: ComparisonFunction -> ComparisonFunction -> Bool
compare :: ComparisonFunction -> ComparisonFunction -> Ordering
$ccompare :: ComparisonFunction -> ComparisonFunction -> Ordering
$cp1Ord :: Eq ComparisonFunction
Ord, Int -> ComparisonFunction -> ShowS
[ComparisonFunction] -> ShowS
ComparisonFunction -> [Char]
(Int -> ComparisonFunction -> ShowS)
-> (ComparisonFunction -> [Char])
-> ([ComparisonFunction] -> ShowS)
-> Show ComparisonFunction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ComparisonFunction] -> ShowS
$cshowList :: [ComparisonFunction] -> ShowS
show :: ComparisonFunction -> [Char]
$cshow :: ComparisonFunction -> [Char]
showsPrec :: Int -> ComparisonFunction -> ShowS
$cshowsPrec :: Int -> ComparisonFunction -> ShowS
Show )

getGlCompFunc :: (Num a, Eq a) => ComparisonFunction -> a
getGlCompFunc :: ComparisonFunction -> a
getGlCompFunc ComparisonFunction
Never = a
forall a. (Eq a, Num a) => a
GL_NEVER
getGlCompFunc ComparisonFunction
Less = a
forall a. (Eq a, Num a) => a
GL_LESS
getGlCompFunc ComparisonFunction
Equal = a
forall a. (Eq a, Num a) => a
GL_EQUAL
getGlCompFunc ComparisonFunction
Lequal = a
forall a. (Eq a, Num a) => a
GL_LEQUAL
getGlCompFunc ComparisonFunction
Greater = a
forall a. (Eq a, Num a) => a
GL_GREATER
getGlCompFunc ComparisonFunction
Notequal = a
forall a. (Eq a, Num a) => a
GL_NOTEQUAL
getGlCompFunc ComparisonFunction
Gequal = a
forall a. (Eq a, Num a) => a
GL_GEQUAL
getGlCompFunc ComparisonFunction
Always = a
forall a. (Eq a, Num a) => a
GL_ALWAYS

newSampler1D :: forall os s c. ColorSampleable c => (s -> (Texture1D os (Format c), SamplerFilter c, (EdgeMode,  BorderColor c))) -> Shader os s (Sampler1D (Format c))
newSampler1DArray :: forall os s c. ColorSampleable c => (s -> (Texture1DArray os (Format c), SamplerFilter c, (EdgeMode, BorderColor c))) -> Shader os s (Sampler1DArray (Format c))
newSampler2D :: forall os s c. ColorSampleable c => (s -> (Texture2D os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os s (Sampler2D (Format c))
newSampler2DArray :: forall os s c. ColorSampleable c => (s -> (Texture2DArray os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os s (Sampler2DArray (Format c))
newSampler3D :: forall os s c. ColorRenderable c => (s -> (Texture3D os (Format c), SamplerFilter c, (EdgeMode3, BorderColor c))) -> Shader os s (Sampler3D (Format c))
newSamplerCube :: forall os s c. ColorSampleable c => (s -> (TextureCube os (Format c), SamplerFilter c)) -> Shader os s (SamplerCube (Format c))

newSampler1DShadow :: forall os s d. DepthRenderable d => (s -> (Texture1D os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler1D Shadow)
newSampler1DArrayShadow :: forall os s d. DepthRenderable d => (s -> (Texture1DArray os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler1DArray Shadow)
newSampler2DShadow :: forall os s d. DepthRenderable d => (s -> (Texture2D os d, SamplerFilter (Format d), (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler2D Shadow)
newSampler2DArrayShadow :: forall os s d. DepthRenderable d => (s -> (Texture2DArray os (Format d), SamplerFilter d, (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler2DArray Shadow)
newSamplerCubeShadow :: forall os s d. DepthRenderable d => (s -> (TextureCube os (Format d), SamplerFilter d, ComparisonFunction)) -> Shader os s (SamplerCube Shadow)

newSampler1D :: (s
 -> (Texture1D os (Format c), SamplerFilter c,
     (EdgeMode, BorderColor c)))
-> Shader os s (Sampler1D (Format c))
newSampler1D s
-> (Texture1D os (Format c), SamplerFilter c,
    (EdgeMode, BorderColor c))
sf = ShaderM s (Sampler1D (Format c))
-> Shader os s (Sampler1D (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler1D (Format c))
 -> Shader os s (Sampler1D (Format c)))
-> ShaderM s (Sampler1D (Format c))
-> Shader os s (Sampler1D (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture1D TexName
tn Int
_ Int
_, SamplerFilter c
filt, (EdgeMode
ex, BorderColor c
ec)) = s
-> (Texture1D os (Format c), SamplerFilter c,
    (EdgeMode, BorderColor c))
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D SamplerFilter c
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, Maybe EdgeMode
forall a. Maybe a
Nothing, Maybe EdgeMode
forall a. Maybe a
Nothing) (c -> GLenum -> BorderColor c -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (c
forall a. HasCallStack => a
undefined :: c) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D BorderColor c
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler1D (Format c) -> ShaderM s (Sampler1D (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler1D (Format c) -> ShaderM s (Sampler1D (Format c)))
-> Sampler1D (Format c) -> ShaderM s (Sampler1D (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler1D (Format c)
forall f. Int -> Bool -> [Char] -> Sampler1D f
Sampler1D Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))
newSampler1DArray :: (s
 -> (Texture1DArray os (Format c), SamplerFilter c,
     (EdgeMode, BorderColor c)))
-> Shader os s (Sampler1DArray (Format c))
newSampler1DArray s
-> (Texture1DArray os (Format c), SamplerFilter c,
    (EdgeMode, BorderColor c))
sf = ShaderM s (Sampler1DArray (Format c))
-> Shader os s (Sampler1DArray (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler1DArray (Format c))
 -> Shader os s (Sampler1DArray (Format c)))
-> ShaderM s (Sampler1DArray (Format c))
-> Shader os s (Sampler1DArray (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture1DArray TexName
tn Size2
_ Int
_, SamplerFilter c
filt, (EdgeMode
ex, BorderColor c
ec)) = s
-> (Texture1DArray os (Format c), SamplerFilter c,
    (EdgeMode, BorderColor c))
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY SamplerFilter c
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, Maybe EdgeMode
forall a. Maybe a
Nothing, Maybe EdgeMode
forall a. Maybe a
Nothing) (c -> GLenum -> BorderColor c -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (c
forall a. HasCallStack => a
undefined :: c) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY BorderColor c
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler1DArray (Format c) -> ShaderM s (Sampler1DArray (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler1DArray (Format c)
 -> ShaderM s (Sampler1DArray (Format c)))
-> Sampler1DArray (Format c)
-> ShaderM s (Sampler1DArray (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler1DArray (Format c)
forall f. Int -> Bool -> [Char] -> Sampler1DArray f
Sampler1DArray Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))
newSampler2D :: (s
 -> (Texture2D os (Format c), SamplerFilter c,
     (EdgeMode2, BorderColor c)))
-> Shader os s (Sampler2D (Format c))
newSampler2D s
-> (Texture2D os (Format c), SamplerFilter c,
    (EdgeMode2, BorderColor c))
sf = ShaderM s (Sampler2D (Format c))
-> Shader os s (Sampler2D (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler2D (Format c))
 -> Shader os s (Sampler2D (Format c)))
-> ShaderM s (Sampler2D (Format c))
-> Shader os s (Sampler2D (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture2D TexName
tn Size2
_ Int
_, SamplerFilter c
filt, (V2 EdgeMode
ex EdgeMode
ey, BorderColor c
ec)) = s
-> (Texture2D os (Format c), SamplerFilter c,
    (EdgeMode2, BorderColor c))
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D SamplerFilter c
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ey, Maybe EdgeMode
forall a. Maybe a
Nothing) (c -> GLenum -> BorderColor c -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (c
forall a. HasCallStack => a
undefined :: c) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D BorderColor c
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler2D (Format c) -> ShaderM s (Sampler2D (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler2D (Format c) -> ShaderM s (Sampler2D (Format c)))
-> Sampler2D (Format c) -> ShaderM s (Sampler2D (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler2D (Format c)
forall f. Int -> Bool -> [Char] -> Sampler2D f
Sampler2D Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))
newSampler2DArray :: (s
 -> (Texture2DArray os (Format c), SamplerFilter c,
     (EdgeMode2, BorderColor c)))
-> Shader os s (Sampler2DArray (Format c))
newSampler2DArray s
-> (Texture2DArray os (Format c), SamplerFilter c,
    (EdgeMode2, BorderColor c))
sf = ShaderM s (Sampler2DArray (Format c))
-> Shader os s (Sampler2DArray (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler2DArray (Format c))
 -> Shader os s (Sampler2DArray (Format c)))
-> ShaderM s (Sampler2DArray (Format c))
-> Shader os s (Sampler2DArray (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture2DArray TexName
tn Size3
_ Int
_, SamplerFilter c
filt, (V2 EdgeMode
ex EdgeMode
ey, BorderColor c
ec)) = s
-> (Texture2DArray os (Format c), SamplerFilter c,
    (EdgeMode2, BorderColor c))
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY SamplerFilter c
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ey, Maybe EdgeMode
forall a. Maybe a
Nothing) (c -> GLenum -> BorderColor c -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (c
forall a. HasCallStack => a
undefined :: c) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY BorderColor c
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler2DArray (Format c) -> ShaderM s (Sampler2DArray (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler2DArray (Format c)
 -> ShaderM s (Sampler2DArray (Format c)))
-> Sampler2DArray (Format c)
-> ShaderM s (Sampler2DArray (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler2DArray (Format c)
forall f. Int -> Bool -> [Char] -> Sampler2DArray f
Sampler2DArray Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))
newSampler3D :: (s
 -> (Texture3D os (Format c), SamplerFilter c,
     (EdgeMode3, BorderColor c)))
-> Shader os s (Sampler3D (Format c))
newSampler3D s
-> (Texture3D os (Format c), SamplerFilter c,
    (EdgeMode3, BorderColor c))
sf = ShaderM s (Sampler3D (Format c))
-> Shader os s (Sampler3D (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler3D (Format c))
 -> Shader os s (Sampler3D (Format c)))
-> ShaderM s (Sampler3D (Format c))
-> Shader os s (Sampler3D (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture3D TexName
tn Size3
_ Int
_, SamplerFilter c
filt, (V3 EdgeMode
ex EdgeMode
ey EdgeMode
ez, BorderColor c
ec)) = s
-> (Texture3D os (Format c), SamplerFilter c,
    (EdgeMode3, BorderColor c))
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D SamplerFilter c
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ey, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ez) (c -> GLenum -> BorderColor c -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (c
forall a. HasCallStack => a
undefined :: c) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_3D BorderColor c
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler3D (Format c) -> ShaderM s (Sampler3D (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler3D (Format c) -> ShaderM s (Sampler3D (Format c)))
-> Sampler3D (Format c) -> ShaderM s (Sampler3D (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler3D (Format c)
forall f. Int -> Bool -> [Char] -> Sampler3D f
Sampler3D Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))
newSamplerCube :: (s -> (TextureCube os (Format c), SamplerFilter c))
-> Shader os s (SamplerCube (Format c))
newSamplerCube s -> (TextureCube os (Format c), SamplerFilter c)
sf = ShaderM s (SamplerCube (Format c))
-> Shader os s (SamplerCube (Format c))
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (SamplerCube (Format c))
 -> Shader os s (SamplerCube (Format c)))
-> ShaderM s (SamplerCube (Format c))
-> Shader os s (SamplerCube (Format c))
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (TextureCube TexName
tn Int
_ Int
_, SamplerFilter c
filt) = s -> (TextureCube os (Format c), SamplerFilter c)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP Int
bind
                                                           GLenum -> IO ()
setNoShadowMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP
                                                           GLenum -> SamplerFilter c -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP SamplerFilter c
filt
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   SamplerCube (Format c) -> ShaderM s (SamplerCube (Format c))
forall (m :: * -> *) a. Monad m => a -> m a
return (SamplerCube (Format c) -> ShaderM s (SamplerCube (Format c)))
-> SamplerCube (Format c) -> ShaderM s (SamplerCube (Format c))
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> SamplerCube (Format c)
forall f. Int -> Bool -> [Char] -> SamplerCube f
SamplerCube Int
sampId Bool
False (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
samplerPrefix (c
forall a. HasCallStack => a
undefined :: c))


newSampler1DShadow :: (s
 -> (Texture1D os (Format d), SamplerFilter d,
     (EdgeMode, BorderColor d), ComparisonFunction))
-> Shader os s (Sampler1D Shadow)
newSampler1DShadow s
-> (Texture1D os (Format d), SamplerFilter d,
    (EdgeMode, BorderColor d), ComparisonFunction)
sf = ShaderM s (Sampler1D Shadow) -> Shader os s (Sampler1D Shadow)
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler1D Shadow) -> Shader os s (Sampler1D Shadow))
-> ShaderM s (Sampler1D Shadow) -> Shader os s (Sampler1D Shadow)
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture1D TexName
tn Int
_ Int
_, SamplerFilter d
filt, (EdgeMode
ex, BorderColor d
ec), ComparisonFunction
cf) = s
-> (Texture1D os (Format d), SamplerFilter d,
    (EdgeMode, BorderColor d), ComparisonFunction)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D Int
bind
                                                           GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D ComparisonFunction
cf
                                                           GLenum -> SamplerFilter d -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D SamplerFilter d
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, Maybe EdgeMode
forall a. Maybe a
Nothing, Maybe EdgeMode
forall a. Maybe a
Nothing) (d -> GLenum -> BorderColor d -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (d
forall a. HasCallStack => a
undefined :: d) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D BorderColor d
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler1D Shadow -> ShaderM s (Sampler1D Shadow)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler1D Shadow -> ShaderM s (Sampler1D Shadow))
-> Sampler1D Shadow -> ShaderM s (Sampler1D Shadow)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler1D Shadow
forall f. Int -> Bool -> [Char] -> Sampler1D f
Sampler1D Int
sampId Bool
True [Char]
""
newSampler1DArrayShadow :: (s
 -> (Texture1DArray os (Format d), SamplerFilter d,
     (EdgeMode, BorderColor d), ComparisonFunction))
-> Shader os s (Sampler1DArray Shadow)
newSampler1DArrayShadow s
-> (Texture1DArray os (Format d), SamplerFilter d,
    (EdgeMode, BorderColor d), ComparisonFunction)
sf = ShaderM s (Sampler1DArray Shadow)
-> Shader os s (Sampler1DArray Shadow)
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler1DArray Shadow)
 -> Shader os s (Sampler1DArray Shadow))
-> ShaderM s (Sampler1DArray Shadow)
-> Shader os s (Sampler1DArray Shadow)
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture1DArray TexName
tn Size2
_ Int
_, SamplerFilter d
filt, (EdgeMode
ex, BorderColor d
ec), ComparisonFunction
cf) = s
-> (Texture1DArray os (Format d), SamplerFilter d,
    (EdgeMode, BorderColor d), ComparisonFunction)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY Int
bind
                                                           GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY ComparisonFunction
cf
                                                           GLenum -> SamplerFilter d -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY SamplerFilter d
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, Maybe EdgeMode
forall a. Maybe a
Nothing, Maybe EdgeMode
forall a. Maybe a
Nothing) (d -> GLenum -> BorderColor d -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (d
forall a. HasCallStack => a
undefined :: d) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D_ARRAY BorderColor d
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler1DArray Shadow -> ShaderM s (Sampler1DArray Shadow)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler1DArray Shadow -> ShaderM s (Sampler1DArray Shadow))
-> Sampler1DArray Shadow -> ShaderM s (Sampler1DArray Shadow)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler1DArray Shadow
forall f. Int -> Bool -> [Char] -> Sampler1DArray f
Sampler1DArray Int
sampId Bool
True [Char]
""
newSampler2DShadow :: (s
 -> (Texture2D os d, SamplerFilter (Format d),
     (EdgeMode2, BorderColor d), ComparisonFunction))
-> Shader os s (Sampler2D Shadow)
newSampler2DShadow s
-> (Texture2D os d, SamplerFilter (Format d),
    (EdgeMode2, BorderColor d), ComparisonFunction)
sf = ShaderM s (Sampler2D Shadow) -> Shader os s (Sampler2D Shadow)
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler2D Shadow) -> Shader os s (Sampler2D Shadow))
-> ShaderM s (Sampler2D Shadow) -> Shader os s (Sampler2D Shadow)
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture2D TexName
tn Size2
_ Int
_, SamplerFilter (Format d)
filt, (V2 EdgeMode
ex EdgeMode
ey, BorderColor d
ec), ComparisonFunction
cf) = s
-> (Texture2D os d, SamplerFilter (Format d),
    (EdgeMode2, BorderColor d), ComparisonFunction)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D Int
bind
                                                           GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D ComparisonFunction
cf
                                                           GLenum -> SamplerFilter (Format d) -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D SamplerFilter (Format d)
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ey, Maybe EdgeMode
forall a. Maybe a
Nothing) (d -> GLenum -> BorderColor d -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (d
forall a. HasCallStack => a
undefined :: d) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D BorderColor d
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler2D Shadow -> ShaderM s (Sampler2D Shadow)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler2D Shadow -> ShaderM s (Sampler2D Shadow))
-> Sampler2D Shadow -> ShaderM s (Sampler2D Shadow)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler2D Shadow
forall f. Int -> Bool -> [Char] -> Sampler2D f
Sampler2D Int
sampId Bool
True [Char]
""
newSampler2DArrayShadow :: (s
 -> (Texture2DArray os (Format d), SamplerFilter d,
     (EdgeMode2, BorderColor d), ComparisonFunction))
-> Shader os s (Sampler2DArray Shadow)
newSampler2DArrayShadow s
-> (Texture2DArray os (Format d), SamplerFilter d,
    (EdgeMode2, BorderColor d), ComparisonFunction)
sf = ShaderM s (Sampler2DArray Shadow)
-> Shader os s (Sampler2DArray Shadow)
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (Sampler2DArray Shadow)
 -> Shader os s (Sampler2DArray Shadow))
-> ShaderM s (Sampler2DArray Shadow)
-> Shader os s (Sampler2DArray Shadow)
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (Texture2DArray TexName
tn Size3
_ Int
_, SamplerFilter d
filt, (V2 EdgeMode
ex EdgeMode
ey, BorderColor d
ec), ComparisonFunction
cf) = s
-> (Texture2DArray os (Format d), SamplerFilter d,
    (EdgeMode2, BorderColor d), ComparisonFunction)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY Int
bind
                                                           GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY ComparisonFunction
cf
                                                           GLenum -> SamplerFilter d -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY SamplerFilter d
filt
                                                           GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY (EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ex, EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ey, Maybe EdgeMode
forall a. Maybe a
Nothing) (d -> GLenum -> BorderColor d -> IO ()
forall f.
ColorSampleable f =>
f -> GLenum -> Color f (ColorElement f) -> IO ()
setBorderColor (d
forall a. HasCallStack => a
undefined :: d) GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D_ARRAY BorderColor d
ec)
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   Sampler2DArray Shadow -> ShaderM s (Sampler2DArray Shadow)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sampler2DArray Shadow -> ShaderM s (Sampler2DArray Shadow))
-> Sampler2DArray Shadow -> ShaderM s (Sampler2DArray Shadow)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> Sampler2DArray Shadow
forall f. Int -> Bool -> [Char] -> Sampler2DArray f
Sampler2DArray Int
sampId Bool
True [Char]
""
newSamplerCubeShadow :: (s
 -> (TextureCube os (Format d), SamplerFilter d,
     ComparisonFunction))
-> Shader os s (SamplerCube Shadow)
newSamplerCubeShadow s
-> (TextureCube os (Format d), SamplerFilter d, ComparisonFunction)
sf = ShaderM s (SamplerCube Shadow) -> Shader os s (SamplerCube Shadow)
forall os s a. ShaderM s a -> Shader os s a
Shader (ShaderM s (SamplerCube Shadow)
 -> Shader os s (SamplerCube Shadow))
-> ShaderM s (SamplerCube Shadow)
-> Shader os s (SamplerCube Shadow)
forall a b. (a -> b) -> a -> b
$ do
                   Int
sampId <- ShaderM s Int
forall s. ShaderM s Int
getNewName
                   Int -> (s -> Int -> IO Int) -> ShaderM s ()
forall s. Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
sampId ((s -> Int -> IO Int) -> ShaderM s ())
-> (s -> Int -> IO Int) -> ShaderM s ()
forall a b. (a -> b) -> a -> b
$ \s
s Int
bind -> let (TextureCube TexName
tn Int
_ Int
_, SamplerFilter d
filt, ComparisonFunction
cf) = s
-> (TextureCube os (Format d), SamplerFilter d, ComparisonFunction)
sf s
s
                                                    in  do Int
n <- TexName -> GLenum -> Int -> IO Int
forall a. Integral a => TexName -> GLenum -> a -> IO Int
useTex TexName
tn GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP Int
bind
                                                           GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP ComparisonFunction
cf
                                                           GLenum -> SamplerFilter d -> IO ()
forall a. GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP SamplerFilter d
filt
                                                           Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                   SamplerCube Shadow -> ShaderM s (SamplerCube Shadow)
forall (m :: * -> *) a. Monad m => a -> m a
return (SamplerCube Shadow -> ShaderM s (SamplerCube Shadow))
-> SamplerCube Shadow -> ShaderM s (SamplerCube Shadow)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Char] -> SamplerCube Shadow
forall f. Int -> Bool -> [Char] -> SamplerCube f
SamplerCube Int
sampId Bool
True [Char]
""

setNoShadowMode :: GLenum -> IO ()
setNoShadowMode :: GLenum -> IO ()
setNoShadowMode GLenum
t = 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_COMPARE_MODE GLint
forall a. (Eq a, Num a) => a
GL_NONE

setShadowFunc :: GLenum -> ComparisonFunction -> IO ()
setShadowFunc :: GLenum -> ComparisonFunction -> IO ()
setShadowFunc GLenum
t ComparisonFunction
cf = 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_COMPARE_MODE GLint
forall a. (Eq a, Num a) => a
GL_COMPARE_REF_TO_TEXTURE
    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_COMPARE_FUNC (ComparisonFunction -> GLint
forall a. (Num a, Eq a) => ComparisonFunction -> a
getGlCompFunc ComparisonFunction
cf)

setEdgeMode :: GLenum -> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode) -> IO () -> IO ()
setEdgeMode :: GLenum
-> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode)
-> IO ()
-> IO ()
setEdgeMode GLenum
t (Maybe EdgeMode
se,Maybe EdgeMode
te,Maybe EdgeMode
re) IO ()
bcio = do GLenum -> Maybe EdgeMode -> IO ()
glwrap GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_S Maybe EdgeMode
se
                                   GLenum -> Maybe EdgeMode -> IO ()
glwrap GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_T Maybe EdgeMode
te
                                   GLenum -> Maybe EdgeMode -> IO ()
glwrap GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_WRAP_R Maybe EdgeMode
re
                                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe EdgeMode
se Maybe EdgeMode -> Maybe EdgeMode -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ClampToBorder Bool -> Bool -> Bool
|| Maybe EdgeMode
te Maybe EdgeMode -> Maybe EdgeMode -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ClampToBorder Bool -> Bool -> Bool
|| Maybe EdgeMode
re Maybe EdgeMode -> Maybe EdgeMode -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
ClampToBorder)
                                      IO ()
bcio
    where glwrap :: GLenum -> Maybe EdgeMode -> IO ()
glwrap GLenum
_ Maybe EdgeMode
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          glwrap GLenum
x (Just EdgeMode
Repeat) = GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
x GLint
forall a. (Eq a, Num a) => a
GL_REPEAT
          glwrap GLenum
x (Just EdgeMode
Mirror) = GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
x GLint
forall a. (Eq a, Num a) => a
GL_MIRRORED_REPEAT
          glwrap GLenum
x (Just EdgeMode
ClampToEdge) = GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
x GLint
forall a. (Eq a, Num a) => a
GL_CLAMP_TO_EDGE
          glwrap GLenum
x (Just EdgeMode
ClampToBorder) = GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexParameteri GLenum
t GLenum
x GLint
forall a. (Eq a, Num a) => a
GL_CLAMP_TO_BORDER

setSamplerFilter :: GLenum -> SamplerFilter a -> IO ()
setSamplerFilter :: GLenum -> SamplerFilter a -> IO ()
setSamplerFilter GLenum
t (SamplerFilter Filter
magf Filter
minf Filter
lodf Anisotropy
a) = GLenum -> Filter -> Filter -> Filter -> Anisotropy -> IO ()
setSamplerFilter' GLenum
t Filter
magf Filter
minf Filter
lodf Anisotropy
a
setSamplerFilter GLenum
t SamplerFilter a
SamplerNearest = GLenum -> Filter -> Filter -> Filter -> Anisotropy -> IO ()
setSamplerFilter' GLenum
t Filter
Nearest Filter
Nearest Filter
Nearest Anisotropy
forall a. Maybe a
Nothing

setSamplerFilter' :: GLenum -> MagFilter -> MinFilter -> LodFilter -> Anisotropy -> IO ()
setSamplerFilter' :: GLenum -> Filter -> Filter -> Filter -> Anisotropy -> IO ()
setSamplerFilter' GLenum
t Filter
magf Filter
minf Filter
lodf Anisotropy
a = 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_MIN_FILTER GLint
glmin
                                           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
glmag
                                           case Anisotropy
a of
                                                Anisotropy
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                Just Float
a' -> GLenum -> GLenum -> Float -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Float -> m ()
glTexParameterf GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_MAX_ANISOTROPY_EXT (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a')
    where glmin :: GLint
glmin = case (Filter
minf, Filter
lodf) of
                    (Filter
Nearest, Filter
Nearest) -> GLint
forall a. (Eq a, Num a) => a
GL_NEAREST_MIPMAP_NEAREST
                    (Filter
Linear, Filter
Nearest) -> GLint
forall a. (Eq a, Num a) => a
GL_LINEAR_MIPMAP_NEAREST
                    (Filter
Nearest, Filter
Linear) -> GLint
forall a. (Eq a, Num a) => a
GL_NEAREST_MIPMAP_LINEAR
                    (Filter
Linear, Filter
Linear) -> GLint
forall a. (Eq a, Num a) => a
GL_LINEAR_MIPMAP_LINEAR
          glmag :: GLint
glmag = case Filter
magf of
                    Filter
Nearest -> GLint
forall a. (Eq a, Num a) => a
GL_NEAREST
                    Filter
Linear -> GLint
forall a. (Eq a, Num a) => a
GL_LINEAR




doForSampler :: Int -> (s -> Binding -> IO Int) -> ShaderM s ()
doForSampler :: Int -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler Int
n s -> Int -> IO Int
io = (RenderIOState s -> RenderIOState s) -> ShaderM s ()
forall s. (RenderIOState s -> RenderIOState s) -> ShaderM s ()
modifyRenderIO (\RenderIOState s
s -> RenderIOState s
s { samplerNameToRenderIO :: IntMap (s -> Int -> IO Int)
samplerNameToRenderIO = Int
-> (s -> Int -> IO Int)
-> IntMap (s -> Int -> IO Int)
-> IntMap (s -> Int -> IO Int)
forall a. Int -> a -> IntMap a -> IntMap a
insert Int
n s -> Int -> IO Int
io (RenderIOState s -> IntMap (s -> Int -> IO Int)
forall s. RenderIOState s -> IntMap (s -> Int -> IO Int)
samplerNameToRenderIO RenderIOState s
s) } )

-- | Used instead of 'Format' for shadow samplers. These samplers have specialized sampler values, see 'sample1DShadow' and friends.
data Shadow
data Sampler1D f = Sampler1D Int Bool String
data Sampler1DArray f = Sampler1DArray Int Bool String
data Sampler2D f = Sampler2D Int Bool String
data Sampler2DArray f = Sampler2DArray Int Bool String
data Sampler3D f = Sampler3D Int Bool String
data SamplerCube f = SamplerCube Int Bool String

-- | A GADT to specify where the level of detail and/or partial derivates should be taken from. Some values of this GADT are restricted to
--   only 'FragmentStream's.
data SampleLod vx x where
    SampleAuto :: SampleLod v F
    SampleBias :: FFloat -> SampleLod vx F
    SampleLod :: S x Float -> SampleLod vx x
    SampleGrad :: vx -> vx -> SampleLod vx x

-- | For some reason, OpenGl doesnt allow explicit lod to be specified for some sampler types, hence this extra GADT.
data SampleLod' vx x where
    SampleAuto' :: SampleLod' v F
    SampleBias' :: FFloat -> SampleLod' vx F
    SampleGrad' :: vx -> vx -> SampleLod' vx x

type SampleLod1 x = SampleLod (S x Float) x
type SampleLod2 x = SampleLod (V2 (S x Float)) x
type SampleLod3 x = SampleLod (V3 (S x Float)) x
type SampleLod2' x = SampleLod' (V2 (S x Float)) x
type SampleLod3' x = SampleLod' (V3 (S x Float)) x

fromLod' :: SampleLod' v x -> SampleLod v x
fromLod' :: SampleLod' v x -> SampleLod v x
fromLod' SampleLod' v x
SampleAuto' = SampleLod v x
forall v. SampleLod v F
SampleAuto
fromLod' (SampleBias' FFloat
x) = FFloat -> SampleLod v F
forall vx. FFloat -> SampleLod vx F
SampleBias FFloat
x
fromLod' (SampleGrad' v
x v
y) = v -> v -> SampleLod v x
forall vx x. vx -> vx -> SampleLod vx x
SampleGrad v
x v
y

type SampleProj x = Maybe (S x Float)
type SampleOffset1 x = Maybe Int
type SampleOffset2 x = Maybe (V2 Int)
type SampleOffset3 x = Maybe (V3 Int)

-- | The type of a color sample made by a texture t
type ColorSample x f = Color f (S x (ColorElement f))
type ReferenceValue x = S x Float

sample1D            :: forall c x. ColorSampleable c =>  Sampler1D (Format c)          -> SampleLod1 x -> SampleProj x -> SampleOffset1 x -> S x Float -> ColorSample x c
sample1DArray       :: forall c x. ColorSampleable c =>  Sampler1DArray (Format c)     -> SampleLod1 x -> SampleOffset1 x -> V2 (S x Float) -> ColorSample x c
sample2D            :: forall c x. ColorSampleable c =>  Sampler2D (Format c)          -> SampleLod2 x -> SampleProj x -> SampleOffset2 x -> V2 (S x Float) -> ColorSample x c
sample2DArray       :: forall c x. ColorSampleable c =>  Sampler2DArray (Format c)     -> SampleLod2 x -> SampleOffset2 x -> V3 (S x Float) -> ColorSample x c
sample3D            :: forall c x. ColorSampleable c =>  Sampler3D (Format c)          -> SampleLod3 x -> SampleProj x -> SampleOffset3 x -> V3 (S x Float) -> ColorSample x c
sampleCube          :: forall c x. ColorSampleable c =>  SamplerCube (Format c)        -> SampleLod3 x -> V3 (S x Float) -> ColorSample x c

sample1DShadow      :: forall x. Sampler1D Shadow     -> SampleLod1 x -> SampleProj x -> SampleOffset1 x -> ReferenceValue x -> S x Float -> S x Float
sample1DArrayShadow :: forall x. Sampler1DArray Shadow-> SampleLod1 x -> SampleOffset1 x -> ReferenceValue x -> V2 (S x Float) -> S x Float
sample2DShadow      :: forall x. Sampler2D Shadow     -> SampleLod2 x -> SampleProj x -> SampleOffset2 x -> ReferenceValue x -> V2 (S x Float) -> S x Float
sample2DArrayShadow :: forall x. Sampler2DArray Shadow-> SampleLod2' x -> SampleOffset2 x -> ReferenceValue x -> V3 (S x Float)-> S x Float
sampleCubeShadow    :: forall x. SamplerCube Shadow   -> SampleLod3' x -> ReferenceValue x -> V3 (S x Float) -> S x Float

sample1D :: Sampler1D (Format c)
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> S x Float
-> ColorSample x c
sample1D (Sampler1D Int
sampId Bool
_ [Char]
prefix) SampleLod1 x
lod SampleProj x
proj SampleOffset1 x
off S x Float
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> S x Float
-> (S x Float -> ExprM [Char])
-> (S x Float -> ExprM [Char])
-> (Int -> [Char])
-> (S x Float -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"1D" Int
sampId SampleLod1 x
lod SampleProj x
proj SampleOffset1 x
off S x Float
coord S x Float -> ExprM [Char]
forall c. S c Float -> ExprM [Char]
v1toF S x Float -> ExprM [Char]
forall c. S c Float -> ExprM [Char]
v1toF Int -> [Char]
civ1toF S x Float -> S x Float -> ExprM [Char]
forall c. S c Float -> S c Float -> ExprM [Char]
pv1toF
sample1DArray :: Sampler1DArray (Format c)
-> SampleLod1 x
-> SampleOffset1 x
-> V2 (S x Float)
-> ColorSample x c
sample1DArray (Sampler1DArray Int
sampId Bool
_ [Char]
prefix) SampleLod1 x
lod SampleOffset1 x
off V2 (S x Float)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> V2 (S x Float)
-> (V2 (S x Float) -> ExprM [Char])
-> (S x Float -> ExprM [Char])
-> (Int -> [Char])
-> (V2 (S x Float) -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"1DArray" Int
sampId SampleLod1 x
lod SampleProj x
forall a. Maybe a
Nothing SampleOffset1 x
off V2 (S x Float)
coord V2 (S x Float) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF S x Float -> ExprM [Char]
forall c. S c Float -> ExprM [Char]
v1toF Int -> [Char]
civ1toF V2 (S x Float) -> S x Float -> ExprM [Char]
forall a. HasCallStack => a
undefined
sample2D :: Sampler2D (Format c)
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> V2 (S x Float)
-> ColorSample x c
sample2D (Sampler2D Int
sampId Bool
_ [Char]
prefix) SampleLod2 x
lod SampleProj x
proj SampleOffset2 x
off V2 (S x Float)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> V2 (S x Float)
-> (V2 (S x Float) -> ExprM [Char])
-> (V2 (S x Float) -> ExprM [Char])
-> (Size2 -> [Char])
-> (V2 (S x Float) -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"2D" Int
sampId SampleLod2 x
lod SampleProj x
proj SampleOffset2 x
off V2 (S x Float)
coord V2 (S x Float) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF V2 (S x Float) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF Size2 -> [Char]
civ2toF V2 (S x Float) -> S x Float -> ExprM [Char]
forall c. V2 (S c Float) -> S c Float -> ExprM [Char]
pv2toF
sample2DArray :: Sampler2DArray (Format c)
-> SampleLod2 x
-> SampleOffset2 x
-> V3 (S x Float)
-> ColorSample x c
sample2DArray (Sampler2DArray Int
sampId Bool
_ [Char]
prefix) SampleLod2 x
lod SampleOffset2 x
off V3 (S x Float)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> V3 (S x Float)
-> (V3 (S x Float) -> ExprM [Char])
-> (V2 (S x Float) -> ExprM [Char])
-> (Size2 -> [Char])
-> (V3 (S x Float) -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"2DArray" Int
sampId SampleLod2 x
lod SampleProj x
forall a. Maybe a
Nothing SampleOffset2 x
off V3 (S x Float)
coord V3 (S x Float) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF V2 (S x Float) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF Size2 -> [Char]
civ2toF V3 (S x Float) -> S x Float -> ExprM [Char]
forall a. HasCallStack => a
undefined
sample3D :: Sampler3D (Format c)
-> SampleLod3 x
-> SampleProj x
-> SampleOffset3 x
-> V3 (S x Float)
-> ColorSample x c
sample3D (Sampler3D Int
sampId Bool
_ [Char]
prefix) SampleLod3 x
lod SampleProj x
proj SampleOffset3 x
off V3 (S x Float)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod3 x
-> SampleProj x
-> SampleOffset3 x
-> V3 (S x Float)
-> (V3 (S x Float) -> ExprM [Char])
-> (V3 (S x Float) -> ExprM [Char])
-> (Size3 -> [Char])
-> (V3 (S x Float) -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"3D" Int
sampId SampleLod3 x
lod SampleProj x
proj SampleOffset3 x
off V3 (S x Float)
coord V3 (S x Float) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF V3 (S x Float) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF Size3 -> [Char]
civ3toF V3 (S x Float) -> S x Float -> ExprM [Char]
forall c. V3 (S c Float) -> S c Float -> ExprM [Char]
pv3toF
sampleCube :: SamplerCube (Format c)
-> SampleLod3 x -> V3 (S x Float) -> ColorSample x c
sampleCube (SamplerCube Int
sampId Bool
_ [Char]
prefix) SampleLod3 x
lod V3 (S x Float)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod3 x
-> SampleProj x
-> Maybe Any
-> V3 (S x Float)
-> (V3 (S x Float) -> ExprM [Char])
-> (V3 (S x Float) -> ExprM [Char])
-> (Any -> [Char])
-> (V3 (S x Float) -> S x Float -> ExprM [Char])
-> V4 (S x (ColorElement c))
forall e lcoord x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"Cube" Int
sampId SampleLod3 x
lod SampleProj x
forall a. Maybe a
Nothing Maybe Any
forall a. Maybe a
Nothing V3 (S x Float)
coord V3 (S x Float) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF V3 (S x Float) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF Any -> [Char]
forall a. HasCallStack => a
undefined V3 (S x Float) -> S x Float -> ExprM [Char]
forall a. HasCallStack => a
undefined

sample1DShadow :: Sampler1D Shadow
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> ReferenceValue x
-> ReferenceValue x
-> ReferenceValue x
sample1DShadow (Sampler1D Int
sampId Bool
_ [Char]
_) SampleLod1 x
lod SampleProj x
proj SampleOffset1 x
off ReferenceValue x
ref ReferenceValue x
coord = [Char]
-> Int
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM [Char])
-> (ReferenceValue x -> ExprM [Char])
-> (Int -> [Char])
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char])
-> ReferenceValue x
forall lcoord x off coord.
[Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
"1D" Int
sampId SampleLod1 x
lod SampleProj x
proj SampleOffset1 x
off (ReferenceValue x -> ReferenceValue x -> V3 (ReferenceValue x)
forall x. S x Float -> S x Float -> V3 (S x Float)
t1t3 ReferenceValue x
coord ReferenceValue x
ref) V3 (ReferenceValue x) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF ReferenceValue x -> ExprM [Char]
forall c. S c Float -> ExprM [Char]
v1toF Int -> [Char]
civ1toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char]
forall c. V3 (S c Float) -> S c Float -> ExprM [Char]
pv3toF
sample1DArrayShadow :: Sampler1DArray Shadow
-> SampleLod1 x
-> SampleOffset1 x
-> ReferenceValue x
-> V2 (ReferenceValue x)
-> ReferenceValue x
sample1DArrayShadow (Sampler1DArray Int
sampId Bool
_ [Char]
_) SampleLod1 x
lod SampleOffset1 x
off ReferenceValue x
ref V2 (ReferenceValue x)
coord = [Char]
-> Int
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM [Char])
-> (ReferenceValue x -> ExprM [Char])
-> (Int -> [Char])
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char])
-> ReferenceValue x
forall lcoord x off coord.
[Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
"1DArray" Int
sampId SampleLod1 x
lod SampleProj x
forall a. Maybe a
Nothing SampleOffset1 x
off (V2 (ReferenceValue x) -> ReferenceValue x -> V3 (ReferenceValue x)
forall t. V2 t -> t -> V3 t
t2t3 V2 (ReferenceValue x)
coord ReferenceValue x
ref) V3 (ReferenceValue x) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF ReferenceValue x -> ExprM [Char]
forall c. S c Float -> ExprM [Char]
v1toF Int -> [Char]
civ1toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char]
forall a. HasCallStack => a
undefined
sample2DShadow :: Sampler2D Shadow
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> ReferenceValue x
-> V2 (ReferenceValue x)
-> ReferenceValue x
sample2DShadow (Sampler2D Int
sampId Bool
_ [Char]
_) SampleLod2 x
lod SampleProj x
proj SampleOffset2 x
off ReferenceValue x
ref V2 (ReferenceValue x)
coord = [Char]
-> Int
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM [Char])
-> (V2 (ReferenceValue x) -> ExprM [Char])
-> (Size2 -> [Char])
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char])
-> ReferenceValue x
forall lcoord x off coord.
[Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
"2D" Int
sampId SampleLod2 x
lod SampleProj x
proj SampleOffset2 x
off (V2 (ReferenceValue x) -> ReferenceValue x -> V3 (ReferenceValue x)
forall t. V2 t -> t -> V3 t
t2t3 V2 (ReferenceValue x)
coord ReferenceValue x
ref) V3 (ReferenceValue x) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF V2 (ReferenceValue x) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF Size2 -> [Char]
civ2toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char]
forall c. V3 (S c Float) -> S c Float -> ExprM [Char]
pv3toF
sample2DArrayShadow :: Sampler2DArray Shadow
-> SampleLod2' x
-> SampleOffset2 x
-> ReferenceValue x
-> V3 (ReferenceValue x)
-> ReferenceValue x
sample2DArrayShadow (Sampler2DArray Int
sampId Bool
_ [Char]
_) SampleLod2' x
lod SampleOffset2 x
off ReferenceValue x
ref V3 (ReferenceValue x)
coord = [Char]
-> Int
-> SampleLod (V2 (ReferenceValue x)) x
-> SampleProj x
-> SampleOffset2 x
-> V4 (ReferenceValue x)
-> (V4 (ReferenceValue x) -> ExprM [Char])
-> (V2 (ReferenceValue x) -> ExprM [Char])
-> (Size2 -> [Char])
-> (V4 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char])
-> ReferenceValue x
forall lcoord x off coord.
[Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
"2DArray" Int
sampId (SampleLod2' x -> SampleLod (V2 (ReferenceValue x)) x
forall v x. SampleLod' v x -> SampleLod v x
fromLod' SampleLod2' x
lod) SampleProj x
forall a. Maybe a
Nothing SampleOffset2 x
off (V3 (ReferenceValue x) -> ReferenceValue x -> V4 (ReferenceValue x)
forall t. V3 t -> t -> V4 t
t3t4 V3 (ReferenceValue x)
coord ReferenceValue x
ref) V4 (ReferenceValue x) -> ExprM [Char]
forall c. V4 (S c Float) -> ExprM [Char]
v4toF V2 (ReferenceValue x) -> ExprM [Char]
forall c. V2 (S c Float) -> ExprM [Char]
v2toF Size2 -> [Char]
civ2toF V4 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char]
forall a. HasCallStack => a
undefined
sampleCubeShadow :: SamplerCube Shadow
-> SampleLod3' x
-> ReferenceValue x
-> V3 (ReferenceValue x)
-> ReferenceValue x
sampleCubeShadow (SamplerCube Int
sampId Bool
_ [Char]
_) SampleLod3' x
lod ReferenceValue x
ref V3 (ReferenceValue x)
coord = [Char]
-> Int
-> SampleLod (V3 (ReferenceValue x)) x
-> SampleProj x
-> Maybe Any
-> V4 (ReferenceValue x)
-> (V4 (ReferenceValue x) -> ExprM [Char])
-> (V3 (ReferenceValue x) -> ExprM [Char])
-> (Any -> [Char])
-> (V4 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char])
-> ReferenceValue x
forall lcoord x off coord.
[Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
"Cube" Int
sampId (SampleLod3' x -> SampleLod (V3 (ReferenceValue x)) x
forall v x. SampleLod' v x -> SampleLod v x
fromLod' SampleLod3' x
lod) SampleProj x
forall a. Maybe a
Nothing Maybe Any
forall a. Maybe a
Nothing (V3 (ReferenceValue x) -> ReferenceValue x -> V4 (ReferenceValue x)
forall t. V3 t -> t -> V4 t
t3t4 V3 (ReferenceValue x)
coord ReferenceValue x
ref) V4 (ReferenceValue x) -> ExprM [Char]
forall c. V4 (S c Float) -> ExprM [Char]
v4toF V3 (ReferenceValue x) -> ExprM [Char]
forall c. V3 (S c Float) -> ExprM [Char]
v3toF Any -> [Char]
forall a. HasCallStack => a
undefined V4 (ReferenceValue x) -> ReferenceValue x -> ExprM [Char]
forall a. HasCallStack => a
undefined

t1t3 :: S x Float -> S x Float -> V3 (S x Float)
t2t3 :: V2 t -> t -> V3 t
t3t4 :: V3 t -> t -> V4 t
t1t3 :: S x Float -> S x Float -> V3 (S x Float)
t1t3 S x Float
x = S x Float -> S x Float -> S x Float -> V3 (S x Float)
forall a. a -> a -> a -> V3 a
V3 S x Float
x S x Float
0
t2t3 :: V2 t -> t -> V3 t
t2t3 (V2 t
x t
y) = t -> t -> t -> V3 t
forall a. a -> a -> a -> V3 a
V3 t
x t
y
t3t4 :: V3 t -> t -> V4 t
t3t4 (V3 t
x t
y t
z) = t -> t -> t -> t -> V4 t
forall a. a -> a -> a -> a -> V4 a
V4 t
x t
y t
z

texelFetch1D        :: forall c x. ColorSampleable c =>  Sampler1D (Format c)          -> SampleOffset1 x -> S x Level -> S x Int -> ColorSample x c
texelFetch1DArray   :: forall c x. ColorSampleable c =>  Sampler1DArray (Format c)     -> SampleOffset1 x -> S x Level -> V2(S x Int) -> ColorSample x c
texelFetch2D        :: forall c x. ColorSampleable c =>  Sampler2D (Format c)          -> SampleOffset2 x -> S x Level -> V2 (S x Int) -> ColorSample x c
texelFetch2DArray   :: forall c x. ColorSampleable c =>  Sampler2DArray (Format c)     -> SampleOffset2 x -> S x Level -> V3 (S x Int) -> ColorSample x c
texelFetch3D        :: forall c x. ColorSampleable c =>  Sampler3D (Format c)          -> SampleOffset3 x -> S x Level -> V3 (S x Int) -> ColorSample x c

texelFetch1D :: Sampler1D (Format c)
-> SampleOffset1 x -> S x Int -> S x Int -> ColorSample x c
texelFetch1D (Sampler1D Int
sampId Bool
_ [Char]
prefix) SampleOffset1 x
off S x Int
lod S x Int
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> SampleOffset1 x
-> S x Int
-> (S x Int -> ExprM [Char])
-> (Int -> [Char])
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"1D" Int
sampId S x Int
lod SampleOffset1 x
off S x Int
coord S x Int -> ExprM [Char]
forall c. S c Int -> ExprM [Char]
iv1toF Int -> [Char]
civ1toF
texelFetch1DArray :: Sampler1DArray (Format c)
-> SampleOffset1 x -> S x Int -> V2 (S x Int) -> ColorSample x c
texelFetch1DArray (Sampler1DArray Int
sampId Bool
_ [Char]
prefix) SampleOffset1 x
off S x Int
lod V2 (S x Int)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> SampleOffset1 x
-> V2 (S x Int)
-> (V2 (S x Int) -> ExprM [Char])
-> (Int -> [Char])
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"1DArray" Int
sampId S x Int
lod SampleOffset1 x
off V2 (S x Int)
coord V2 (S x Int) -> ExprM [Char]
forall c. V2 (S c Int) -> ExprM [Char]
iv2toF Int -> [Char]
civ1toF
texelFetch2D :: Sampler2D (Format c)
-> SampleOffset2 x -> S x Int -> V2 (S x Int) -> ColorSample x c
texelFetch2D (Sampler2D Int
sampId Bool
_ [Char]
prefix) SampleOffset2 x
off S x Int
lod V2 (S x Int)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> SampleOffset2 x
-> V2 (S x Int)
-> (V2 (S x Int) -> ExprM [Char])
-> (Size2 -> [Char])
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"2D" Int
sampId S x Int
lod SampleOffset2 x
off V2 (S x Int)
coord V2 (S x Int) -> ExprM [Char]
forall c. V2 (S c Int) -> ExprM [Char]
iv2toF Size2 -> [Char]
civ2toF
texelFetch2DArray :: Sampler2DArray (Format c)
-> SampleOffset2 x -> S x Int -> V3 (S x Int) -> ColorSample x c
texelFetch2DArray (Sampler2DArray Int
sampId Bool
_ [Char]
prefix) SampleOffset2 x
off S x Int
lod V3 (S x Int)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> SampleOffset2 x
-> V3 (S x Int)
-> (V3 (S x Int) -> ExprM [Char])
-> (Size2 -> [Char])
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"2DArray" Int
sampId S x Int
lod SampleOffset2 x
off V3 (S x Int)
coord V3 (S x Int) -> ExprM [Char]
forall c. V3 (S c Int) -> ExprM [Char]
iv3toF Size2 -> [Char]
civ2toF
texelFetch3D :: Sampler3D (Format c)
-> SampleOffset3 x -> S x Int -> V3 (S x Int) -> ColorSample x c
texelFetch3D (Sampler3D Int
sampId Bool
_ [Char]
prefix) SampleOffset3 x
off S x Int
lod V3 (S x Int)
coord = c -> V4 (S x (ColorElement c)) -> ColorSample x c
forall f x. ColorSampleable f => f -> V4 x -> Color f x
toColor (c
forall a. HasCallStack => a
undefined :: c) (V4 (S x (ColorElement c)) -> ColorSample x c)
-> V4 (S x (ColorElement c)) -> ColorSample x c
forall a b. (a -> b) -> a -> b
$ ColorElement c
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> SampleOffset3 x
-> V3 (S x Int)
-> (V3 (S x Int) -> ExprM [Char])
-> (Size3 -> [Char])
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) [Char]
prefix (c -> [Char]
forall f. ColorSampleable f => f -> [Char]
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) [Char]
"3D" Int
sampId S x Int
lod SampleOffset3 x
off V3 (S x Int)
coord V3 (S x Int) -> ExprM [Char]
forall c. V3 (S c Int) -> ExprM [Char]
iv3toF Size3 -> [Char]
civ3toF

sampler1DSize      :: Sampler1D f -> S x Level -> S x Int
sampler1DArraySize :: Sampler1DArray f -> S x Level -> V2 (S x Int)
sampler2DSize      :: Sampler2D f -> S x Level -> V2 (S x Int)
sampler2DArraySize :: Sampler2DArray f -> S x Level -> V3 (S x Int)
sampler3DSize      :: Sampler3D f -> S x Level -> V3 (S x Int)
samplerCubeSize    :: SamplerCube f -> S x Level -> S x Int

sampler1DSize :: Sampler1D f -> S x Int -> S x Int
sampler1DSize (Sampler1D Int
sampId Bool
shadow [Char]
prefix) = SType -> ExprM [Char] -> S x Int
forall c a. SType -> ExprM [Char] -> S c a
scalarS SType
STypeInt (ExprM [Char] -> S x Int)
-> (S x Int -> ExprM [Char]) -> S x Int -> S x Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"1D")
sampler1DArraySize :: Sampler1DArray f -> S x Int -> V2 (S x Int)
sampler1DArraySize (Sampler1DArray Int
sampId Bool
shadow [Char]
prefix) = SType -> ExprM [Char] -> V2 (S x Int)
forall c a. SType -> ExprM [Char] -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM [Char] -> V2 (S x Int))
-> (S x Int -> ExprM [Char]) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"1DArray")
sampler2DSize :: Sampler2D f -> S x Int -> V2 (S x Int)
sampler2DSize (Sampler2D Int
sampId Bool
shadow [Char]
prefix) = SType -> ExprM [Char] -> V2 (S x Int)
forall c a. SType -> ExprM [Char] -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM [Char] -> V2 (S x Int))
-> (S x Int -> ExprM [Char]) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"2D")
sampler2DArraySize :: Sampler2DArray f -> S x Int -> V3 (S x Int)
sampler2DArraySize (Sampler2DArray Int
sampId Bool
shadow [Char]
prefix) = SType -> ExprM [Char] -> V3 (S x Int)
forall c a. SType -> ExprM [Char] -> V3 (S c a)
vec3S (Int -> SType
STypeIVec Int
3) (ExprM [Char] -> V3 (S x Int))
-> (S x Int -> ExprM [Char]) -> S x Int -> V3 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"2DArray")
sampler3DSize :: Sampler3D f -> S x Int -> V3 (S x Int)
sampler3DSize (Sampler3D Int
sampId Bool
shadow [Char]
prefix) = SType -> ExprM [Char] -> V3 (S x Int)
forall c a. SType -> ExprM [Char] -> V3 (S c a)
vec3S (Int -> SType
STypeIVec Int
3) (ExprM [Char] -> V3 (S x Int))
-> (S x Int -> ExprM [Char]) -> S x Int -> V3 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"3D")
samplerCubeSize :: SamplerCube f -> S x Int -> S x Int
samplerCubeSize (SamplerCube Int
sampId Bool
shadow [Char]
prefix) = (\(V2 S x Int
x S x Int
_) -> S x Int
x) (V2 (S x Int) -> S x Int)
-> (S x Int -> V2 (S x Int)) -> S x Int -> S x Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SType -> ExprM [Char] -> V2 (S x Int)
forall c a. SType -> ExprM [Char] -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM [Char] -> V2 (S x Int))
-> (S x Int -> ExprM [Char]) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> [Char] -> S x Int -> ExprM [Char]
forall c. [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId (Bool -> ShowS
addShadowPrefix Bool
shadow [Char]
"Cube")

addShadowPrefix :: Bool -> String -> String
addShadowPrefix :: Bool -> ShowS
addShadowPrefix Bool
shadow = if Bool
shadow then ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Shadow") else ShowS
forall a. a -> a
id

getTextureSize :: String -> Int -> String -> S c Int -> ExprM String
getTextureSize :: [Char] -> Int -> [Char] -> S c Int -> ExprM [Char]
getTextureSize [Char]
prefix Int
sampId [Char]
sName S c Int
l = do [Char]
s <- [Char] -> [Char] -> Int -> ExprM [Char]
useSampler [Char]
prefix [Char]
sName Int
sampId
                                          [Char]
l' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
l
                                          [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"textureSize(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
l' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

sample :: e -> String -> String -> String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> V4 (S x e)
sample :: e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> V4 (S x e)
sample e
_ [Char]
prefix [Char]
sDynType [Char]
sName Int
sampId SampleLod lcoord x
lod SampleProj x
proj Maybe off
off coord
coord coord -> ExprM [Char]
vToS lcoord -> ExprM [Char]
lvToS off -> [Char]
ivToS coord -> S x Float -> ExprM [Char]
pvToS =
    SType -> ExprM [Char] -> V4 (S x e)
forall c a. SType -> ExprM [Char] -> V4 (S c a)
vec4S ([Char] -> SType
STypeDyn [Char]
sDynType) (ExprM [Char] -> V4 (S x e)) -> ExprM [Char] -> V4 (S x e)
forall a b. (a -> b) -> a -> b
$ do [Char]
s <- [Char] -> [Char] -> Int -> ExprM [Char]
useSampler [Char]
prefix [Char]
sName Int
sampId
                                   [Char]
-> SampleProj x
-> SampleLod lcoord x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> ExprM [Char]
forall a vx x t t.
[Char]
-> Maybe a
-> SampleLod vx x
-> Maybe t
-> t
-> (t -> ExprM [Char])
-> (vx -> ExprM [Char])
-> (t -> [Char])
-> (t -> a -> ExprM [Char])
-> ExprM [Char]
sampleFunc [Char]
s SampleProj x
proj SampleLod lcoord x
lod Maybe off
off coord
coord coord -> ExprM [Char]
vToS lcoord -> ExprM [Char]
lvToS off -> [Char]
ivToS coord -> S x Float -> ExprM [Char]
pvToS

sampleShadow :: String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> S x Float
sampleShadow :: [Char]
-> Int
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> S x Float
sampleShadow [Char]
sName Int
sampId SampleLod lcoord x
lod SampleProj x
proj Maybe off
off coord
coord coord -> ExprM [Char]
vToS lcoord -> ExprM [Char]
lvToS off -> [Char]
civToS coord -> S x Float -> ExprM [Char]
pvToS =
    SType -> ExprM [Char] -> S x Float
forall c a. SType -> ExprM [Char] -> S c a
scalarS SType
STypeFloat (ExprM [Char] -> S x Float) -> ExprM [Char] -> S x Float
forall a b. (a -> b) -> a -> b
$ do [Char]
s <- [Char] -> [Char] -> Int -> ExprM [Char]
useSampler [Char]
"" ([Char]
sName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Shadow") Int
sampId
                            [Char]
-> SampleProj x
-> SampleLod lcoord x
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (lcoord -> ExprM [Char])
-> (off -> [Char])
-> (coord -> S x Float -> ExprM [Char])
-> ExprM [Char]
forall a vx x t t.
[Char]
-> Maybe a
-> SampleLod vx x
-> Maybe t
-> t
-> (t -> ExprM [Char])
-> (vx -> ExprM [Char])
-> (t -> [Char])
-> (t -> a -> ExprM [Char])
-> ExprM [Char]
sampleFunc [Char]
s SampleProj x
proj SampleLod lcoord x
lod Maybe off
off coord
coord coord -> ExprM [Char]
vToS lcoord -> ExprM [Char]
lvToS off -> [Char]
civToS coord -> S x Float -> ExprM [Char]
pvToS

fetch :: e -> String -> String -> String -> Int -> S x Int -> Maybe off -> coord -> (coord -> ExprM String) -> (off -> String) -> V4 (S x e)
fetch :: e
-> [Char]
-> [Char]
-> [Char]
-> Int
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> V4 (S x e)
fetch e
_ [Char]
prefix [Char]
sDynType [Char]
sName Int
sampId S x Int
lod Maybe off
off coord
coord coord -> ExprM [Char]
ivToS off -> [Char]
civToS =
    SType -> ExprM [Char] -> V4 (S x e)
forall c a. SType -> ExprM [Char] -> V4 (S c a)
vec4S ([Char] -> SType
STypeDyn [Char]
sDynType) (ExprM [Char] -> V4 (S x e)) -> ExprM [Char] -> V4 (S x e)
forall a b. (a -> b) -> a -> b
$ do [Char]
s <- [Char] -> [Char] -> Int -> ExprM [Char]
useSampler [Char]
prefix [Char]
sName Int
sampId
                                   [Char]
-> Maybe off
-> coord
-> S x Int
-> (coord -> ExprM [Char])
-> (off -> [Char])
-> ExprM [Char]
forall t t x a.
[Char]
-> Maybe t
-> t
-> S x a
-> (t -> ExprM [Char])
-> (t -> [Char])
-> ExprM [Char]
fetchFunc [Char]
s Maybe off
off coord
coord S x Int
lod coord -> ExprM [Char]
ivToS off -> [Char]
civToS

v1toF :: S c Float -> ExprM String
v2toF :: V2 (S c Float) -> ExprM String
v3toF :: V3 (S c Float) -> ExprM String
v4toF :: V4 (S c Float) -> ExprM String
v1toF :: S c Float -> ExprM [Char]
v1toF = S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS
v2toF :: V2 (S c Float) -> ExprM [Char]
v2toF (V2 S c Float
x S c Float
y) = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                    [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                    [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec2(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
v3toF :: V3 (S c Float) -> ExprM [Char]
v3toF (V3 S c Float
x S c Float
y S c Float
z) = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                      [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                      [Char]
z' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
z
                      [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec3(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
z' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
v4toF :: V4 (S c Float) -> ExprM [Char]
v4toF (V4 S c Float
x S c Float
y S c Float
z S c Float
w) = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                        [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                        [Char]
z' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
z
                        [Char]
w' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
w
                        [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec4(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
z' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
w' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

iv1toF :: S c Int -> ExprM String
iv2toF :: V2 (S c Int) -> ExprM String
iv3toF :: V3 (S c Int) -> ExprM String
iv1toF :: S c Int -> ExprM [Char]
iv1toF = S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS
iv2toF :: V2 (S c Int) -> ExprM [Char]
iv2toF (V2 S c Int
x S c Int
y) = do [Char]
x' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
x
                     [Char]
y' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
y
                     [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"ivec2(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
iv3toF :: V3 (S c Int) -> ExprM [Char]
iv3toF (V3 S c Int
x S c Int
y S c Int
z) = do [Char]
x' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
x
                       [Char]
y' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
y
                       [Char]
z' <- S c Int -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Int
z
                       [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"ivec3(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
z' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

civ1toF :: Int -> String
civ2toF :: V2 Int -> String
civ3toF :: V3 Int -> String
civ1toF :: Int -> [Char]
civ1toF = Int -> [Char]
forall a. Show a => a -> [Char]
show
civ2toF :: Size2 -> [Char]
civ2toF (V2 Int
x Int
y) = [Char]
"ivec2(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
civ3toF :: Size3 -> [Char]
civ3toF (V3 Int
x Int
y Int
z) = [Char]
"ivec3(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
z [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
pv1toF :: S c Float -> S c Float -> ExprM String
pv2toF :: V2 (S c Float) -> S c Float -> ExprM String
pv3toF :: V3 (S c Float) -> S c Float -> ExprM String

pv1toF :: S c Float -> S c Float -> ExprM [Char]
pv1toF S c Float
x S c Float
y = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec2(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
pv2toF :: V2 (S c Float) -> S c Float -> ExprM [Char]
pv2toF (V2 S c Float
x S c Float
y) S c Float
z = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                       [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                       [Char]
z' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
z
                       [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec3(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
z' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
pv3toF :: V3 (S c Float) -> S c Float -> ExprM [Char]
pv3toF (V3 S c Float
x S c Float
y S c Float
z) S c Float
w = do [Char]
x' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
x
                         [Char]
y' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
y
                         [Char]
z' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
z
                         [Char]
w' <- S c Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S c Float
w
                         [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"vec4(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
y' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
z' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++  Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
w' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

sampleFunc :: [Char]
-> Maybe a
-> SampleLod vx x
-> Maybe t
-> t
-> (t -> ExprM [Char])
-> (vx -> ExprM [Char])
-> (t -> [Char])
-> (t -> a -> ExprM [Char])
-> ExprM [Char]
sampleFunc [Char]
s Maybe a
proj SampleLod vx x
lod Maybe t
off t
coord t -> ExprM [Char]
vToS vx -> ExprM [Char]
lvToS t -> [Char]
civToS t -> a -> ExprM [Char]
pvToS = do
    [Char]
pc <- Maybe a -> ExprM [Char]
projCoordParam Maybe a
proj
    [Char]
l <- SampleLod vx x -> ExprM [Char]
lodParam SampleLod vx x
lod
    [Char]
b <- SampleLod vx x -> ExprM [Char]
forall v x. SampleLod v x -> ExprM [Char]
biasParam SampleLod vx x
lod
    [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"texture" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Char]
forall a. Maybe a -> [Char]
projName Maybe a
proj [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SampleLod vx x -> [Char]
forall vx x. SampleLod vx x -> [Char]
lodName SampleLod vx x
lod [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe t -> [Char]
forall a. Maybe a -> [Char]
offName Maybe t
off [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
pc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
o [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  where
    o :: [Char]
o = Maybe t -> (t -> [Char]) -> [Char]
forall t. Maybe t -> (t -> [Char]) -> [Char]
offParam Maybe t
off t -> [Char]
civToS

    projName :: Maybe a -> [Char]
projName Maybe a
Nothing = [Char]
""
    projName Maybe a
_ = [Char]
"Proj"

    projCoordParam :: Maybe a -> ExprM [Char]
projCoordParam Maybe a
Nothing = t -> ExprM [Char]
vToS t
coord
    projCoordParam (Just a
p) = t -> a -> ExprM [Char]
pvToS t
coord a
p

    lodParam :: SampleLod vx x -> ExprM [Char]
lodParam (SampleLod S x Float
x) = ShowS -> ExprM [Char] -> ExprM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) (S x Float -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S x Float
x)
    lodParam (SampleGrad vx
x vx
y) = [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) ([Char] -> ShowS)
-> ExprM [Char]
-> SNMapReaderT
     [[Char]] (StateT ExprState (WriterT [Char] (StateT Int IO))) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShowS -> ExprM [Char] -> ExprM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) (vx -> ExprM [Char]
lvToS vx
x) SNMapReaderT
  [[Char]] (StateT ExprState (WriterT [Char] (StateT Int IO))) ShowS
-> ExprM [Char] -> ExprM [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShowS -> ExprM [Char] -> ExprM [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) (vx -> ExprM [Char]
lvToS vx
y)
    lodParam SampleLod vx x
_ = [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""

    biasParam :: SampleLod v x -> ExprM String
    biasParam :: SampleLod v x -> ExprM [Char]
biasParam (SampleBias (S ExprM [Char]
x)) = do [Char]
x' <- ExprM [Char]
x
                                      [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
x'
    biasParam SampleLod v x
_ = [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""

    lodName :: SampleLod vx x -> [Char]
lodName (SampleLod S x Float
_) = [Char]
"Lod"
    lodName (SampleGrad vx
_ vx
_) = [Char]
"Grad"
    lodName SampleLod vx x
_ = [Char]
""

fetchFunc :: [Char]
-> Maybe t
-> t
-> S x a
-> (t -> ExprM [Char])
-> (t -> [Char])
-> ExprM [Char]
fetchFunc [Char]
s Maybe t
off t
coord S x a
lod t -> ExprM [Char]
vToS t -> [Char]
civToS = do
    [Char]
c <- t -> ExprM [Char]
vToS t
coord
    [Char]
l <- S x a -> ExprM [Char]
forall x a. S x a -> ExprM [Char]
unS S x a
lod
    [Char] -> ExprM [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ExprM [Char]) -> [Char] -> ExprM [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"texelFetch" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe t -> [Char]
forall a. Maybe a -> [Char]
offName Maybe t
off [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
','Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
o [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  where
    o :: [Char]
o = Maybe t -> (t -> [Char]) -> [Char]
forall t. Maybe t -> (t -> [Char]) -> [Char]
offParam Maybe t
off t -> [Char]
civToS

offParam :: Maybe t -> (t -> String) -> String
offParam :: Maybe t -> (t -> [Char]) -> [Char]
offParam Maybe t
Nothing t -> [Char]
_ = [Char]
""
offParam (Just t
x) t -> [Char]
civToS = Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: t -> [Char]
civToS t
x

offName :: Maybe t -> String
offName :: Maybe t -> [Char]
offName Maybe t
Nothing = [Char]
""
offName Maybe t
_ = [Char]
"Offset"

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

-- | A texture image is a reference to a 2D array of pixels in a texture. Some textures contain one 'Image' per level of detail while some contain several.
data Image f = Image TexName Int Int (V2 Int) (GLuint -> IO ()) -- the two Ints is last two in FBOKey

instance Eq (Image f) where
    == :: Image f -> Image f -> Bool
(==) = Image f -> Image f -> Bool
forall a b. Image a -> Image b -> Bool
imageEquals

-- | Compare two images that doesn't necessarily has same type
imageEquals :: Image a -> Image b -> Bool
imageEquals :: Image a -> Image b -> Bool
imageEquals (Image TexName
tn' Int
k1' Int
k2' Size2
_ GLenum -> IO ()
_) (Image TexName
tn Int
k1 Int
k2 Size2
_ GLenum -> IO ()
_) = TexName
tn' TexName -> TexName -> Bool
forall a. Eq a => a -> a -> Bool
== TexName
tn Bool -> Bool -> Bool
&& Int
k1' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k1 Bool -> Bool -> Bool
&& Int
k2' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k2

getImageBinding :: Image t -> GLuint -> IO ()
getImageBinding :: Image t -> GLenum -> IO ()
getImageBinding (Image TexName
_ Int
_ Int
_ Size2
_ GLenum -> IO ()
io) = GLenum -> IO ()
io

getImageFBOKey :: Image t -> IO FBOKey
getImageFBOKey :: Image t -> IO FBOKey
getImageFBOKey (Image TexName
tn Int
k1 Int
k2 Size2
_ GLenum -> IO ()
_) = do GLenum
tn' <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
                                         FBOKey -> IO FBOKey
forall (m :: * -> *) a. Monad m => a -> m a
return (FBOKey -> IO FBOKey) -> FBOKey -> IO FBOKey
forall a b. (a -> b) -> a -> b
$ GLenum -> Int -> Int -> FBOKey
FBOKey GLenum
tn' Int
k1 Int
k2
-- | Retrieve the 2D size an image
imageSize :: Image f -> V2 Int
imageSize :: Image f -> Size2
imageSize (Image TexName
_ Int
_ Int
_ Size2
s GLenum -> IO ()
_) = Size2
s

getTexture1DImage :: Texture1D os f -> Level -> Render os (Image f)
getTexture1DArrayImage :: Texture1DArray os f -> Level -> Int -> Render os (Image f)
getTexture2DImage :: Texture2D os f -> Level -> Render os (Image f)
getTexture2DArrayImage :: Texture2DArray os f -> Level -> Int -> Render os (Image f)
getTexture3DImage :: Texture3D os f -> Level -> Int -> Render os (Image f)
getTextureCubeImage :: TextureCube os f -> Level -> CubeSide -> Render os (Image f)
getLayeredTextureImage :: Texture3D os f -> MaxLevels -> Render os (Image f)

registerRenderWriteTextureName :: IORef a -> Render os ()
registerRenderWriteTextureName IORef a
tn = ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
forall os a.
ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ReaderT RenderEnv (StateT RenderState IO) a
-> ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) a
 -> ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a)
-> ReaderT RenderEnv (StateT RenderState IO) a
-> ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO a
-> ReaderT RenderEnv (StateT RenderState IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO a
 -> ReaderT RenderEnv (StateT RenderState IO) a)
-> StateT RenderState IO a
-> ReaderT RenderEnv (StateT RenderState IO) a
forall a b. (a -> b) -> a -> b
$ IO a -> StateT RenderState IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> StateT RenderState IO a)
-> IO a -> StateT RenderState IO a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
tn) Render os a -> (a -> Render os ()) -> Render os ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Render os ()
forall os. Int -> Render os ()
registerRenderWriteTexture (Int -> Render os ()) -> (a -> Int) -> a -> Render os ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

getTexture1DImage :: Texture1D os f -> Int -> Render os (Image f)
getTexture1DImage t :: Texture1D os f
t@(Texture1D TexName
tn Int
_ Int
ls) Int
l' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
0 Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 (Texture1D os f -> [Int]
forall os f. Texture1D os f -> [Int]
texture1DSizes Texture1D os f
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l) Int
1) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> GLint -> m ()
glFramebufferTexture1D GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_1D GLenum
n (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

getTexture1DArrayImage :: Texture1DArray os f -> Int -> Int -> Render os (Image f)
getTexture1DArrayImage t :: Texture1DArray os f
t@(Texture1DArray TexName
tn Size2
_ Int
ls) Int
l' Int
y' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
        V2 Int
x Int
y = Texture1DArray os f -> [Size2]
forall os f. Texture1DArray os f -> [Size2]
texture1DArraySizes Texture1DArray os f
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
y' Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 Int
x Int
1) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLint -> GLint -> m ()
glFramebufferTextureLayer GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
n (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 -> GLint) -> Int -> GLint
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
y' (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

getTexture2DImage :: Texture2D os f -> Int -> Render os (Image f)
getTexture2DImage t :: Texture2D os f
t@(Texture2D TexName
tn Size2
_ Int
ls) Int
l' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
0 Int
l (Texture2D os f -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os f
t [Size2] -> Int -> Size2
forall a. [a] -> Int -> a
!! Int
l) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> GLint -> m ()
glFramebufferTexture2D GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_2D GLenum
n (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

getTexture2DImage t :: Texture2D os f
t@(RenderBuffer2D TexName
tn Size2
_) Int
_ =
    Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn (-Int
1) Int
0 ([Size2] -> Size2
forall a. [a] -> a
head ([Size2] -> Size2) -> [Size2] -> Size2
forall a b. (a -> b) -> a -> b
$ Texture2D os f -> [Size2]
forall os f. Texture2D os f -> [Size2]
texture2DSizes Texture2D os f
t) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
        GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
        GLenum -> GLenum -> GLenum -> GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> m ()
glFramebufferRenderbuffer GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
forall a. (Eq a, Num a) => a
GL_RENDERBUFFER GLenum
n

getTexture2DArrayImage :: Texture2DArray os f -> Int -> Int -> Render os (Image f)
getTexture2DArrayImage t :: Texture2DArray os f
t@(Texture2DArray TexName
tn Size3
_ Int
ls) Int
l' Int
z' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
        V3 Int
x Int
y Int
z = Texture2DArray os f -> [Size3]
forall os f. Texture2DArray os f -> [Size3]
texture2DArraySizes Texture2DArray os f
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
z' Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 Int
x Int
y) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLint -> GLint -> m ()
glFramebufferTextureLayer GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
n (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 -> GLint) -> Int -> GLint
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
z' (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

getTexture3DImage :: Texture3D os f -> Int -> Int -> Render os (Image f)
getTexture3DImage t :: Texture3D os f
t@(Texture3D TexName
tn Size3
_ Int
ls) Int
l' Int
z' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
        V3 Int
x Int
y Int
z = Texture3D os f -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os f
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
z' Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 Int
x Int
y) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLint -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLint -> GLint -> m ()
glFramebufferTextureLayer GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
n (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 -> GLint) -> Int -> GLint
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
z' (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

getTextureCubeImage :: TextureCube os f -> Int -> CubeSide -> Render os (Image f)
getTextureCubeImage t :: TextureCube os f
t@(TextureCube TexName
tn Int
_ Int
ls) Int
l' CubeSide
s =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
        x :: Int
x = TextureCube os f -> [Int]
forall os f. TextureCube os f -> [Int]
textureCubeSizes TextureCube os f
t [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
l
        s' :: GLenum
s' = CubeSide -> GLenum
getGlCubeSide CubeSide
s
    in do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn (GLenum -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
s') Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 Int
x Int
x) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> GLint -> m ()
glFramebufferTexture2D GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
s' GLenum
n (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

-- Experimental. Meant to be used with a geometry shader and emitVertex(PositionAnd)Layer.
getLayeredTextureImage :: Texture3D os f -> Int -> Render os (Image f)
getLayeredTextureImage t :: Texture3D os f
t@(Texture3D TexName
tn Size3
_ Int
ls) Int
l' =
    let l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
l'
        V3 Int
x Int
y Int
_ = Texture3D os f -> [Size3]
forall os f. Texture3D os f -> [Size3]
texture3DSizes Texture3D os f
t [Size3] -> Int -> Size3
forall a. [a] -> Int -> a
!! Int
l
    in  do
        TexName -> Render os ()
forall a os. Integral a => IORef a -> Render os ()
registerRenderWriteTextureName TexName
tn
        Image f -> Render os (Image f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Image f -> Render os (Image f)) -> Image f -> Render os (Image f)
forall a b. (a -> b) -> a -> b
$ TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
forall f.
TexName -> Int -> Int -> Size2 -> (GLenum -> IO ()) -> Image f
Image TexName
tn Int
0 Int
l (Int -> Int -> Size2
forall a. a -> a -> V2 a
V2 Int
x Int
y) ((GLenum -> IO ()) -> Image f) -> (GLenum -> IO ()) -> Image f
forall a b. (a -> b) -> a -> b
$ \GLenum
attP -> do
            GLenum
n <- TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn
            GLenum -> GLenum -> GLenum -> GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLint -> m ()
glFramebufferTexture GLenum
forall a. (Eq a, Num a) => a
GL_DRAW_FRAMEBUFFER GLenum
attP GLenum
n (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

getGlCubeSide :: CubeSide -> GLenum
getGlCubeSide :: CubeSide -> GLenum
getGlCubeSide CubeSide
CubePosX = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_POSITIVE_X
getGlCubeSide CubeSide
CubeNegX = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_NEGATIVE_X
getGlCubeSide CubeSide
CubePosY = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_POSITIVE_Y
getGlCubeSide CubeSide
CubeNegY = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_NEGATIVE_Y
getGlCubeSide CubeSide
CubePosZ = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_POSITIVE_Z
getGlCubeSide CubeSide
CubeNegZ = GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_CUBE_MAP_NEGATIVE_Z