{-# LANGUAGE Arrows               #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Graphics.GPipe.Internal.Buffer
(
    BufferFormat(..),
    BufferColor,
    Buffer(),
    ToBuffer(..),
    B(..), B2(..), B3(..), B4(..),
    toB22, toB3, toB21, toB12, toB11,
    Uniform(..), Normalized(..), BPacked(),
    BInput(..),
    newBuffer,
    writeBuffer,
    copyBuffer,
    BufferStartPos,
    bufSize, bufName, bufElementSize, bufferLength, bufBElement, bufTransformFeedback, bufferWriteInternal, makeBuffer, getUniformAlignment, UniformAlignment
) where

import           Control.Arrow                     (Arrow (arr, first),
                                                    Kleisli (..), returnA)
import           Control.Category                  (Category (..))
import           Control.Monad                     (void)
import           Control.Monad.IO.Class            (MonadIO (..))
import           Control.Monad.Trans.Class         (lift)
import           Control.Monad.Trans.Reader        (Reader, ask, runReader)
import           Control.Monad.Trans.State.Strict  (StateT (runStateT), get,
                                                    put)
import           Control.Monad.Trans.Writer.Strict (WriterT (runWriterT), tell)
import           Data.IORef                        (IORef, newIORef, readIORef)
import           Data.Int                          (Int16, Int32, Int8)
import           Data.Word                         (Word16, Word32, Word8)
import           Foreign.Marshal.Alloc             (alloca)
import           Foreign.Marshal.Utils             (with)
import           Foreign.Ptr                       (Ptr, castPtr, minusPtr,
                                                    nullPtr, plusPtr)
import           Foreign.Storable                  (Storable (peek, peekElemOff, poke, sizeOf))
import           Graphics.GL.Core45
import           Graphics.GL.Types                 (GLenum, GLuint)
import           Graphics.GPipe.Internal.Context   (ContextHandler, ContextT,
                                                    addContextFinalizer,
                                                    addVAOBufferFinalizer,
                                                    liftNonWinContextAsyncIO,
                                                    liftNonWinContextIO)
import           Linear                            (Quaternion (..), V0 (..),
                                                    V1 (..), V2 (..), V3 (..),
                                                    V4 (..))
import           Linear.Affine                     (Point (..))
import           Linear.Plucker                    (Plucker (..))
import           Prelude                           hiding (id, (.))

-- | The class that constraints which types can live in a buffer.
class BufferFormat f where
    -- | The type a value of this format has when it lives on the host (i.e. normal Haskell world)
    type HostFormat f
    -- | An arrow action that turns a value from it's host representation to it's buffer representation. Use 'toBuffer' from
    --   the GPipe provided instances to operate in this arrow. Also note that this arrow needs to be able to return a value
    --   lazily, so ensure you use
    --
    --   @proc ~pattern -> do ...@
    toBuffer :: ToBuffer (HostFormat f) f
    getGlType :: f -> GLenum
    peekPixel :: f -> Ptr () -> IO (HostFormat f)
    getGlPaddedFormat :: f -> GLenum
    getGlType = [Char] -> f -> GLenum
forall a. HasCallStack => [Char] -> a
error [Char]
"This is only defined for BufferColor types"
    peekPixel = [Char] -> f -> Ptr () -> IO (HostFormat f)
forall a. HasCallStack => [Char] -> a
error [Char]
"This is only defined for BufferColor types"
    getGlPaddedFormat = [Char] -> f -> GLenum
forall a. HasCallStack => [Char] -> a
error [Char]
"This is only defined for BufferColor types"

-- | A @Buffer os b@ lives in the object space @os@ and contains elements of type @b@.
data Buffer os b = Buffer
    {   Buffer os b -> BufferName
bufName              :: BufferName
    ,   Buffer os b -> Int
bufElementSize       :: Int
        -- | Retrieve the number of elements in a buffer.
    ,   Buffer os b -> Int
bufferLength         :: Int
    ,   Buffer os b -> BInput -> b
bufBElement          :: BInput -> b
    ,   Buffer os b -> Ptr () -> HostFormat b -> IO ()
bufWriter            :: Ptr () -> HostFormat b -> IO ()
    ,   Buffer os b -> IORef (Maybe (GLenum, GLenum))
bufTransformFeedback :: IORef (Maybe (GLuint, GLuint))
    }

instance Eq (Buffer os b) where
    Buffer os b
a == :: Buffer os b -> Buffer os b -> Bool
== Buffer os b
b = Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
a BufferName -> BufferName -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
b

bufSize :: forall os b. Buffer os b -> Int
bufSize :: Buffer os b -> Int
bufSize Buffer os b
b = 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
* Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
b

type BufferName = IORef GLuint
type Offset = Int
type Stride = Int
type BufferStartPos = Int

data BInput = BInput
    {   BInput -> Int
bInSkipElems   :: Int
    ,   BInput -> Int
bInInstanceDiv :: Int
    }

type UniformAlignment = Int

data AlignmentMode = Align4 | AlignUniform | AlignPackedIndices | AlignUnknown deriving (AlignmentMode -> AlignmentMode -> Bool
(AlignmentMode -> AlignmentMode -> Bool)
-> (AlignmentMode -> AlignmentMode -> Bool) -> Eq AlignmentMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignmentMode -> AlignmentMode -> Bool
$c/= :: AlignmentMode -> AlignmentMode -> Bool
== :: AlignmentMode -> AlignmentMode -> Bool
$c== :: AlignmentMode -> AlignmentMode -> Bool
Eq)

-- | The arrow type for 'toBuffer'.
data ToBuffer a b = ToBuffer
    !(Kleisli (StateT Offset (WriterT [Int] (Reader (UniformAlignment, AlignmentMode)))) a b) -- Normal = aligned to 4 bytes
    !(Kleisli (StateT Offset (Reader (BufferName, Stride, BInput))) a b)
    !(Kleisli (StateT (Ptr (), [Int]) IO) a b) -- Normal = aligned to 4 bytes
    !AlignmentMode

instance Category ToBuffer where
    {-# INLINE id #-}
    id :: ToBuffer a a
id = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a a
-> Kleisli (StateT (Ptr (), [Int]) IO) a a
-> AlignmentMode
-> ToBuffer a a
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Kleisli (StateT (Ptr (), [Int]) IO) a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id AlignmentMode
AlignUnknown
    {-# INLINE (.) #-}
    ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
a Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
b Kleisli (StateT (Ptr (), [Int]) IO) b c
c AlignmentMode
m1 . :: ToBuffer b c -> ToBuffer a b -> ToBuffer a c
. ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
x Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
y Kleisli (StateT (Ptr (), [Int]) IO) a b
z AlignmentMode
m2 = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a c
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a c
-> Kleisli (StateT (Ptr (), [Int]) IO) a c
-> AlignmentMode
-> ToBuffer a c
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer (Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
aKleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
x) (Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
bKleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
y) (Kleisli (StateT (Ptr (), [Int]) IO) b c
cKleisli (StateT (Ptr (), [Int]) IO) b c
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Kleisli (StateT (Ptr (), [Int]) IO) a b
z) (AlignmentMode -> AlignmentMode -> AlignmentMode
comb AlignmentMode
m1 AlignmentMode
m2)
        where
            -- If only one uniform or one PackedIndices, use that, otherwise use Align4
            comb :: AlignmentMode -> AlignmentMode -> AlignmentMode
comb AlignmentMode
AlignUniform AlignmentMode
AlignUnknown       = AlignmentMode
AlignUniform
            comb AlignmentMode
AlignUnknown AlignmentMode
AlignUniform       = AlignmentMode
AlignUniform
            comb AlignmentMode
AlignUnknown AlignmentMode
AlignPackedIndices = AlignmentMode
AlignPackedIndices
            comb AlignmentMode
AlignPackedIndices AlignmentMode
AlignUnknown = AlignmentMode
AlignPackedIndices
            comb AlignmentMode
AlignUnknown AlignmentMode
AlignUnknown       = AlignmentMode
AlignUnknown
            comb AlignmentMode
_ AlignmentMode
_                             = AlignmentMode
Align4

instance Arrow ToBuffer where
    {-# INLINE arr #-}
    arr :: (b -> c) -> ToBuffer b c
arr b -> c
f = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
-> Kleisli (StateT (Ptr (), [Int]) IO) b c
-> AlignmentMode
-> ToBuffer b c
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer ((b -> c)
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f) ((b -> c)
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f) ((b -> c) -> Kleisli (StateT (Ptr (), [Int]) IO) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f) AlignmentMode
AlignUnknown
    {-# INLINE first #-}
    first :: ToBuffer b c -> ToBuffer (b, d) (c, d)
first (ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
a Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
b Kleisli (StateT (Ptr (), [Int]) IO) b c
c AlignmentMode
m) = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  (b, d)
  (c, d)
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput))) (b, d) (c, d)
-> Kleisli (StateT (Ptr (), [Int]) IO) (b, d) (c, d)
-> AlignmentMode
-> ToBuffer (b, d) (c, d)
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer (Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
     (b, d)
     (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) b c
a) (Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput))) (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Kleisli (StateT Int (Reader (BufferName, Int, BInput))) b c
b) (Kleisli (StateT (Ptr (), [Int]) IO) b c
-> Kleisli (StateT (Ptr (), [Int]) IO) (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Kleisli (StateT (Ptr (), [Int]) IO) b c
c) AlignmentMode
m

-- | The atomic buffer value that represents a host value of type 'a'.
data B a = B
    {   B a -> BufferName
bName        :: IORef GLuint
    ,   B a -> Int
bOffset      :: Int
    ,   B a -> Int
bStride      :: Int
    ,   B a -> Int
bSkipElems   :: Int
    ,   B a -> Int
bInstanceDiv :: Int
    }

-- | An atomic buffer value that represents a vector of 2 'a's on the host.
newtype B2 a = B2 { B2 a -> B a
unB2 :: B a } -- Internal
-- | An atomic buffer value that represents a vector of 3 'a's on the host.
newtype B3 a = B3 { B3 a -> B a
unB3 :: B a } -- Internal
-- | An atomic buffer value that represents a vector of 4 'a's on the host. This works similar to '(B a, B a, B a, B a)' but has some performance advantage, especially when used
--   in 'VertexArray's.
newtype B4 a = B4 { B4 a -> B a
unB4 :: B a } -- Internal

-- | Split up a @'B4' a@ into two @'B2' a@s.
toB22 :: forall a. (Storable a, BufferFormat (B2 a)) => B4 a -> (B2 a, B2 a)
-- | Discard the last component of a @'B4' a@ to get a @'B3' a@.
toB3 :: forall a. (Storable a, BufferFormat (B3 a)) => B4 a -> B3 a
-- | Split up a @'B3' a@ into a @'B2' a@ and a @'B1' a@.
toB21 :: forall a. (Storable a, BufferFormat (B a)) => B3 a -> (B2 a, B a)
-- | Split up a @'B3' a@ into a @'B1' a@ and a @'B2' a@.
toB12 :: forall a. (Storable a, BufferFormat (B a)) => B3 a -> (B a, B2 a)
-- | Split up a @'B2' a@ into two @'B1' a@s.
toB11 :: forall a. (Storable a, BufferFormat (B a)) => B2 a -> (B a, B a)

toB22 :: B4 a -> (B2 a, B2 a)
toB22 (B4 B a
b) = (B a -> B2 a
forall a. B a -> B2 a
B2 B a
b, B a -> B2 a
forall a. B a -> B2 a
B2 (B a -> B2 a) -> B a -> B2 a
forall a b. (a -> b) -> a -> b
$ B a
b { bOffset :: Int
bOffset = B a -> Int
forall a. B a -> Int
bOffset B a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) })
toB3 :: B4 a -> B3 a
toB3 (B4 B a
b) = B a -> B3 a
forall a. B a -> B3 a
B3 B a
b
toB21 :: B3 a -> (B2 a, B a)
toB21 (B3 B a
b) = (B a -> B2 a
forall a. B a -> B2 a
B2 B a
b, B a
b { bOffset :: Int
bOffset = B a -> Int
forall a. B a -> Int
bOffset B a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) })
toB12 :: B3 a -> (B a, B2 a)
toB12 (B3 B a
b) = (B a
b, B a -> B2 a
forall a. B a -> B2 a
B2 (B a -> B2 a) -> B a -> B2 a
forall a b. (a -> b) -> a -> b
$ B a
b { bOffset :: Int
bOffset = B a -> Int
forall a. B a -> Int
bOffset B a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) })
toB11 :: B2 a -> (B a, B a)
toB11 (B2 B a
b) = (B a
b, B a
b { bOffset :: Int
bOffset = B a -> Int
forall a. B a -> Int
bOffset B a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) })

-- | Any buffer value that is going to be used as a uniform needs to be wrapped in this newtype. This will cause is to be aligned
--   properly for uniform usage. It can still be used as input for vertex arrays, but due to the uniform alignment it will probably be
--   padded quite heavily and thus wasteful.
newtype Uniform a = Uniform a

-- | This wrapper is used for integer values to indicate that it should be interpreted as a floating point value, in the range [-1,1] or [0,1] depending on wether it is a
--   signed or unsigned integer (i.e. 'Int' or 'Word').
newtype Normalized a = Normalized a

-- | This works like a 'B a', but has an alignment smaller than 4 bytes that is the limit for vertex buffers, and thus cannot be used for those.
--   Index buffers on the other hand need to be tightly packed, so you need to use this type for index buffers of 'Word8' or 'Word16'.
newtype BPacked a = BPacked (B a)

toBufferBUnaligned :: forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned :: ToBuffer a (B a)
toBufferBUnaligned = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a (B a)
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a (B a)
-> Kleisli (StateT (Ptr (), [Int]) IO) a (B a)
-> AlignmentMode
-> ToBuffer a (B a)
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer
        ((a
 -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a))
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a (B a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a
  -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a))
 -> Kleisli
      (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a (B a))
-> (a
    -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a))
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a (B a)
forall a b. (a -> b) -> a -> b
$ StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a)
-> a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a)
forall a b. a -> b -> a
const StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a)
static)
        ((a -> StateT Int (Reader (BufferName, Int, BInput)) (B a))
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a (B a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT Int (Reader (BufferName, Int, BInput)) (B a))
 -> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a (B a))
-> (a -> StateT Int (Reader (BufferName, Int, BInput)) (B a))
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a (B a)
forall a b. (a -> b) -> a -> b
$ StateT Int (Reader (BufferName, Int, BInput)) (B a)
-> a -> StateT Int (Reader (BufferName, Int, BInput)) (B a)
forall a b. a -> b -> a
const StateT Int (Reader (BufferName, Int, BInput)) (B a)
valueProd)
        ((a -> StateT (Ptr (), [Int]) IO (B a))
-> Kleisli (StateT (Ptr (), [Int]) IO) a (B a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli a -> StateT (Ptr (), [Int]) IO (B a)
writer)
        AlignmentMode
Align4
    where
        size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
        static :: StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a)
static = do
            Int
offset <- StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
            Int -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
 -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ())
-> Int
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size
            B a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) (B a)
forall (m :: * -> *) a. Monad m => a -> m a
return B a
forall a. HasCallStack => a
undefined
        valueProd :: StateT Int (Reader (BufferName, Int, BInput)) (B a)
valueProd = do
            (BufferName
name, Int
stride, BInput
bIn) <- ReaderT
  (BufferName, Int, BInput) Identity (BufferName, Int, BInput)
-> StateT
     Int (Reader (BufferName, Int, BInput)) (BufferName, Int, BInput)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT
  (BufferName, Int, BInput) Identity (BufferName, Int, BInput)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
            Int
offset <- StateT Int (Reader (BufferName, Int, BInput)) Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
            Int -> StateT Int (Reader (BufferName, Int, BInput)) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int -> StateT Int (Reader (BufferName, Int, BInput)) ())
-> Int -> StateT Int (Reader (BufferName, Int, BInput)) ()
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size
            B a -> StateT Int (Reader (BufferName, Int, BInput)) (B a)
forall (m :: * -> *) a. Monad m => a -> m a
return (B a -> StateT Int (Reader (BufferName, Int, BInput)) (B a))
-> B a -> StateT Int (Reader (BufferName, Int, BInput)) (B a)
forall a b. (a -> b) -> a -> b
$ BufferName -> Int -> Int -> Int -> Int -> B a
forall a. BufferName -> Int -> Int -> Int -> Int -> B a
B BufferName
name Int
offset Int
stride (BInput -> Int
bInSkipElems BInput
bIn) (BInput -> Int
bInInstanceDiv BInput
bIn)
        writer :: a -> StateT (Ptr (), [Int]) IO (B a)
writer a
a = do
            (Ptr ()
ptr,[Int]
pads) <- StateT (Ptr (), [Int]) IO (Ptr (), [Int])
forall (m :: * -> *) s. Monad m => StateT s m s
get
            (Ptr (), [Int]) -> StateT (Ptr (), [Int]) IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size, [Int]
pads)
            IO () -> StateT (Ptr (), [Int]) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (Ptr (), [Int]) IO ())
-> IO () -> StateT (Ptr (), [Int]) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
ptr) a
a
            B a -> StateT (Ptr (), [Int]) IO (B a)
forall (m :: * -> *) a. Monad m => a -> m a
return B a
forall a. HasCallStack => a
undefined

toBufferB :: forall a. Storable a => ToBuffer a (B a)
toBufferB :: ToBuffer a (B a)
toBufferB = ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -- Will always be 4 aligned, only 4 size types defined for B1

toBufferB2 :: forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2 :: ToBuffer (V2 a) (B2 a)
toBufferB2 = proc ~(V2 a
a a
b) -> do
    (if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then [(AlignmentMode, Int)] -> ToBuffer () ()
forall a. [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen [(AlignmentMode
AlignUniform, Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))] else ToBuffer () ()
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) -< () -- Small optimization if someone puts non-usable types in a uniform
    B a
a' <- ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned  -< a
a
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
b
    ToBuffer (B2 a) (B2 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< B a -> B2 a
forall a. B a -> B2 a
B2 B a
a' -- Will always be 4 aligned, only 4 size types defined for B2
toBufferB3 :: forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3 :: ToBuffer (V3 a) (B3 a)
toBufferB3 = proc ~(V3 a
a a
b a
c) -> do
    (if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then [(AlignmentMode, Int)] -> ToBuffer () ()
forall a. [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen [(AlignmentMode
AlignUniform, Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))] else ToBuffer () ()
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) -< () -- Small optimization if someone puts non-usable types in a uniform
    B a
a' <- ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
a
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
b
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
c
    (if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then [(AlignmentMode, Int)] -> ToBuffer () ()
forall a. [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen [(AlignmentMode
Align4, Int
4), (AlignmentMode
AlignUniform, Int
4)] else ToBuffer () ()
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) -< () -- For types smaller than 4 we need to pad
    ToBuffer (B3 a) (B3 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< B a -> B3 a
forall a. B a -> B3 a
B3 B a
a'
toBufferB4 :: forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4 :: ToBuffer (V4 a) (B4 a)
toBufferB4 = proc ~(V4 a
a a
b a
c a
d) -> do
    (if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then [(AlignmentMode, Int)] -> ToBuffer () ()
forall a. [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen [(AlignmentMode
AlignUniform, Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))] else ToBuffer () ()
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) -< () -- Small optimization if someone puts non-usable types in a uniform
    B a
a' <- ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
a
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
b
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
c
    ToBuffer a (B a)
forall a. Storable a => ToBuffer a (B a)
toBufferBUnaligned -< a
d
    ToBuffer (B4 a) (B4 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< B a -> B4 a
forall a. B a -> B4 a
B4 B a
a' -- Will always be 4 aligned

instance BufferFormat a => BufferFormat (Uniform a) where
    type HostFormat (Uniform a) = HostFormat a
    toBuffer :: ToBuffer (HostFormat (Uniform a)) (Uniform a)
toBuffer = (a -> Uniform a) -> ToBuffer a (Uniform a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Uniform a
forall a. a -> Uniform a
Uniform ToBuffer a (Uniform a)
-> ToBuffer (HostFormat a) a -> ToBuffer (HostFormat a) (Uniform a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  (HostFormat a)
  a
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput))) (HostFormat a) a
-> Kleisli (StateT (Ptr (), [Int]) IO) (HostFormat a) a
-> AlignmentMode
-> ToBuffer (HostFormat a) a
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer
        ((HostFormat a
 -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a)
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
     (HostFormat a)
     a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli HostFormat a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
preStep)
        ((HostFormat a -> StateT Int (Reader (BufferName, Int, BInput)) a)
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput))) (HostFormat a) a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli HostFormat a -> StateT Int (Reader (BufferName, Int, BInput)) a
elementBuilderA)
        ((HostFormat a -> StateT (Ptr (), [Int]) IO a)
-> Kleisli (StateT (Ptr (), [Int]) IO) (HostFormat a) a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli HostFormat a -> StateT (Ptr (), [Int]) IO a
writerA)
        AlignmentMode
AlignUniform
        where
            ToBuffer (Kleisli HostFormat a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
preStep') (Kleisli HostFormat a -> StateT Int (Reader (BufferName, Int, BInput)) a
elementBuilderA) (Kleisli HostFormat a -> StateT (Ptr (), [Int]) IO a
writerA') AlignmentMode
_ = ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer :: ToBuffer (HostFormat a) a
            preStep :: HostFormat a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
preStep HostFormat a
a = do
                (Int
x,AlignmentMode
_) <- WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
-> StateT
     Int
     (WriterT [Int] (Reader (Int, AlignmentMode)))
     (Int, AlignmentMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
 -> StateT
      Int
      (WriterT [Int] (Reader (Int, AlignmentMode)))
      (Int, AlignmentMode))
-> WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
-> StateT
     Int
     (WriterT [Int] (Reader (Int, AlignmentMode)))
     (Int, AlignmentMode)
forall a b. (a -> b) -> a -> b
$ ReaderT (Int, AlignmentMode) Identity (Int, AlignmentMode)
-> WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT (Int, AlignmentMode) Identity (Int, AlignmentMode)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
                a
a' <- HostFormat a
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
preStep' HostFormat a
a
                [(AlignmentMode, Int)]
-> ()
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall b.
[(AlignmentMode, Int)]
-> b -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
setElemAlignM [(AlignmentMode
AlignUniform, Int
x)] ()
                a -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
            writerA :: HostFormat a -> StateT (Ptr (), [Int]) IO a
writerA HostFormat a
a = do
                a
a' <- HostFormat a -> StateT (Ptr (), [Int]) IO a
writerA' HostFormat a
a
                () -> StateT (Ptr (), [Int]) IO ()
forall b a. b -> StateT (Ptr a, [Int]) IO b
setWriterAlignM ()
                a -> StateT (Ptr (), [Int]) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a'
instance BufferFormat a => BufferFormat (Normalized a) where
    type HostFormat (Normalized a) = HostFormat a
    toBuffer :: ToBuffer (HostFormat (Normalized a)) (Normalized a)
toBuffer = (a -> Normalized a) -> ToBuffer a (Normalized a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Normalized a
forall a. a -> Normalized a
Normalized ToBuffer a (Normalized a)
-> ToBuffer (HostFormat a) a
-> ToBuffer (HostFormat a) (Normalized a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer
    getGlType :: Normalized a -> GLenum
getGlType (Normalized a
a) = a -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlType a
a
    getGlPaddedFormat :: Normalized a -> GLenum
getGlPaddedFormat (Normalized a
a) = case a -> GLenum
forall f. BufferFormat f => f -> GLenum
getGlPaddedFormat a
a of
        GLenum
GL_RGBA_INTEGER -> GLenum
forall a. (Eq a, Num a) => a
GL_RGBA
        GLenum
GL_RGB_INTEGER  -> GLenum
forall a. (Eq a, Num a) => a
GL_RGB
        GLenum
GL_RG_INTEGER   -> GLenum
forall a. (Eq a, Num a) => a
GL_RG
        GLenum
GL_RED_INTEGER  -> GLenum
forall a. (Eq a, Num a) => a
GL_RED
        GLenum
x               -> GLenum
x

instance BufferFormat a => BufferFormat (V0 a) where
    type HostFormat (V0 a) = V0 (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (V0 a)) (V0 a)
toBuffer = (V0 (HostFormat a) -> V0 a) -> ToBuffer (V0 (HostFormat a)) (V0 a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (V0 a -> V0 (HostFormat a) -> V0 a
forall a b. a -> b -> a
const V0 a
forall a. V0 a
V0)
instance BufferFormat a => BufferFormat (V1 a) where
    type HostFormat (V1 a) = V1 (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (V1 a)) (V1 a)
toBuffer = proc ~(V1 a) -> do
        a
a' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
a
        ToBuffer (V1 a) (V1 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> V1 a
forall a. a -> V1 a
V1 a
a'
instance BufferFormat a => BufferFormat (V2 a) where
    type HostFormat (V2 a) = V2 (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (V2 a)) (V2 a)
toBuffer = proc ~(V2 a b) -> do
        (a
a', a
b') <- ToBuffer (HostFormat a, HostFormat a) (a, a)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< (HostFormat a
a,HostFormat a
b)
        ToBuffer (V2 a) (V2 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
a' a
b'
instance BufferFormat a => BufferFormat (V3 a) where
    type HostFormat (V3 a) = V3 (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (V3 a)) (V3 a)
toBuffer = proc ~(V3 a b c) -> do
        (a
a', a
b', a
c') <- ToBuffer (HostFormat a, HostFormat a, HostFormat a) (a, a, a)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< (HostFormat a
a, HostFormat a
b, HostFormat a
c)
        ToBuffer (V3 a) (V3 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
a' a
b' a
c'
instance BufferFormat a => BufferFormat (V4 a) where
    type HostFormat (V4 a) = V4 (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (V4 a)) (V4 a)
toBuffer = proc ~(V4 a b c d) -> do
        (a
a', a
b', a
c', a
d') <- ToBuffer
  (HostFormat a, HostFormat a, HostFormat a, HostFormat a)
  (a, a, a, a)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< (HostFormat a
a, HostFormat a
b, HostFormat a
c, HostFormat a
d)
        ToBuffer (V4 a) (V4 a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a' a
b' a
c' a
d'

instance BufferFormat () where
    type HostFormat () = ()
    toBuffer :: ToBuffer (HostFormat ()) ()
toBuffer = (() -> ()) -> ToBuffer () ()
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (() -> () -> ()
forall a b. a -> b -> a
const ())
instance (BufferFormat a, BufferFormat b) => BufferFormat (a, b) where
    type HostFormat (a,b) = (HostFormat a, HostFormat b)
    toBuffer :: ToBuffer (HostFormat (a, b)) (a, b)
toBuffer = proc ~(a, b) -> do
        a
a' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
a
        b
b' <- ToBuffer (HostFormat b) b
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat b
b
        ToBuffer (a, b) (a, b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b')
instance (BufferFormat a, BufferFormat b, BufferFormat c) => BufferFormat (a, b, c) where
    type HostFormat (a,b,c) = (HostFormat a, HostFormat b, HostFormat c)
    toBuffer :: ToBuffer (HostFormat (a, b, c)) (a, b, c)
toBuffer = proc ~(a, b, c) -> do
        ((a
a', b
b'), c
c') <- ToBuffer ((HostFormat a, HostFormat b), HostFormat c) ((a, b), c)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< ((HostFormat a
a, HostFormat b
b), HostFormat c
c)
        ToBuffer (a, b, c) (a, b, c)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c')
instance (BufferFormat a, BufferFormat b, BufferFormat c, BufferFormat d) => BufferFormat (a, b, c, d) where
    type HostFormat (a,b,c,d) = (HostFormat a, HostFormat b, HostFormat c, HostFormat d)
    toBuffer :: ToBuffer (HostFormat (a, b, c, d)) (a, b, c, d)
toBuffer = proc ~(a, b, c, d) -> do
        ((a
a', b
b', c
c'), d
d') <- ToBuffer
  ((HostFormat a, HostFormat b, HostFormat c), HostFormat d)
  ((a, b, c), d)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< ((HostFormat a
a, HostFormat b
b, HostFormat c
c), HostFormat d
d)
        ToBuffer (a, b, c, d) (a, b, c, d)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d')
instance (BufferFormat a, BufferFormat b, BufferFormat c, BufferFormat d, BufferFormat e) => BufferFormat (a, b, c, d, e) where
    type HostFormat (a,b,c,d,e) = (HostFormat a, HostFormat b, HostFormat c, HostFormat d, HostFormat e)
    toBuffer :: ToBuffer (HostFormat (a, b, c, d, e)) (a, b, c, d, e)
toBuffer = proc ~(a, b, c, d, e) -> do
        ((a
a', b
b', c
c', d
d'), e
e') <- ToBuffer
  ((HostFormat a, HostFormat b, HostFormat c, HostFormat d),
   HostFormat e)
  ((a, b, c, d), e)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< ((HostFormat a
a, HostFormat b
b, HostFormat c
c, HostFormat d
d), HostFormat e
e)
        ToBuffer (a, b, c, d, e) (a, b, c, d, e)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e')
instance (BufferFormat a, BufferFormat b, BufferFormat c, BufferFormat d, BufferFormat e, BufferFormat f) => BufferFormat (a, b, c, d, e, f) where
    type HostFormat (a,b,c,d,e,f) = (HostFormat a, HostFormat b, HostFormat c, HostFormat d, HostFormat e, HostFormat f)
    toBuffer :: ToBuffer (HostFormat (a, b, c, d, e, f)) (a, b, c, d, e, f)
toBuffer = proc ~(a, b, c, d, e, f) -> do
        ((a
a', b
b', c
c', d
d', e
e'), f
f') <- ToBuffer
  ((HostFormat a, HostFormat b, HostFormat c, HostFormat d,
    HostFormat e),
   HostFormat f)
  ((a, b, c, d, e), f)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< ((HostFormat a
a, HostFormat b
b, HostFormat c
c, HostFormat d
d, HostFormat e
e), HostFormat f
f)
        ToBuffer (a, b, c, d, e, f) (a, b, c, d, e, f)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e', f
f')
instance (BufferFormat a, BufferFormat b, BufferFormat c, BufferFormat d, BufferFormat e, BufferFormat f, BufferFormat g) => BufferFormat (a, b, c, d, e, f, g) where
    type HostFormat (a,b,c,d,e,f,g) = (HostFormat a, HostFormat b, HostFormat c, HostFormat d, HostFormat e, HostFormat f, HostFormat g)
    toBuffer :: ToBuffer (HostFormat (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
toBuffer = proc ~(a, b, c, d, e, f, g) -> do
        ((a
a', b
b', c
c', d
d', e
e', f
f'), g
g') <- ToBuffer
  ((HostFormat a, HostFormat b, HostFormat c, HostFormat d,
    HostFormat e, HostFormat f),
   HostFormat g)
  ((a, b, c, d, e, f), g)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< ((HostFormat a
a, HostFormat b
b, HostFormat c
c, HostFormat d
d, HostFormat e
e, HostFormat f
f), HostFormat g
g)
        ToBuffer (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
a', b
b', c
c', d
d', e
e', f
f', g
g')

instance BufferFormat a => BufferFormat (Quaternion a) where
    type HostFormat (Quaternion a) = Quaternion (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (Quaternion a)) (Quaternion a)
toBuffer = proc ~(Quaternion a v) -> do
        a
a' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
a
        V3 a
v' <- ToBuffer (V3 (HostFormat a)) (V3 a)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< V3 (HostFormat a)
v
        ToBuffer (Quaternion a) (Quaternion a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> V3 a -> Quaternion a
forall a. a -> V3 a -> Quaternion a
Quaternion a
a' V3 a
v'

instance (BufferFormat (f a), BufferFormat a, HostFormat (f a) ~ f (HostFormat a)) => BufferFormat (Point f a) where
    type HostFormat (Point f a) = Point f (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (Point f a)) (Point f a)
toBuffer = proc ~(P a) -> do
        f a
a' <- ToBuffer (f (HostFormat a)) (f a)
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< f (HostFormat a)
a
        ToBuffer (Point f a) (Point f a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< f a -> Point f a
forall (f :: * -> *) a. f a -> Point f a
P f a
a'

instance BufferFormat a => BufferFormat (Plucker a) where
    type HostFormat (Plucker a) = Plucker (HostFormat a)
    toBuffer :: ToBuffer (HostFormat (Plucker a)) (Plucker a)
toBuffer = proc ~(Plucker a b c d e f) -> do
        a
a' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
a
        a
b' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
b
        a
c' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
c
        a
d' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
d
        a
e' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
e
        a
f' <- ToBuffer (HostFormat a) a
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer -< HostFormat a
f
        ToBuffer (Plucker a) (Plucker a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> a -> a -> a -> a -> a -> Plucker a
forall a. a -> a -> a -> a -> a -> a -> Plucker a
Plucker a
a' a
b' a
c' a
d' a
e' a
f'

-- | Create a buffer with a specified number of elements.
newBuffer :: (MonadIO m, BufferFormat b, ContextHandler ctx) => Int -> ContextT ctx os m (Buffer os b)
newBuffer :: Int -> ContextT ctx os m (Buffer os b)
newBuffer Int
elementCount
    | Int
elementCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m (Buffer os b)
forall a. HasCallStack => [Char] -> a
error [Char]
"newBuffer, length negative"
    | Bool
otherwise = do
    (Buffer os b
buffer, BufferName
nameRef, GLenum
name) <- IO (Buffer os b, BufferName, GLenum)
-> ContextT ctx os m (Buffer os b, BufferName, GLenum)
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IO a -> ContextT ctx os m a
liftNonWinContextIO (IO (Buffer os b, BufferName, GLenum)
 -> ContextT ctx os m (Buffer os b, BufferName, GLenum))
-> IO (Buffer os b, BufferName, GLenum)
-> ContextT ctx os m (Buffer os b, BufferName, GLenum)
forall a b. (a -> b) -> a -> b
$ do
        GLenum
name <- (Ptr GLenum -> IO GLenum) -> IO GLenum
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO GLenum) -> IO GLenum)
-> (Ptr GLenum -> IO GLenum) -> IO GLenum
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
ptr -> do
            GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLenum -> m ()
glGenBuffers GLsizei
1 Ptr GLenum
ptr
            Ptr GLenum -> IO GLenum
forall a. Storable a => Ptr a -> IO a
peek Ptr GLenum
ptr
        BufferName
nameRef <- GLenum -> IO BufferName
forall a. a -> IO (IORef a)
newIORef GLenum
name
        IORef (Maybe (GLenum, GLenum))
tfRef <- Maybe (GLenum, GLenum) -> IO (IORef (Maybe (GLenum, GLenum)))
forall a. a -> IO (IORef a)
newIORef Maybe (GLenum, GLenum)
forall a. Maybe a
Nothing
        Int
uniAl <- IO Int
getUniformAlignment
        let buffer :: Buffer os b
buffer = BufferName
-> Int -> Int -> IORef (Maybe (GLenum, GLenum)) -> Buffer os b
forall os b.
BufferFormat b =>
BufferName
-> Int -> Int -> IORef (Maybe (GLenum, GLenum)) -> Buffer os b
makeBuffer' BufferName
nameRef Int
elementCount Int
uniAl IORef (Maybe (GLenum, GLenum))
tfRef
        GLenum
bname <- BufferName -> IO GLenum
forall a. IORef a -> IO a
readIORef (BufferName -> IO GLenum) -> BufferName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
buffer
        GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER GLenum
bname
        GLenum -> GLsizeiptr -> Ptr () -> GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizeiptr -> Ptr () -> GLenum -> m ()
glBufferData GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Buffer os b -> Int
forall os b. Buffer os b -> Int
bufSize Buffer os b
buffer) Ptr ()
forall a. Ptr a
nullPtr GLenum
forall a. (Eq a, Num a) => a
GL_STREAM_DRAW
        (Buffer os b, BufferName, GLenum)
-> IO (Buffer os b, BufferName, GLenum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer os b
buffer, BufferName
nameRef, GLenum
name)
    BufferName -> IO () -> ContextT ctx os m ()
forall ctx (m :: * -> *) a os.
(ContextHandler ctx, MonadIO m) =>
IORef a -> IO () -> ContextT ctx os m ()
addContextFinalizer BufferName
nameRef (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 (GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLenum -> m ()
glDeleteBuffers GLsizei
1)
    BufferName -> ContextT ctx os m ()
forall (m :: * -> *) ctx os.
MonadIO m =>
BufferName -> ContextT ctx os m ()
addVAOBufferFinalizer BufferName
nameRef
    Buffer os b -> ContextT ctx os m (Buffer os b)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer os b
buffer

bufferWriteInternal :: Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal :: Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os f
b Ptr ()
ptr (HostFormat f
x:[HostFormat f]
xs) = do
    Buffer os f -> Ptr () -> HostFormat f -> IO ()
forall os b. Buffer os b -> Ptr () -> HostFormat b -> IO ()
bufWriter Buffer os f
b Ptr ()
ptr HostFormat f
x
    Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
forall os f. Buffer os f -> Ptr () -> [HostFormat f] -> IO (Ptr ())
bufferWriteInternal Buffer os f
b (Ptr ()
ptr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Buffer os f -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os f
b) [HostFormat f]
xs
bufferWriteInternal Buffer os f
_ Ptr ()
ptr [] = Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
ptr

-- | Write a buffer from the host (i.e. the normal Haskell world).
writeBuffer :: (ContextHandler ctx, MonadIO m) => Buffer os b -> BufferStartPos -> [HostFormat b] -> ContextT ctx os m ()
writeBuffer :: Buffer os b -> Int -> [HostFormat b] -> ContextT ctx os m ()
writeBuffer Buffer os b
buffer Int
offset [HostFormat b]
elems
    | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
offset 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
buffer = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, offset out of bounds"
    | Bool
otherwise =
        let maxElems :: Int
maxElems = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
buffer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
            elemSize :: Int
elemSize = Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
buffer
            off :: GLsizeiptr
off = Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize

        in 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 <- BufferName -> IO GLenum
forall a. IORef a -> IO a
readIORef (BufferName -> IO GLenum) -> BufferName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
buffer
            GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER GLenum
bname
            Ptr ()
ptr <- GLenum -> GLsizeiptr -> GLsizeiptr -> GLenum -> IO (Ptr ())
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizeiptr -> GLsizeiptr -> GLenum -> m (Ptr ())
glMapBufferRange GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER GLsizeiptr
off (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$Int
maxElems Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize) (GLenum
forall a. (Eq a, Num a) => a
GL_MAP_WRITE_BIT GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLenum
forall a. (Eq a, Num a) => a
GL_MAP_FLUSH_EXPLICIT_BIT)
            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
buffer Ptr ()
ptr (Int -> [HostFormat b] -> [HostFormat b]
forall a. Int -> [a] -> [a]
take Int
maxElems [HostFormat b]
elems)
            GLenum -> GLsizeiptr -> GLsizeiptr -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizeiptr -> GLsizeiptr -> m ()
glFlushMappedBufferRange GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER GLsizeiptr
off (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Ptr ()
end Ptr () -> Ptr () -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr ()
ptr)
            IO GLboolean -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO GLboolean -> IO ()) -> IO GLboolean -> IO ()
forall a b. (a -> b) -> a -> b
$ GLenum -> IO GLboolean
forall (m :: * -> *). MonadIO m => GLenum -> m GLboolean
glUnmapBuffer GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER

-- | Copies values from one buffer to another (of the same type).
--
--   @copyBuffer fromBuffer fromStart toBuffer toStart length@ will copy @length@ elements from position @fromStart@ in @fromBuffer@ to position @toStart@ in @toBuffer@.
copyBuffer :: (ContextHandler ctx, MonadIO m) => Buffer os b -> BufferStartPos -> Buffer os b -> BufferStartPos -> Int -> ContextT ctx os m ()
copyBuffer :: Buffer os b
-> Int -> Buffer os b -> Int -> Int -> ContextT ctx os m ()
copyBuffer Buffer os b
bFrom Int
from Buffer os b
bTo Int
to Int
len
    | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
from 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
bFrom = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, source offset out of bounds"
    | Int
to Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
to 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
bTo = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, destination offset out of bounds"
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, length negative"
    | Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
from 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
bFrom = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, source buffer too small"
    | Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
to 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
bTo = [Char] -> ContextT ctx os m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeBuffer, destination buffer 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
bnamef <- BufferName -> IO GLenum
forall a. IORef a -> IO a
readIORef (BufferName -> IO GLenum) -> BufferName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
bFrom
        GLenum
bnamet <- BufferName -> IO GLenum
forall a. IORef a -> IO a
readIORef (BufferName -> IO GLenum) -> BufferName -> IO GLenum
forall a b. (a -> b) -> a -> b
$ Buffer os b -> BufferName
forall os b. Buffer os b -> BufferName
bufName Buffer os b
bTo
        GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_COPY_READ_BUFFER GLenum
bnamef
        GLenum -> GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBindBuffer GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER GLenum
bnamet
        let elemSize :: Int
elemSize = Buffer os b -> Int
forall os b. Buffer os b -> Int
bufElementSize Buffer os b
bFrom -- same as for bTo
        GLenum -> GLenum -> GLsizeiptr -> GLsizeiptr -> GLsizeiptr -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLsizeiptr -> GLsizeiptr -> GLsizeiptr -> m ()
glCopyBufferSubData
            GLenum
forall a. (Eq a, Num a) => a
GL_COPY_READ_BUFFER
            GLenum
forall a. (Eq a, Num a) => a
GL_COPY_WRITE_BUFFER
            (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize)
            (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize)
            (Int -> GLsizeiptr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLsizeiptr) -> Int -> GLsizeiptr
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elemSize)

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

alignWhen :: [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen :: [(AlignmentMode, Int)] -> ToBuffer a a
alignWhen [(AlignmentMode, Int)]
x = Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a a
-> Kleisli (StateT (Ptr (), [Int]) IO) a a
-> AlignmentMode
-> ToBuffer a a
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer ((a -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a)
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a)
 -> Kleisli
      (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a)
-> (a
    -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a)
-> Kleisli
     (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a a
forall a b. (a -> b) -> a -> b
$ [(AlignmentMode, Int)]
-> a -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) a
forall b.
[(AlignmentMode, Int)]
-> b -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
setElemAlignM [(AlignmentMode, Int)]
x) ((a -> StateT Int (Reader (BufferName, Int, BInput)) a)
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli a -> StateT Int (Reader (BufferName, Int, BInput)) a
forall (m :: * -> *) a. Monad m => a -> m a
return) ((a -> StateT (Ptr (), [Int]) IO a)
-> Kleisli (StateT (Ptr (), [Int]) IO) a a
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli a -> StateT (Ptr (), [Int]) IO a
forall b a. b -> StateT (Ptr a, [Int]) IO b
setWriterAlignM) AlignmentMode
AlignUniform

setElemAlignM :: [(AlignmentMode, Int)] -> b -> StateT Offset (WriterT [Int] (Reader (UniformAlignment, AlignmentMode))) b
setElemAlignM :: [(AlignmentMode, Int)]
-> b -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
setElemAlignM [(AlignmentMode, Int)]
x b
a = do
    (Int
_,AlignmentMode
m) <- WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
-> StateT
     Int
     (WriterT [Int] (Reader (Int, AlignmentMode)))
     (Int, AlignmentMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
 -> StateT
      Int
      (WriterT [Int] (Reader (Int, AlignmentMode)))
      (Int, AlignmentMode))
-> WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
-> StateT
     Int
     (WriterT [Int] (Reader (Int, AlignmentMode)))
     (Int, AlignmentMode)
forall a b. (a -> b) -> a -> b
$ ReaderT (Int, AlignmentMode) Identity (Int, AlignmentMode)
-> WriterT [Int] (Reader (Int, AlignmentMode)) (Int, AlignmentMode)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT (Int, AlignmentMode) Identity (Int, AlignmentMode)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Int
pad <- case AlignmentMode -> [(AlignmentMode, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup AlignmentMode
m [(AlignmentMode, Int)]
x of
        Maybe Int
Nothing -> Int -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        Just Int
al -> do
            Int
offset <- StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
            let pad :: Int
pad = Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
al)
            Int -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
 -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ())
-> Int
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pad
            Int -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
pad
    WriterT [Int] (Reader (Int, AlignmentMode)) ()
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [Int] (Reader (Int, AlignmentMode)) ()
 -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ())
-> WriterT [Int] (Reader (Int, AlignmentMode)) ()
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) ()
forall a b. (a -> b) -> a -> b
$ [Int] -> WriterT [Int] (Reader (Int, AlignmentMode)) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Int
pad]
    b -> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
setWriterAlignM :: b -> StateT (Ptr a, [Int]) IO b
setWriterAlignM :: b -> StateT (Ptr a, [Int]) IO b
setWriterAlignM b
a = do
    (Ptr a
ptr, Int
pad:[Int]
pads) <- StateT (Ptr a, [Int]) IO (Ptr a, [Int])
forall (m :: * -> *) s. Monad m => StateT s m s
get
    (Ptr a, [Int]) -> StateT (Ptr a, [Int]) IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
pad, [Int]
pads)
    b -> StateT (Ptr a, [Int]) IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a

getUniformAlignment :: IO Int
getUniformAlignment :: IO Int
getUniformAlignment = GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLsizei -> Int) -> IO GLsizei -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr GLsizei -> IO GLsizei) -> IO GLsizei
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\ Ptr GLsizei
ptr -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLsizei -> m ()
glGetIntegerv GLenum
forall a. (Eq a, Num a) => a
GL_UNIFORM_BUFFER_OFFSET_ALIGNMENT Ptr GLsizei
ptr IO () -> IO GLsizei -> IO GLsizei
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr GLsizei -> IO GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
ptr)

makeBuffer :: forall os b. BufferFormat b => BufferName -> Int -> UniformAlignment -> Buffer os b
makeBuffer :: BufferName -> Int -> Int -> Buffer os b
makeBuffer BufferName
name Int
elementCount Int
uniformAlignment = BufferName
-> Int -> Int -> IORef (Maybe (GLenum, GLenum)) -> Buffer os b
forall os b.
BufferFormat b =>
BufferName
-> Int -> Int -> IORef (Maybe (GLenum, GLenum)) -> Buffer os b
makeBuffer' BufferName
name Int
elementCount Int
uniformAlignment ([Char] -> IORef (Maybe (GLenum, GLenum))
forall a. HasCallStack => [Char] -> a
error [Char]
"Not meant to be used for transform feedback")

makeBuffer' :: forall os b. BufferFormat b => BufferName -> Int -> UniformAlignment -> IORef (Maybe (GLuint, GLuint)) -> Buffer os b
makeBuffer' :: BufferName
-> Int -> Int -> IORef (Maybe (GLenum, GLenum)) -> Buffer os b
makeBuffer' BufferName
name Int
elementCount Int
uniformAlignment IORef (Maybe (GLenum, GLenum))
tfRef = do
    let ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  (HostFormat b)
  b
skipIt Kleisli
  (StateT Int (Reader (BufferName, Int, BInput))) (HostFormat b) b
readIt Kleisli (StateT (Ptr (), [Int]) IO) (HostFormat b) b
writeIt AlignmentMode
alignMode = ToBuffer (HostFormat b) b
forall f. BufferFormat f => ToBuffer (HostFormat f) f
toBuffer :: ToBuffer (HostFormat b) b
        err :: HostFormat b
err = [Char] -> HostFormat b
forall a. HasCallStack => [Char] -> a
error [Char]
"toBuffer is creating values that are dependant on the actual HostFormat values, this is not allowed since it doesn't allow static creation of shaders" :: HostFormat b
        ((b
_,Int
elementSize),[Int]
pads) = Reader (Int, AlignmentMode) ((b, Int), [Int])
-> (Int, AlignmentMode) -> ((b, Int), [Int])
forall r a. Reader r a -> r -> a
runReader (WriterT [Int] (Reader (Int, AlignmentMode)) (b, Int)
-> Reader (Int, AlignmentMode) ((b, Int), [Int])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
-> Int -> WriterT [Int] (Reader (Int, AlignmentMode)) (b, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  (HostFormat b)
  b
-> HostFormat b
-> StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))) b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  (HostFormat b)
  b
skipIt HostFormat b
err) Int
0)) (Int
uniformAlignment, AlignmentMode
alignMode)
        elementF :: BInput -> b
elementF BInput
bIn = (b, Int) -> b
forall a b. (a, b) -> a
fst ((b, Int) -> b) -> (b, Int) -> b
forall a b. (a -> b) -> a -> b
$ Reader (BufferName, Int, BInput) (b, Int)
-> (BufferName, Int, BInput) -> (b, Int)
forall r a. Reader r a -> r -> a
runReader (StateT Int (Reader (BufferName, Int, BInput)) b
-> Int -> Reader (BufferName, Int, BInput) (b, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Kleisli
  (StateT Int (Reader (BufferName, Int, BInput))) (HostFormat b) b
-> HostFormat b -> StateT Int (Reader (BufferName, Int, BInput)) b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli
  (StateT Int (Reader (BufferName, Int, BInput))) (HostFormat b) b
readIt HostFormat b
err) Int
0) (BufferName
name, Int
elementSize, BInput
bIn)
        writer :: Ptr () -> HostFormat b -> IO ()
writer Ptr ()
ptr HostFormat b
x = IO (b, (Ptr (), [Int])) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (b, (Ptr (), [Int])) -> IO ())
-> IO (b, (Ptr (), [Int])) -> IO ()
forall a b. (a -> b) -> a -> b
$ StateT (Ptr (), [Int]) IO b
-> (Ptr (), [Int]) -> IO (b, (Ptr (), [Int]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Kleisli (StateT (Ptr (), [Int]) IO) (HostFormat b) b
-> HostFormat b -> StateT (Ptr (), [Int]) IO b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli (StateT (Ptr (), [Int]) IO) (HostFormat b) b
writeIt HostFormat b
x) (Ptr ()
ptr,[Int]
pads)
    BufferName
-> Int
-> Int
-> (BInput -> b)
-> (Ptr () -> HostFormat b -> IO ())
-> IORef (Maybe (GLenum, GLenum))
-> Buffer os b
forall os b.
BufferName
-> Int
-> Int
-> (BInput -> b)
-> (Ptr () -> HostFormat b -> IO ())
-> IORef (Maybe (GLenum, GLenum))
-> Buffer os b
Buffer BufferName
name Int
elementSize Int
elementCount BInput -> b
elementF Ptr () -> HostFormat b -> IO ()
writer IORef (Maybe (GLenum, GLenum))
tfRef

-- | This type family restricts what host and buffer types a texture format may be converted into.
-- 'BufferColor t h' for a texture representation 't' and a host representation 'h' will evaluate to a buffer type used in the transfer.
-- This family is closed, i.e. you cannot create additional instances to it.
type family BufferColor c h where
    BufferColor Float Int32 = Normalized (B Int32)
    BufferColor Float Word32 = Normalized (B Word32)
    BufferColor Float Float = B Float
    BufferColor Int Int32   = B Int32

    BufferColor Word Word32 = B Word32
    BufferColor Word Word16 = BPacked Word16
    BufferColor Word Word8  = BPacked Word8

    BufferColor (V2 Float) (V2 Int32) = Normalized (B2 Int32)
    BufferColor (V2 Float) (V2 Int16) = Normalized (B2 Int16)
    BufferColor (V2 Float) (V2 Word32) = Normalized (B2 Word32)
    BufferColor (V2 Float) (V2 Word16) = Normalized (B2 Word16)
    BufferColor (V2 Float) (V2 Float) = B2 Float

    BufferColor (V2 Int) (V2 Int32) = B2 Int32
    BufferColor (V2 Int) (V2 Int16) = B2 Int16

    BufferColor (V2 Word) (V2 Word32) = B2 Word32
    BufferColor (V2 Word) (V2 Word16) = B2 Word16

    BufferColor (V3 Float) (V3 Int32) = Normalized (B3 Int32)
    BufferColor (V3 Float) (V3 Int16) = Normalized (B3 Int16)
    BufferColor (V3 Float) (V3 Int8)  = Normalized (B3 Int8)
    BufferColor (V3 Float) (V3 Word32) = Normalized (B3 Word32)
    BufferColor (V3 Float) (V3 Word16) = Normalized (B3 Word16)
    BufferColor (V3 Float) (V3 Word8)  = Normalized (B3 Word8)
    BufferColor (V3 Float) (V3 Float) = B3 Float

    BufferColor (V3 Int) (V3 Int32) = B3 Int32
    BufferColor (V3 Int) (V3 Int16) = B3 Int16
    BufferColor (V3 Int) (V3 Int8)  = B3 Int8

    BufferColor (V3 Word) (V3 Word32) = B3 Word32
    BufferColor (V3 Word) (V3 Word16) = B3 Word16
    BufferColor (V3 Word) (V3 Word8)  = B3 Word8

    BufferColor (V4 Float) (V4 Int32) = Normalized (B4 Int32)
    BufferColor (V4 Float) (V4 Int16) = Normalized (B4 Int16)
    BufferColor (V4 Float) (V4 Int8)  = Normalized (B4 Int8)
    BufferColor (V4 Float) (V4 Word32) = Normalized (B4 Word32)
    BufferColor (V4 Float) (V4 Word16) = Normalized (B4 Word16)
    BufferColor (V4 Float) (V4 Word8)  = Normalized (B4 Word8)
    BufferColor (V4 Float) (V4 Float) = B4 Float

    BufferColor (V4 Int) (V4 Int32) = B4 Int32
    BufferColor (V4 Int) (V4 Int16) = B4 Int16
    BufferColor (V4 Int) (V4 Int8)  = B4 Int8

    BufferColor (V4 Word) (V4 Word32) = B4 Word32
    BufferColor (V4 Word) (V4 Word16) = B4 Word16
    BufferColor (V4 Word) (V4 Word8)  = B4 Word8

peekPixel1 :: Storable a => Ptr x -> IO a
peekPixel1 :: Ptr x -> IO a
peekPixel1 = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> IO a) -> (Ptr x -> Ptr a) -> Ptr x -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr
peekPixel2 :: (Storable a) => Ptr x -> IO (V2 a)
peekPixel2 :: Ptr x -> IO (V2 a)
peekPixel2 Ptr x
ptr = do
    a
x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr)
    a
y <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr ) Int
1
    V2 a -> IO (V2 a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y)
peekPixel3 :: (Storable a) => Ptr x -> IO (V3 a)
peekPixel3 :: Ptr x -> IO (V3 a)
peekPixel3 Ptr x
ptr = do
    a
x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr)
    a
y <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr ) Int
1
    a
z <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr ) Int
2
    V3 a -> IO (V3 a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
y a
z)
peekPixel4 :: (Storable a) => Ptr x -> IO (V4 a)
peekPixel4 :: Ptr x -> IO (V4 a)
peekPixel4 Ptr x
ptr = do
    V3 a
x a
y a
z <- Ptr x -> IO (V3 a)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3 Ptr x
ptr
    a
w <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr x -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr x
ptr ) Int
3
    V4 a -> IO (V4 a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
y a
z a
w)

instance BufferFormat (B Int32) where
    type HostFormat (B Int32) = Int32
    toBuffer :: ToBuffer (HostFormat (B GLsizei)) (B GLsizei)
toBuffer = ToBuffer (HostFormat (B GLsizei)) (B GLsizei)
forall a. Storable a => ToBuffer a (B a)
toBufferB
    getGlType :: B GLsizei -> GLenum
getGlType B GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_INT
    peekPixel :: B GLsizei -> Ptr () -> IO (HostFormat (B GLsizei))
peekPixel = (Ptr () -> IO GLsizei) -> B GLsizei -> Ptr () -> IO GLsizei
forall a b. a -> b -> a
const Ptr () -> IO GLsizei
forall a x. Storable a => Ptr x -> IO a
peekPixel1
    getGlPaddedFormat :: B GLsizei -> GLenum
getGlPaddedFormat B GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER

instance BufferFormat (B Word32) where
    type HostFormat (B Word32) = Word32
    toBuffer :: ToBuffer (HostFormat (B GLenum)) (B GLenum)
toBuffer = ToBuffer (HostFormat (B GLenum)) (B GLenum)
forall a. Storable a => ToBuffer a (B a)
toBufferB
    getGlType :: B GLenum -> GLenum
getGlType B GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_INT
    peekPixel :: B GLenum -> Ptr () -> IO (HostFormat (B GLenum))
peekPixel = (Ptr () -> IO GLenum) -> B GLenum -> Ptr () -> IO GLenum
forall a b. a -> b -> a
const Ptr () -> IO GLenum
forall a x. Storable a => Ptr x -> IO a
peekPixel1
    getGlPaddedFormat :: B GLenum -> GLenum
getGlPaddedFormat B GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER

instance BufferFormat (BPacked Word16) where
    type HostFormat (BPacked Word16) = Word16
    toBuffer :: ToBuffer (HostFormat (BPacked Word16)) (BPacked Word16)
toBuffer = let ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  Word16
  (B Word16)
a Kleisli
  (StateT Int (Reader (BufferName, Int, BInput))) Word16 (B Word16)
b Kleisli (StateT (Ptr (), [Int]) IO) Word16 (B Word16)
c AlignmentMode
_ = ToBuffer Word16 (B Word16)
forall a. Storable a => ToBuffer a (B a)
toBufferB :: ToBuffer Word16 (B Word16) in (B Word16 -> BPacked Word16)
-> ToBuffer (B Word16) (BPacked Word16)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr B Word16 -> BPacked Word16
forall a. B a -> BPacked a
BPacked ToBuffer (B Word16) (BPacked Word16)
-> ToBuffer Word16 (B Word16) -> ToBuffer Word16 (BPacked Word16)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  Word16
  (B Word16)
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput))) Word16 (B Word16)
-> Kleisli (StateT (Ptr (), [Int]) IO) Word16 (B Word16)
-> AlignmentMode
-> ToBuffer Word16 (B Word16)
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  Word16
  (B Word16)
a Kleisli
  (StateT Int (Reader (BufferName, Int, BInput))) Word16 (B Word16)
b Kleisli (StateT (Ptr (), [Int]) IO) Word16 (B Word16)
c AlignmentMode
AlignPackedIndices
    getGlType :: BPacked Word16 -> GLenum
getGlType BPacked Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_SHORT
    peekPixel :: BPacked Word16 -> Ptr () -> IO (HostFormat (BPacked Word16))
peekPixel = (Ptr () -> IO Word16) -> BPacked Word16 -> Ptr () -> IO Word16
forall a b. a -> b -> a
const Ptr () -> IO Word16
forall a x. Storable a => Ptr x -> IO a
peekPixel1
    getGlPaddedFormat :: BPacked Word16 -> GLenum
getGlPaddedFormat BPacked Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER

instance BufferFormat (BPacked Word8) where
    type HostFormat (BPacked Word8) = Word8
    toBuffer :: ToBuffer (HostFormat (BPacked GLboolean)) (BPacked GLboolean)
toBuffer = let ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  GLboolean
  (B GLboolean)
a Kleisli
  (StateT Int (Reader (BufferName, Int, BInput)))
  GLboolean
  (B GLboolean)
b Kleisli (StateT (Ptr (), [Int]) IO) GLboolean (B GLboolean)
c AlignmentMode
_ = ToBuffer GLboolean (B GLboolean)
forall a. Storable a => ToBuffer a (B a)
toBufferB :: ToBuffer Word8 (B Word8) in (B GLboolean -> BPacked GLboolean)
-> ToBuffer (B GLboolean) (BPacked GLboolean)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr B GLboolean -> BPacked GLboolean
forall a. B a -> BPacked a
BPacked ToBuffer (B GLboolean) (BPacked GLboolean)
-> ToBuffer GLboolean (B GLboolean)
-> ToBuffer GLboolean (BPacked GLboolean)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  GLboolean
  (B GLboolean)
-> Kleisli
     (StateT Int (Reader (BufferName, Int, BInput)))
     GLboolean
     (B GLboolean)
-> Kleisli (StateT (Ptr (), [Int]) IO) GLboolean (B GLboolean)
-> AlignmentMode
-> ToBuffer GLboolean (B GLboolean)
forall a b.
Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode)))) a b
-> Kleisli (StateT Int (Reader (BufferName, Int, BInput))) a b
-> Kleisli (StateT (Ptr (), [Int]) IO) a b
-> AlignmentMode
-> ToBuffer a b
ToBuffer Kleisli
  (StateT Int (WriterT [Int] (Reader (Int, AlignmentMode))))
  GLboolean
  (B GLboolean)
a Kleisli
  (StateT Int (Reader (BufferName, Int, BInput)))
  GLboolean
  (B GLboolean)
b Kleisli (StateT (Ptr (), [Int]) IO) GLboolean (B GLboolean)
c AlignmentMode
AlignPackedIndices
    getGlType :: BPacked GLboolean -> GLenum
getGlType BPacked GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_BYTE
    peekPixel :: BPacked GLboolean -> Ptr () -> IO (HostFormat (BPacked GLboolean))
peekPixel = (Ptr () -> IO GLboolean)
-> BPacked GLboolean -> Ptr () -> IO GLboolean
forall a b. a -> b -> a
const Ptr () -> IO GLboolean
forall a x. Storable a => Ptr x -> IO a
peekPixel1
    getGlPaddedFormat :: BPacked GLboolean -> GLenum
getGlPaddedFormat BPacked GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER

instance BufferFormat (B Float) where
    type HostFormat (B Float) = Float
    toBuffer :: ToBuffer (HostFormat (B Float)) (B Float)
toBuffer = ToBuffer (HostFormat (B Float)) (B Float)
forall a. Storable a => ToBuffer a (B a)
toBufferB
    getGlType :: B Float -> GLenum
getGlType B Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_FLOAT
    peekPixel :: B Float -> Ptr () -> IO (HostFormat (B Float))
peekPixel = (Ptr () -> IO Float) -> B Float -> Ptr () -> IO Float
forall a b. a -> b -> a
const Ptr () -> IO Float
forall a x. Storable a => Ptr x -> IO a
peekPixel1
    getGlPaddedFormat :: B Float -> GLenum
getGlPaddedFormat B Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED

instance BufferFormat (B2 Int32) where
    type HostFormat (B2 Int32) = V2 Int32
    toBuffer :: ToBuffer (HostFormat (B2 GLsizei)) (B2 GLsizei)
toBuffer = ToBuffer (HostFormat (B2 GLsizei)) (B2 GLsizei)
forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2
    getGlType :: B2 GLsizei -> GLenum
getGlType B2 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_INT
    peekPixel :: B2 GLsizei -> Ptr () -> IO (HostFormat (B2 GLsizei))
peekPixel = (Ptr () -> IO (V2 GLsizei))
-> B2 GLsizei -> Ptr () -> IO (V2 GLsizei)
forall a b. a -> b -> a
const Ptr () -> IO (V2 GLsizei)
forall a x. Storable a => Ptr x -> IO (V2 a)
peekPixel2
    getGlPaddedFormat :: B2 GLsizei -> GLenum
getGlPaddedFormat B2 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER

instance BufferFormat (B2 Int16) where
    type HostFormat (B2 Int16) = V2 Int16
    toBuffer :: ToBuffer (HostFormat (B2 Int16)) (B2 Int16)
toBuffer = ToBuffer (HostFormat (B2 Int16)) (B2 Int16)
forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2
    getGlType :: B2 Int16 -> GLenum
getGlType B2 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_SHORT
    peekPixel :: B2 Int16 -> Ptr () -> IO (HostFormat (B2 Int16))
peekPixel = (Ptr () -> IO (V2 Int16)) -> B2 Int16 -> Ptr () -> IO (V2 Int16)
forall a b. a -> b -> a
const Ptr () -> IO (V2 Int16)
forall a x. Storable a => Ptr x -> IO (V2 a)
peekPixel2
    getGlPaddedFormat :: B2 Int16 -> GLenum
getGlPaddedFormat B2 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER

instance BufferFormat (B2 Word32) where
    type HostFormat (B2 Word32) = V2 Word32
    toBuffer :: ToBuffer (HostFormat (B2 GLenum)) (B2 GLenum)
toBuffer = ToBuffer (HostFormat (B2 GLenum)) (B2 GLenum)
forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2
    getGlType :: B2 GLenum -> GLenum
getGlType B2 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_INT
    peekPixel :: B2 GLenum -> Ptr () -> IO (HostFormat (B2 GLenum))
peekPixel = (Ptr () -> IO (V2 GLenum)) -> B2 GLenum -> Ptr () -> IO (V2 GLenum)
forall a b. a -> b -> a
const Ptr () -> IO (V2 GLenum)
forall a x. Storable a => Ptr x -> IO (V2 a)
peekPixel2
    getGlPaddedFormat :: B2 GLenum -> GLenum
getGlPaddedFormat B2 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER

instance BufferFormat (B2 Word16) where
    type HostFormat (B2 Word16) = V2 Word16
    toBuffer :: ToBuffer (HostFormat (B2 Word16)) (B2 Word16)
toBuffer = ToBuffer (HostFormat (B2 Word16)) (B2 Word16)
forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2
    getGlType :: B2 Word16 -> GLenum
getGlType B2 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_SHORT
    peekPixel :: B2 Word16 -> Ptr () -> IO (HostFormat (B2 Word16))
peekPixel = (Ptr () -> IO (V2 Word16)) -> B2 Word16 -> Ptr () -> IO (V2 Word16)
forall a b. a -> b -> a
const Ptr () -> IO (V2 Word16)
forall a x. Storable a => Ptr x -> IO (V2 a)
peekPixel2
    getGlPaddedFormat :: B2 Word16 -> GLenum
getGlPaddedFormat B2 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER

instance BufferFormat (B2 Float) where
    type HostFormat (B2 Float) = V2 Float
    toBuffer :: ToBuffer (HostFormat (B2 Float)) (B2 Float)
toBuffer = ToBuffer (HostFormat (B2 Float)) (B2 Float)
forall a. Storable a => ToBuffer (V2 a) (B2 a)
toBufferB2
    getGlType :: B2 Float -> GLenum
getGlType B2 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_FLOAT
    peekPixel :: B2 Float -> Ptr () -> IO (HostFormat (B2 Float))
peekPixel = (Ptr () -> IO (V2 Float)) -> B2 Float -> Ptr () -> IO (V2 Float)
forall a b. a -> b -> a
const Ptr () -> IO (V2 Float)
forall a x. Storable a => Ptr x -> IO (V2 a)
peekPixel2
    getGlPaddedFormat :: B2 Float -> GLenum
getGlPaddedFormat B2 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG

instance BufferFormat (B3 Int32) where
    type HostFormat (B3 Int32) = V3 Int32
    toBuffer :: ToBuffer (HostFormat (B3 GLsizei)) (B3 GLsizei)
toBuffer = ToBuffer (HostFormat (B3 GLsizei)) (B3 GLsizei)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 GLsizei -> GLenum
getGlType B3 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_INT
    peekPixel :: B3 GLsizei -> Ptr () -> IO (HostFormat (B3 GLsizei))
peekPixel = (Ptr () -> IO (V3 GLsizei))
-> B3 GLsizei -> Ptr () -> IO (V3 GLsizei)
forall a b. a -> b -> a
const Ptr () -> IO (V3 GLsizei)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 GLsizei -> GLenum
getGlPaddedFormat B3 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB_INTEGER

instance BufferFormat (B3 Int16) where
    type HostFormat (B3 Int16) = V3 Int16
    toBuffer :: ToBuffer (HostFormat (B3 Int16)) (B3 Int16)
toBuffer = ToBuffer (HostFormat (B3 Int16)) (B3 Int16)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 Int16 -> GLenum
getGlType B3 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_SHORT
    peekPixel :: B3 Int16 -> Ptr () -> IO (HostFormat (B3 Int16))
peekPixel = (Ptr () -> IO (V3 Int16)) -> B3 Int16 -> Ptr () -> IO (V3 Int16)
forall a b. a -> b -> a
const Ptr () -> IO (V3 Int16)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 Int16 -> GLenum
getGlPaddedFormat B3 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B3 Int8) where
    type HostFormat (B3 Int8) = V3 Int8
    toBuffer :: ToBuffer (HostFormat (B3 Int8)) (B3 Int8)
toBuffer = ToBuffer (HostFormat (B3 Int8)) (B3 Int8)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 Int8 -> GLenum
getGlType B3 Int8
_ = GLenum
forall a. (Eq a, Num a) => a
GL_BYTE
    peekPixel :: B3 Int8 -> Ptr () -> IO (HostFormat (B3 Int8))
peekPixel = (Ptr () -> IO (V3 Int8)) -> B3 Int8 -> Ptr () -> IO (V3 Int8)
forall a b. a -> b -> a
const Ptr () -> IO (V3 Int8)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 Int8 -> GLenum
getGlPaddedFormat B3 Int8
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B3 Word32) where
    type HostFormat (B3 Word32) = V3 Word32
    toBuffer :: ToBuffer (HostFormat (B3 GLenum)) (B3 GLenum)
toBuffer = ToBuffer (HostFormat (B3 GLenum)) (B3 GLenum)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 GLenum -> GLenum
getGlType B3 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_INT
    peekPixel :: B3 GLenum -> Ptr () -> IO (HostFormat (B3 GLenum))
peekPixel = (Ptr () -> IO (V3 GLenum)) -> B3 GLenum -> Ptr () -> IO (V3 GLenum)
forall a b. a -> b -> a
const Ptr () -> IO (V3 GLenum)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 GLenum -> GLenum
getGlPaddedFormat B3 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB_INTEGER

instance BufferFormat (B3 Word16) where
    type HostFormat (B3 Word16) = V3 Word16
    toBuffer :: ToBuffer (HostFormat (B3 Word16)) (B3 Word16)
toBuffer = ToBuffer (HostFormat (B3 Word16)) (B3 Word16)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 Word16 -> GLenum
getGlType B3 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_SHORT
    peekPixel :: B3 Word16 -> Ptr () -> IO (HostFormat (B3 Word16))
peekPixel = (Ptr () -> IO (V3 Word16)) -> B3 Word16 -> Ptr () -> IO (V3 Word16)
forall a b. a -> b -> a
const Ptr () -> IO (V3 Word16)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 Word16 -> GLenum
getGlPaddedFormat B3 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B3 Word8) where
    type HostFormat (B3 Word8) = V3 Word8
    toBuffer :: ToBuffer (HostFormat (B3 GLboolean)) (B3 GLboolean)
toBuffer = ToBuffer (HostFormat (B3 GLboolean)) (B3 GLboolean)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 GLboolean -> GLenum
getGlType B3 GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_BYTE
    peekPixel :: B3 GLboolean -> Ptr () -> IO (HostFormat (B3 GLboolean))
peekPixel = (Ptr () -> IO (V3 GLboolean))
-> B3 GLboolean -> Ptr () -> IO (V3 GLboolean)
forall a b. a -> b -> a
const Ptr () -> IO (V3 GLboolean)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 GLboolean -> GLenum
getGlPaddedFormat B3 GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B3 Float) where
    type HostFormat (B3 Float) = V3 Float
    toBuffer :: ToBuffer (HostFormat (B3 Float)) (B3 Float)
toBuffer = ToBuffer (HostFormat (B3 Float)) (B3 Float)
forall a. Storable a => ToBuffer (V3 a) (B3 a)
toBufferB3
    getGlType :: B3 Float -> GLenum
getGlType B3 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_FLOAT
    peekPixel :: B3 Float -> Ptr () -> IO (HostFormat (B3 Float))
peekPixel = (Ptr () -> IO (V3 Float)) -> B3 Float -> Ptr () -> IO (V3 Float)
forall a b. a -> b -> a
const Ptr () -> IO (V3 Float)
forall a x. Storable a => Ptr x -> IO (V3 a)
peekPixel3
    getGlPaddedFormat :: B3 Float -> GLenum
getGlPaddedFormat B3 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB

instance BufferFormat (B4 Int32) where
    type HostFormat (B4 Int32) = V4 Int32
    toBuffer :: ToBuffer (HostFormat (B4 GLsizei)) (B4 GLsizei)
toBuffer = ToBuffer (HostFormat (B4 GLsizei)) (B4 GLsizei)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 GLsizei -> GLenum
getGlType B4 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_INT
    peekPixel :: B4 GLsizei -> Ptr () -> IO (HostFormat (B4 GLsizei))
peekPixel = (Ptr () -> IO (V4 GLsizei))
-> B4 GLsizei -> Ptr () -> IO (V4 GLsizei)
forall a b. a -> b -> a
const Ptr () -> IO (V4 GLsizei)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 GLsizei -> GLenum
getGlPaddedFormat B4 GLsizei
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Int16) where
    type HostFormat (B4 Int16) = V4 Int16
    toBuffer :: ToBuffer (HostFormat (B4 Int16)) (B4 Int16)
toBuffer = ToBuffer (HostFormat (B4 Int16)) (B4 Int16)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 Int16 -> GLenum
getGlType B4 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_SHORT
    peekPixel :: B4 Int16 -> Ptr () -> IO (HostFormat (B4 Int16))
peekPixel = (Ptr () -> IO (V4 Int16)) -> B4 Int16 -> Ptr () -> IO (V4 Int16)
forall a b. a -> b -> a
const Ptr () -> IO (V4 Int16)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 Int16 -> GLenum
getGlPaddedFormat B4 Int16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Int8) where
    type HostFormat (B4 Int8) = V4 Int8
    toBuffer :: ToBuffer (HostFormat (B4 Int8)) (B4 Int8)
toBuffer = ToBuffer (HostFormat (B4 Int8)) (B4 Int8)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 Int8 -> GLenum
getGlType B4 Int8
_ = GLenum
forall a. (Eq a, Num a) => a
GL_BYTE
    peekPixel :: B4 Int8 -> Ptr () -> IO (HostFormat (B4 Int8))
peekPixel = (Ptr () -> IO (V4 Int8)) -> B4 Int8 -> Ptr () -> IO (V4 Int8)
forall a b. a -> b -> a
const Ptr () -> IO (V4 Int8)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 Int8 -> GLenum
getGlPaddedFormat B4 Int8
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Word32) where
    type HostFormat (B4 Word32) = V4 Word32
    toBuffer :: ToBuffer (HostFormat (B4 GLenum)) (B4 GLenum)
toBuffer = ToBuffer (HostFormat (B4 GLenum)) (B4 GLenum)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 GLenum -> GLenum
getGlType B4 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_INT
    peekPixel :: B4 GLenum -> Ptr () -> IO (HostFormat (B4 GLenum))
peekPixel = (Ptr () -> IO (V4 GLenum)) -> B4 GLenum -> Ptr () -> IO (V4 GLenum)
forall a b. a -> b -> a
const Ptr () -> IO (V4 GLenum)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 GLenum -> GLenum
getGlPaddedFormat B4 GLenum
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Word16) where
    type HostFormat (B4 Word16) = V4 Word16
    toBuffer :: ToBuffer (HostFormat (B4 Word16)) (B4 Word16)
toBuffer = ToBuffer (HostFormat (B4 Word16)) (B4 Word16)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 Word16 -> GLenum
getGlType B4 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_SHORT
    peekPixel :: B4 Word16 -> Ptr () -> IO (HostFormat (B4 Word16))
peekPixel = (Ptr () -> IO (V4 Word16)) -> B4 Word16 -> Ptr () -> IO (V4 Word16)
forall a b. a -> b -> a
const Ptr () -> IO (V4 Word16)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 Word16 -> GLenum
getGlPaddedFormat B4 Word16
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Word8) where
    type HostFormat (B4 Word8) = V4 Word8
    toBuffer :: ToBuffer (HostFormat (B4 GLboolean)) (B4 GLboolean)
toBuffer = ToBuffer (HostFormat (B4 GLboolean)) (B4 GLboolean)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 GLboolean -> GLenum
getGlType B4 GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_UNSIGNED_BYTE
    peekPixel :: B4 GLboolean -> Ptr () -> IO (HostFormat (B4 GLboolean))
peekPixel = (Ptr () -> IO (V4 GLboolean))
-> B4 GLboolean -> Ptr () -> IO (V4 GLboolean)
forall a b. a -> b -> a
const Ptr () -> IO (V4 GLboolean)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 GLboolean -> GLenum
getGlPaddedFormat B4 GLboolean
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance BufferFormat (B4 Float) where
    type HostFormat (B4 Float) = V4 Float
    toBuffer :: ToBuffer (HostFormat (B4 Float)) (B4 Float)
toBuffer = ToBuffer (HostFormat (B4 Float)) (B4 Float)
forall a. Storable a => ToBuffer (V4 a) (B4 a)
toBufferB4
    getGlType :: B4 Float -> GLenum
getGlType B4 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_FLOAT
    peekPixel :: B4 Float -> Ptr () -> IO (HostFormat (B4 Float))
peekPixel = (Ptr () -> IO (V4 Float)) -> B4 Float -> Ptr () -> IO (V4 Float)
forall a b. a -> b -> a
const Ptr () -> IO (V4 Float)
forall a x. Storable a => Ptr x -> IO (V4 a)
peekPixel4
    getGlPaddedFormat :: B4 Float -> GLenum
getGlPaddedFormat B4 Float
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA