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

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

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

type MaxLevels = Int

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

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

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

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

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

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

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

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


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

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

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

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

type TexName = IORef GLuint

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

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

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

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


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

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


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

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


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

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

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

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

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

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


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

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

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 :: SamplerId -> (s -> Binding -> IO Int) -> ShaderM s ()
doForSampler :: SamplerId -> (s -> Int -> IO Int) -> ShaderM s ()
doForSampler SamplerId
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 SamplerId (s -> Int -> IO Int)
samplerNameToRenderIO = SamplerId
-> (s -> Int -> IO Int)
-> IntMap SamplerId (s -> Int -> IO Int)
-> IntMap SamplerId (s -> Int -> IO Int)
forall k v. Integral k => k -> v -> IntMap k v -> IntMap k v
insert SamplerId
n s -> Int -> IO Int
io (RenderIOState s -> IntMap SamplerId (s -> Int -> IO Int)
forall s. RenderIOState s -> IntMap SamplerId (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 SamplerId Bool Text
data Sampler1DArray f = Sampler1DArray SamplerId Bool Text
data Sampler2D f = Sampler2D SamplerId Bool Text
data Sampler2DArray f = Sampler2DArray SamplerId Bool Text
data Sampler3D f = Sampler3D SamplerId Bool Text
data SamplerCube f = SamplerCube SamplerId Bool Text

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

sample1DShadow :: Sampler1D Shadow
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> ReferenceValue x
-> ReferenceValue x
-> ReferenceValue x
sample1DShadow (Sampler1D SamplerId
sampId Bool
_ Text
_) SampleLod1 x
lod SampleProj x
proj SampleOffset1 x
off ReferenceValue x
ref ReferenceValue x
coord = Text
-> SamplerId
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM Text)
-> (ReferenceValue x -> ExprM Text)
-> (Int -> Text)
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text)
-> ReferenceValue x
forall lcoord x off coord.
Text
-> SamplerId
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (lcoord -> ExprM Text)
-> (off -> Text)
-> (coord -> S x Float -> ExprM Text)
-> S x Float
sampleShadow Text
"1D" SamplerId
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 Text
forall c. V3 (S c Float) -> ExprM Text
v3toF ReferenceValue x -> ExprM Text
forall c. S c Float -> ExprM Text
v1toF Int -> Text
civ1toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text
forall c. V3 (S c Float) -> S c Float -> ExprM Text
pv3toF
sample1DArrayShadow :: Sampler1DArray Shadow
-> SampleLod1 x
-> SampleOffset1 x
-> ReferenceValue x
-> V2 (ReferenceValue x)
-> ReferenceValue x
sample1DArrayShadow (Sampler1DArray SamplerId
sampId Bool
_ Text
_) SampleLod1 x
lod SampleOffset1 x
off ReferenceValue x
ref V2 (ReferenceValue x)
coord = Text
-> SamplerId
-> SampleLod1 x
-> SampleProj x
-> SampleOffset1 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM Text)
-> (ReferenceValue x -> ExprM Text)
-> (Int -> Text)
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text)
-> ReferenceValue x
forall lcoord x off coord.
Text
-> SamplerId
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (lcoord -> ExprM Text)
-> (off -> Text)
-> (coord -> S x Float -> ExprM Text)
-> S x Float
sampleShadow Text
"1DArray" SamplerId
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 Text
forall c. V3 (S c Float) -> ExprM Text
v3toF ReferenceValue x -> ExprM Text
forall c. S c Float -> ExprM Text
v1toF Int -> Text
civ1toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text
forall a. HasCallStack => a
undefined
sample2DShadow :: Sampler2D Shadow
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> ReferenceValue x
-> V2 (ReferenceValue x)
-> ReferenceValue x
sample2DShadow (Sampler2D SamplerId
sampId Bool
_ Text
_) SampleLod2 x
lod SampleProj x
proj SampleOffset2 x
off ReferenceValue x
ref V2 (ReferenceValue x)
coord = Text
-> SamplerId
-> SampleLod2 x
-> SampleProj x
-> SampleOffset2 x
-> V3 (ReferenceValue x)
-> (V3 (ReferenceValue x) -> ExprM Text)
-> (V2 (ReferenceValue x) -> ExprM Text)
-> (Size2 -> Text)
-> (V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text)
-> ReferenceValue x
forall lcoord x off coord.
Text
-> SamplerId
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (lcoord -> ExprM Text)
-> (off -> Text)
-> (coord -> S x Float -> ExprM Text)
-> S x Float
sampleShadow Text
"2D" SamplerId
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 Text
forall c. V3 (S c Float) -> ExprM Text
v3toF V2 (ReferenceValue x) -> ExprM Text
forall c. V2 (S c Float) -> ExprM Text
v2toF Size2 -> Text
civ2toF V3 (ReferenceValue x) -> ReferenceValue x -> ExprM Text
forall c. V3 (S c Float) -> S c Float -> ExprM Text
pv3toF
sample2DArrayShadow :: Sampler2DArray Shadow
-> SampleLod2' x
-> SampleOffset2 x
-> ReferenceValue x
-> V3 (ReferenceValue x)
-> ReferenceValue x
sample2DArrayShadow (Sampler2DArray SamplerId
sampId Bool
_ Text
_) SampleLod2' x
lod SampleOffset2 x
off ReferenceValue x
ref V3 (ReferenceValue x)
coord = Text
-> SamplerId
-> SampleLod (V2 (ReferenceValue x)) x
-> SampleProj x
-> SampleOffset2 x
-> V4 (ReferenceValue x)
-> (V4 (ReferenceValue x) -> ExprM Text)
-> (V2 (ReferenceValue x) -> ExprM Text)
-> (Size2 -> Text)
-> (V4 (ReferenceValue x) -> ReferenceValue x -> ExprM Text)
-> ReferenceValue x
forall lcoord x off coord.
Text
-> SamplerId
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (lcoord -> ExprM Text)
-> (off -> Text)
-> (coord -> S x Float -> ExprM Text)
-> S x Float
sampleShadow Text
"2DArray" SamplerId
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 Text
forall c. V4 (S c Float) -> ExprM Text
v4toF V2 (ReferenceValue x) -> ExprM Text
forall c. V2 (S c Float) -> ExprM Text
v2toF Size2 -> Text
civ2toF V4 (ReferenceValue x) -> ReferenceValue x -> ExprM Text
forall a. HasCallStack => a
undefined
sampleCubeShadow :: SamplerCube Shadow
-> SampleLod3' x
-> ReferenceValue x
-> V3 (ReferenceValue x)
-> ReferenceValue x
sampleCubeShadow (SamplerCube SamplerId
sampId Bool
_ Text
_) SampleLod3' x
lod ReferenceValue x
ref V3 (ReferenceValue x)
coord = Text
-> SamplerId
-> SampleLod (V3 (ReferenceValue x)) x
-> SampleProj x
-> Maybe Any
-> V4 (ReferenceValue x)
-> (V4 (ReferenceValue x) -> ExprM Text)
-> (V3 (ReferenceValue x) -> ExprM Text)
-> (Any -> Text)
-> (V4 (ReferenceValue x) -> ReferenceValue x -> ExprM Text)
-> ReferenceValue x
forall lcoord x off coord.
Text
-> SamplerId
-> SampleLod lcoord x
-> SampleProj x
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (lcoord -> ExprM Text)
-> (off -> Text)
-> (coord -> S x Float -> ExprM Text)
-> S x Float
sampleShadow Text
"Cube" SamplerId
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 Text
forall c. V4 (S c Float) -> ExprM Text
v4toF V3 (ReferenceValue x) -> ExprM Text
forall c. V3 (S c Float) -> ExprM Text
v3toF Any -> Text
forall a. HasCallStack => a
undefined V4 (ReferenceValue x) -> ReferenceValue x -> ExprM Text
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 SamplerId
sampId Bool
_ Text
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
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> SampleOffset1 x
-> S x Int
-> (S x Int -> ExprM Text)
-> (Int -> Text)
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (off -> Text)
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) Text
prefix (c -> Text
forall f. ColorSampleable f => f -> Text
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) Text
"1D" SamplerId
sampId S x Int
lod SampleOffset1 x
off S x Int
coord S x Int -> ExprM Text
forall c. S c Int -> ExprM Text
iv1toF Int -> Text
civ1toF
texelFetch1DArray :: Sampler1DArray (Format c)
-> SampleOffset1 x -> S x Int -> V2 (S x Int) -> ColorSample x c
texelFetch1DArray (Sampler1DArray SamplerId
sampId Bool
_ Text
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
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> SampleOffset1 x
-> V2 (S x Int)
-> (V2 (S x Int) -> ExprM Text)
-> (Int -> Text)
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (off -> Text)
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) Text
prefix (c -> Text
forall f. ColorSampleable f => f -> Text
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) Text
"1DArray" SamplerId
sampId S x Int
lod SampleOffset1 x
off V2 (S x Int)
coord V2 (S x Int) -> ExprM Text
forall c. V2 (S c Int) -> ExprM Text
iv2toF Int -> Text
civ1toF
texelFetch2D :: Sampler2D (Format c)
-> SampleOffset2 x -> S x Int -> V2 (S x Int) -> ColorSample x c
texelFetch2D (Sampler2D SamplerId
sampId Bool
_ Text
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
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> SampleOffset2 x
-> V2 (S x Int)
-> (V2 (S x Int) -> ExprM Text)
-> (Size2 -> Text)
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (off -> Text)
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) Text
prefix (c -> Text
forall f. ColorSampleable f => f -> Text
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) Text
"2D" SamplerId
sampId S x Int
lod SampleOffset2 x
off V2 (S x Int)
coord V2 (S x Int) -> ExprM Text
forall c. V2 (S c Int) -> ExprM Text
iv2toF Size2 -> Text
civ2toF
texelFetch2DArray :: Sampler2DArray (Format c)
-> SampleOffset2 x -> S x Int -> V3 (S x Int) -> ColorSample x c
texelFetch2DArray (Sampler2DArray SamplerId
sampId Bool
_ Text
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
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> SampleOffset2 x
-> V3 (S x Int)
-> (V3 (S x Int) -> ExprM Text)
-> (Size2 -> Text)
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (off -> Text)
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) Text
prefix (c -> Text
forall f. ColorSampleable f => f -> Text
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) Text
"2DArray" SamplerId
sampId S x Int
lod SampleOffset2 x
off V3 (S x Int)
coord V3 (S x Int) -> ExprM Text
forall c. V3 (S c Int) -> ExprM Text
iv3toF Size2 -> Text
civ2toF
texelFetch3D :: Sampler3D (Format c)
-> SampleOffset3 x -> S x Int -> V3 (S x Int) -> ColorSample x c
texelFetch3D (Sampler3D SamplerId
sampId Bool
_ Text
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
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> SampleOffset3 x
-> V3 (S x Int)
-> (V3 (S x Int) -> ExprM Text)
-> (Size3 -> Text)
-> V4 (S x (ColorElement c))
forall e x off coord.
e
-> Text
-> Text
-> Text
-> SamplerId
-> S x Int
-> Maybe off
-> coord
-> (coord -> ExprM Text)
-> (off -> Text)
-> V4 (S x e)
fetch (ColorElement c
forall a. HasCallStack => a
undefined :: ColorElement c) Text
prefix (c -> Text
forall f. ColorSampleable f => f -> Text
typeStr4 (c
forall a. HasCallStack => a
undefined :: c)) Text
"3D" SamplerId
sampId S x Int
lod SampleOffset3 x
off V3 (S x Int)
coord V3 (S x Int) -> ExprM Text
forall c. V3 (S c Int) -> ExprM Text
iv3toF Size3 -> Text
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 SamplerId
sampId Bool
shadow Text
prefix) = SType -> ExprM Text -> S x Int
forall c a. SType -> ExprM Text -> S c a
scalarS SType
STypeInt (ExprM Text -> S x Int)
-> (S x Int -> ExprM Text) -> S x Int -> S x Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"1D")
sampler1DArraySize :: Sampler1DArray f -> S x Int -> V2 (S x Int)
sampler1DArraySize (Sampler1DArray SamplerId
sampId Bool
shadow Text
prefix) = SType -> ExprM Text -> V2 (S x Int)
forall c a. SType -> ExprM Text -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM Text -> V2 (S x Int))
-> (S x Int -> ExprM Text) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"1DArray")
sampler2DSize :: Sampler2D f -> S x Int -> V2 (S x Int)
sampler2DSize (Sampler2D SamplerId
sampId Bool
shadow Text
prefix) = SType -> ExprM Text -> V2 (S x Int)
forall c a. SType -> ExprM Text -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM Text -> V2 (S x Int))
-> (S x Int -> ExprM Text) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"2D")
sampler2DArraySize :: Sampler2DArray f -> S x Int -> V3 (S x Int)
sampler2DArraySize (Sampler2DArray SamplerId
sampId Bool
shadow Text
prefix) = SType -> ExprM Text -> V3 (S x Int)
forall c a. SType -> ExprM Text -> V3 (S c a)
vec3S (Int -> SType
STypeIVec Int
3) (ExprM Text -> V3 (S x Int))
-> (S x Int -> ExprM Text) -> S x Int -> V3 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"2DArray")
sampler3DSize :: Sampler3D f -> S x Int -> V3 (S x Int)
sampler3DSize (Sampler3D SamplerId
sampId Bool
shadow Text
prefix) = SType -> ExprM Text -> V3 (S x Int)
forall c a. SType -> ExprM Text -> V3 (S c a)
vec3S (Int -> SType
STypeIVec Int
3) (ExprM Text -> V3 (S x Int))
-> (S x Int -> ExprM Text) -> S x Int -> V3 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"3D")
samplerCubeSize :: SamplerCube f -> S x Int -> S x Int
samplerCubeSize (SamplerCube SamplerId
sampId Bool
shadow Text
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 Text -> V2 (S x Int)
forall c a. SType -> ExprM Text -> V2 (S c a)
vec2S (Int -> SType
STypeIVec Int
2) (ExprM Text -> V2 (S x Int))
-> (S x Int -> ExprM Text) -> S x Int -> V2 (S x Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SamplerId -> Text -> S x Int -> ExprM Text
forall c. Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId (Bool -> Text -> Text
addShadowPrefix Bool
shadow Text
"Cube")

addShadowPrefix :: Bool -> Text -> Text
addShadowPrefix :: Bool -> Text -> Text
addShadowPrefix Bool
shadow = if Bool
shadow then (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Shadow") else Text -> Text
forall a. a -> a
id

getTextureSize :: Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize :: Text -> SamplerId -> Text -> S c Int -> ExprM Text
getTextureSize Text
prefix SamplerId
sampId Text
sName S c Int
l = do Text
s <- Text -> Text -> SamplerId -> ExprM Text
useSampler Text
prefix Text
sName SamplerId
sampId
                                          Text
l' <- S c Int -> ExprM Text
forall x a. S x a -> ExprM Text
unS S c Int
l
                                          Text -> ExprM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExprM Text) -> Text -> ExprM Text
forall a b. (a -> b) -> a -> b
$ Text
"textureSize(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

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

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

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

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

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

civ1toF :: Int -> Text
civ2toF :: V2 Int -> Text
civ3toF :: V3 Int -> Text
civ1toF :: Int -> Text
civ1toF = Int -> Text
forall a. Show a => a -> Text
tshow
civ2toF :: Size2 -> Text
civ2toF (V2 Int
x Int
y) = Text
"ivec2(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
civ3toF :: Size3 -> Text
civ3toF (V3 Int
x Int
y Int
z) = Text
"ivec3(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
z Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
pv1toF :: S c Float -> S c Float -> ExprM Text
pv2toF :: V2 (S c Float) -> S c Float -> ExprM Text
pv3toF :: V3 (S c Float) -> S c Float -> ExprM Text

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

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

    projName :: Maybe a -> p
projName Maybe a
Nothing = p
""
    projName Maybe a
_       = p
"Proj"

    projCoordParam :: Maybe a -> ExprM Text
projCoordParam Maybe a
Nothing  = coord -> ExprM Text
vToS coord
coord
    projCoordParam (Just a
p) = coord -> a -> ExprM Text
pvToS coord
coord a
p

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

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

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

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

offParam :: Maybe t -> (t -> Text) -> Text
offParam :: Maybe t -> (t -> Text) -> Text
offParam Maybe t
Nothing t -> Text
_       = Text
""
offParam (Just t
x) t -> Text
civToS = Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> t -> Text
civToS t
x

offName :: Maybe t -> Text
offName :: Maybe t -> Text
offName Maybe t
Nothing = Text
""
offName Maybe t
_       = Text
"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 :: TexName -> Render os ()
registerRenderWriteTextureName :: TexName -> Render os ()
registerRenderWriteTextureName TexName
tn = ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) GLenum
-> Render os GLenum
forall os a.
ExceptT [Char] (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ReaderT RenderEnv (StateT RenderState IO) GLenum
-> ExceptT
     [Char] (ReaderT RenderEnv (StateT RenderState IO)) GLenum
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT RenderEnv (StateT RenderState IO) GLenum
 -> ExceptT
      [Char] (ReaderT RenderEnv (StateT RenderState IO)) GLenum)
-> ReaderT RenderEnv (StateT RenderState IO) GLenum
-> ExceptT
     [Char] (ReaderT RenderEnv (StateT RenderState IO)) GLenum
forall a b. (a -> b) -> a -> b
$ StateT RenderState IO GLenum
-> ReaderT RenderEnv (StateT RenderState IO) GLenum
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RenderState IO GLenum
 -> ReaderT RenderEnv (StateT RenderState IO) GLenum)
-> StateT RenderState IO GLenum
-> ReaderT RenderEnv (StateT RenderState IO) GLenum
forall a b. (a -> b) -> a -> b
$ IO GLenum -> StateT RenderState IO GLenum
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GLenum -> StateT RenderState IO GLenum)
-> IO GLenum -> StateT RenderState IO GLenum
forall a b. (a -> b) -> a -> b
$ TexName -> IO GLenum
forall a. IORef a -> IO a
readIORef TexName
tn) Render os GLenum -> (GLenum -> 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 ()) -> (GLenum -> Int) -> GLenum -> Render os ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> 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 os. TexName -> 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 os. TexName -> 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 os. TexName -> 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 os. TexName -> 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 os. TexName -> 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 os. TexName -> 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 os. TexName -> 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