{-# LANGUAGE ScopedTypeVariables #-}

module Graphics.HaGL.GLType (
    UInt,
    Vec,
    Mat,
    GLType(..),
    GLPrimOrVec,
    GLInputType(..),
    GLSupportsSmoothInterp,
    GLSupportsBitwiseOps,
    GLElt,
    GLPrim(..), 
    GLSingle, 
    GLNumeric,
    GLSigned,
    GLFloating, 
    GLSingleNumeric, 
    GLInteger,
    genDiv
) where

import Control.Applicative (liftA2, liftA3)
import Data.Bits
import Data.Int (Int32)
import Data.Word (Word32)
import Data.List (intercalate)
import Foreign.Storable (Storable)
import Foreign.Marshal.Array (withArray)
import qualified Graphics.Rendering.OpenGL as OpenGL
import qualified Graphics.GL as RawGL

import Graphics.HaGL.Numerical


-- * Raw types

-- | An unsigned integer 
type UInt = Word32

-- | The class of base raw types. Users should not and
-- need not implement any instances of this class.
class (Eq t, Show t) => GLType t where
    showGlslType :: a t -> String
    showGlslVal :: t -> String
    glMap :: (GLElt t -> GLElt t) -> t -> t
    glZipWith :: (GLElt t -> GLElt t -> GLElt t) -> t -> t -> t
    glZipWith3 :: (GLElt t -> GLElt t -> GLElt t -> GLElt t) -> t -> t -> t -> t
    eltSize :: [t] -> Int
    numComponents :: [t] -> Int
    arrayLen :: t -> Int
    getGlslType :: [t] -> OpenGL.DataType
    uniformSet :: OpenGL.GLint -> t -> IO ()

instance GLType Float where
    showGlslType :: forall (a :: * -> *). a Float -> String
showGlslType = forall a b. a -> b -> a
const String
"float"
    showGlslVal :: Float -> String
showGlslVal = forall a. Show a => a -> String
show
    glMap :: (GLElt Float -> GLElt Float) -> Float -> Float
glMap = forall a. a -> a
id
    glZipWith :: (GLElt Float -> GLElt Float -> GLElt Float)
-> Float -> Float -> Float
glZipWith = forall a. a -> a
id
    glZipWith3 :: (GLElt Float -> GLElt Float -> GLElt Float -> GLElt Float)
-> Float -> Float -> Float -> Float
glZipWith3 = forall a. a -> a
id
    eltSize :: [Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    arrayLen :: Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Float -> IO ()
uniformSet = forall (m :: * -> *). MonadIO m => GLint -> Float -> m ()
RawGL.glUniform1f
instance GLType Double where
    showGlslType :: forall (a :: * -> *). a Double -> String
showGlslType = forall a b. a -> b -> a
const String
"double"
    showGlslVal :: Double -> String
showGlslVal = forall a. Show a => a -> String
show
    glMap :: (GLElt Double -> GLElt Double) -> Double -> Double
glMap = forall a. a -> a
id
    glZipWith :: (GLElt Double -> GLElt Double -> GLElt Double)
-> Double -> Double -> Double
glZipWith = forall a. a -> a
id
    glZipWith3 :: (GLElt Double -> GLElt Double -> GLElt Double -> GLElt Double)
-> Double -> Double -> Double -> Double
glZipWith3 = forall a. a -> a
id
    eltSize :: [Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    arrayLen :: Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Double -> IO ()
uniformSet = forall (m :: * -> *). MonadIO m => GLint -> Double -> m ()
RawGL.glUniform1d
instance GLType Int where
    showGlslType :: forall (a :: * -> *). a Int -> String
showGlslType = forall a b. a -> b -> a
const String
"int"
    showGlslVal :: Int -> String
showGlslVal = forall a. Show a => a -> String
show
    glMap :: (GLElt Int -> GLElt Int) -> Int -> Int
glMap = forall a. a -> a
id
    glZipWith :: (GLElt Int -> GLElt Int -> GLElt Int) -> Int -> Int -> Int
glZipWith = forall a. a -> a
id
    glZipWith3 :: (GLElt Int -> GLElt Int -> GLElt Int -> GLElt Int)
-> Int -> Int -> Int -> Int
glZipWith3 = forall a. a -> a
id
    eltSize :: [Int] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Int] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    arrayLen :: Int -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Int] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> Int -> IO ()
uniformSet GLint
i Int
x = forall (m :: * -> *). MonadIO m => GLint -> GLint -> m ()
RawGL.glUniform1i GLint
i (forall a. Enum a => Int -> a
toEnum Int
x)
instance GLType UInt where
    showGlslType :: forall (a :: * -> *). a UInt -> String
showGlslType = forall a b. a -> b -> a
const String
"uint"
    showGlslVal :: UInt -> String
showGlslVal UInt
x = forall a. Show a => a -> String
show UInt
x forall a. [a] -> [a] -> [a]
++ String
"u"
    glMap :: (GLElt UInt -> GLElt UInt) -> UInt -> UInt
glMap = forall a. a -> a
id
    glZipWith :: (GLElt UInt -> GLElt UInt -> GLElt UInt) -> UInt -> UInt -> UInt
glZipWith = forall a. a -> a
id
    glZipWith3 :: (GLElt UInt -> GLElt UInt -> GLElt UInt -> GLElt UInt)
-> UInt -> UInt -> UInt -> UInt
glZipWith3 = forall a. a -> a
id
    eltSize :: [UInt] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [UInt] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    arrayLen :: UInt -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [UInt] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> UInt -> IO ()
uniformSet = forall (m :: * -> *). MonadIO m => GLint -> UInt -> m ()
RawGL.glUniform1ui
instance GLType Bool where
    showGlslType :: forall (a :: * -> *). a Bool -> String
showGlslType = forall a b. a -> b -> a
const String
"bool"
    showGlslVal :: Bool -> String
showGlslVal Bool
x = if Bool
x then String
"true" else String
"false"
    glMap :: (GLElt Bool -> GLElt Bool) -> Bool -> Bool
glMap = forall a. a -> a
id
    glZipWith :: (GLElt Bool -> GLElt Bool -> GLElt Bool) -> Bool -> Bool -> Bool
glZipWith = forall a. a -> a
id
    glZipWith3 :: (GLElt Bool -> GLElt Bool -> GLElt Bool -> GLElt Bool)
-> Bool -> Bool -> Bool -> Bool
glZipWith3 = forall a. a -> a
id
    eltSize :: [Bool] -> Int
eltSize = forall a b. a -> b -> a
const Int
1
    numComponents :: [Bool] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    arrayLen :: Bool -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Bool] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> Bool -> IO ()
uniformSet GLint
i Bool
x = forall (m :: * -> *). MonadIO m => GLint -> GLint -> m ()
RawGL.glUniform1i GLint
i (Bool -> GLint
fromBool Bool
x)
instance GLType (Vec 2 Float) where
    showGlslType :: forall (a :: * -> *). a (Vec 2 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"vec2"
    showGlslVal :: Vec 2 Float -> String
showGlslVal Vec 2 Float
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"vec2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 2 Float
v)
    glMap :: (GLElt (Vec 2 Float) -> GLElt (Vec 2 Float))
-> Vec 2 Float -> Vec 2 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 2 Float) -> GLElt (Vec 2 Float) -> GLElt (Vec 2 Float))
-> Vec 2 Float -> Vec 2 Float -> Vec 2 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 2 Float)
 -> GLElt (Vec 2 Float)
 -> GLElt (Vec 2 Float)
 -> GLElt (Vec 2 Float))
-> Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Vec 2 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 2 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 2 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    arrayLen :: Vec 2 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 2 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Vec 2 Float -> IO ()
uniformSet GLint
ul Vec 2 Float
v = forall (m :: * -> *). MonadIO m => GLint -> Float -> Float -> m ()
RawGL.glUniform2f GLint
ul 
        (Vec 2 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 2 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0))
instance GLType (Vec 3 Float) where
    showGlslType :: forall (a :: * -> *). a (Vec 3 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"vec3"
    showGlslVal :: Vec 3 Float -> String
showGlslVal Vec 3 Float
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"vec3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 3 Float
v)
    glMap :: (GLElt (Vec 3 Float) -> GLElt (Vec 3 Float))
-> Vec 3 Float -> Vec 3 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 3 Float) -> GLElt (Vec 3 Float) -> GLElt (Vec 3 Float))
-> Vec 3 Float -> Vec 3 Float -> Vec 3 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 3 Float)
 -> GLElt (Vec 3 Float)
 -> GLElt (Vec 3 Float)
 -> GLElt (Vec 3 Float))
-> Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Vec 3 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 3 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 3 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    arrayLen :: Vec 3 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 3 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Vec 3 Float -> IO ()
uniformSet GLint
ul Vec 3 Float
v = forall (m :: * -> *).
MonadIO m =>
GLint -> Float -> Float -> Float -> m ()
RawGL.glUniform3f GLint
ul 
        (Vec 3 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 3 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 3 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0))
instance GLType (Vec 4 Float) where
    showGlslType :: forall (a :: * -> *). a (Vec 4 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"vec4"
    showGlslVal :: Vec 4 Float -> String
showGlslVal Vec 4 Float
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"vec4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 4 Float
v)
    glMap :: (GLElt (Vec 4 Float) -> GLElt (Vec 4 Float))
-> Vec 4 Float -> Vec 4 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 4 Float) -> GLElt (Vec 4 Float) -> GLElt (Vec 4 Float))
-> Vec 4 Float -> Vec 4 Float -> Vec 4 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 4 Float)
 -> GLElt (Vec 4 Float)
 -> GLElt (Vec 4 Float)
 -> GLElt (Vec 4 Float))
-> Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Vec 4 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 4 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 4 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Vec 4 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 4 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Vec 4 Float -> IO ()
uniformSet GLint
ul Vec 4 Float
v = forall (m :: * -> *).
MonadIO m =>
GLint -> Float -> Float -> Float -> Float -> m ()
RawGL.glUniform4f GLint
ul 
        (Vec 4 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 4 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 4 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0)) (Vec 4 Float
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
3, Int
0))
instance GLType (Vec 2 Double) where
    showGlslType :: forall (a :: * -> *). a (Vec 2 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec2"
    showGlslVal :: Vec 2 Double -> String
showGlslVal Vec 2 Double
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"dvec2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 2 Double
v)
    glMap :: (GLElt (Vec 2 Double) -> GLElt (Vec 2 Double))
-> Vec 2 Double -> Vec 2 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 2 Double)
 -> GLElt (Vec 2 Double) -> GLElt (Vec 2 Double))
-> Vec 2 Double -> Vec 2 Double -> Vec 2 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 2 Double)
 -> GLElt (Vec 2 Double)
 -> GLElt (Vec 2 Double)
 -> GLElt (Vec 2 Double))
-> Vec 2 Double -> Vec 2 Double -> Vec 2 Double -> Vec 2 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 2 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 2 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    arrayLen :: Vec 2 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 2 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Vec 2 Double -> IO ()
uniformSet GLint
ul Vec 2 Double
v = forall (m :: * -> *).
MonadIO m =>
GLint -> Double -> Double -> m ()
RawGL.glUniform2d GLint
ul 
        (Vec 2 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 2 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0))
instance GLType (Vec 3 Double) where
    showGlslType :: forall (a :: * -> *). a (Vec 3 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec3"
    showGlslVal :: Vec 3 Double -> String
showGlslVal Vec 3 Double
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"dvec3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 3 Double
v)
    glMap :: (GLElt (Vec 3 Double) -> GLElt (Vec 3 Double))
-> Vec 3 Double -> Vec 3 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 3 Double)
 -> GLElt (Vec 3 Double) -> GLElt (Vec 3 Double))
-> Vec 3 Double -> Vec 3 Double -> Vec 3 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 3 Double)
 -> GLElt (Vec 3 Double)
 -> GLElt (Vec 3 Double)
 -> GLElt (Vec 3 Double))
-> Vec 3 Double -> Vec 3 Double -> Vec 3 Double -> Vec 3 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 3 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 3 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    arrayLen :: Vec 3 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 3 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Vec 3 Double -> IO ()
uniformSet GLint
ul Vec 3 Double
v = forall (m :: * -> *).
MonadIO m =>
GLint -> Double -> Double -> Double -> m ()
RawGL.glUniform3d GLint
ul 
        (Vec 3 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 3 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 3 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0))
instance GLType (Vec 4 Double) where
    showGlslType :: forall (a :: * -> *). a (Vec 4 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec4" 
    showGlslVal :: Vec 4 Double -> String
showGlslVal Vec 4 Double
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"dvec4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 4 Double
v)
    glMap :: (GLElt (Vec 4 Double) -> GLElt (Vec 4 Double))
-> Vec 4 Double -> Vec 4 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 4 Double)
 -> GLElt (Vec 4 Double) -> GLElt (Vec 4 Double))
-> Vec 4 Double -> Vec 4 Double -> Vec 4 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 4 Double)
 -> GLElt (Vec 4 Double)
 -> GLElt (Vec 4 Double)
 -> GLElt (Vec 4 Double))
-> Vec 4 Double -> Vec 4 Double -> Vec 4 Double -> Vec 4 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 4 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 4 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Vec 4 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 4 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Vec 4 Double -> IO ()
uniformSet GLint
ul Vec 4 Double
v = forall (m :: * -> *).
MonadIO m =>
GLint -> Double -> Double -> Double -> Double -> m ()
RawGL.glUniform4d GLint
ul 
        (Vec 4 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 4 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 4 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0)) (Vec 4 Double
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
3, Int
0))
instance GLType (Vec 2 Int) where
    showGlslType :: forall (a :: * -> *). a (Vec 2 Int) -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec2"
    showGlslVal :: Vec 2 Int -> String
showGlslVal Vec 2 Int
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"ivec2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 2 Int
v)
    glMap :: (GLElt (Vec 2 Int) -> GLElt (Vec 2 Int)) -> Vec 2 Int -> Vec 2 Int
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 2 Int) -> GLElt (Vec 2 Int) -> GLElt (Vec 2 Int))
-> Vec 2 Int -> Vec 2 Int -> Vec 2 Int
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 2 Int)
 -> GLElt (Vec 2 Int) -> GLElt (Vec 2 Int) -> GLElt (Vec 2 Int))
-> Vec 2 Int -> Vec 2 Int -> Vec 2 Int -> Vec 2 Int
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 2 Int] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 2 Int] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    arrayLen :: Vec 2 Int -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 2 Int] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> Vec 2 Int -> IO ()
uniformSet GLint
ul Vec 2 Int
v = forall (m :: * -> *). MonadIO m => GLint -> GLint -> GLint -> m ()
RawGL.glUniform2i GLint
ul 
        (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 2 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 2 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0))
instance GLType (Vec 3 Int) where
    showGlslType :: forall (a :: * -> *). a (Vec 3 Int) -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec3"
    showGlslVal :: Vec 3 Int -> String
showGlslVal Vec 3 Int
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"ivec3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 3 Int
v)
    glMap :: (GLElt (Vec 3 Int) -> GLElt (Vec 3 Int)) -> Vec 3 Int -> Vec 3 Int
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 3 Int) -> GLElt (Vec 3 Int) -> GLElt (Vec 3 Int))
-> Vec 3 Int -> Vec 3 Int -> Vec 3 Int
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 3 Int)
 -> GLElt (Vec 3 Int) -> GLElt (Vec 3 Int) -> GLElt (Vec 3 Int))
-> Vec 3 Int -> Vec 3 Int -> Vec 3 Int -> Vec 3 Int
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 3 Int] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 3 Int] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    arrayLen :: Vec 3 Int -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 3 Int] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> Vec 3 Int -> IO ()
uniformSet GLint
ul Vec 3 Int
v = forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
RawGL.glUniform3i GLint
ul 
        (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 3 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 3 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 3 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0))
instance GLType (Vec 4 Int) where
    showGlslType :: forall (a :: * -> *). a (Vec 4 Int) -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec4" 
    showGlslVal :: Vec 4 Int -> String
showGlslVal Vec 4 Int
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"ivec4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 4 Int
v)
    glMap :: (GLElt (Vec 4 Int) -> GLElt (Vec 4 Int)) -> Vec 4 Int -> Vec 4 Int
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 4 Int) -> GLElt (Vec 4 Int) -> GLElt (Vec 4 Int))
-> Vec 4 Int -> Vec 4 Int -> Vec 4 Int
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 4 Int)
 -> GLElt (Vec 4 Int) -> GLElt (Vec 4 Int) -> GLElt (Vec 4 Int))
-> Vec 4 Int -> Vec 4 Int -> Vec 4 Int -> Vec 4 Int
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 4 Int] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 4 Int] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Vec 4 Int -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 4 Int] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> Vec 4 Int -> IO ()
uniformSet GLint
ul Vec 4 Int
v = forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> GLint -> m ()
RawGL.glUniform4i GLint
ul 
        (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 4 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 4 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 4 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0)) (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Vec 4 Int
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
3, Int
0))
instance GLType (Vec 2 UInt) where
    showGlslType :: forall (a :: * -> *). a (Vec 2 UInt) -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec2"
    showGlslVal :: Vec 2 UInt -> String
showGlslVal Vec 2 UInt
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"uvec2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 2 UInt
v)
    glMap :: (GLElt (Vec 2 UInt) -> GLElt (Vec 2 UInt))
-> Vec 2 UInt -> Vec 2 UInt
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 2 UInt) -> GLElt (Vec 2 UInt) -> GLElt (Vec 2 UInt))
-> Vec 2 UInt -> Vec 2 UInt -> Vec 2 UInt
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 2 UInt)
 -> GLElt (Vec 2 UInt) -> GLElt (Vec 2 UInt) -> GLElt (Vec 2 UInt))
-> Vec 2 UInt -> Vec 2 UInt -> Vec 2 UInt -> Vec 2 UInt
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 2 UInt] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 2 UInt] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    arrayLen :: Vec 2 UInt -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 2 UInt] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> Vec 2 UInt -> IO ()
uniformSet GLint
ul Vec 2 UInt
v = forall (m :: * -> *). MonadIO m => GLint -> UInt -> UInt -> m ()
RawGL.glUniform2ui GLint
ul 
        (Vec 2 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 2 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0))
instance GLType (Vec 3 UInt) where
    showGlslType :: forall (a :: * -> *). a (Vec 3 UInt) -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec3"
    showGlslVal :: Vec 3 UInt -> String
showGlslVal Vec 3 UInt
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"uvec3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 3 UInt
v)
    glMap :: (GLElt (Vec 3 UInt) -> GLElt (Vec 3 UInt))
-> Vec 3 UInt -> Vec 3 UInt
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 3 UInt) -> GLElt (Vec 3 UInt) -> GLElt (Vec 3 UInt))
-> Vec 3 UInt -> Vec 3 UInt -> Vec 3 UInt
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 3 UInt)
 -> GLElt (Vec 3 UInt) -> GLElt (Vec 3 UInt) -> GLElt (Vec 3 UInt))
-> Vec 3 UInt -> Vec 3 UInt -> Vec 3 UInt -> Vec 3 UInt
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 3 UInt] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 3 UInt] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    arrayLen :: Vec 3 UInt -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 3 UInt] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> Vec 3 UInt -> IO ()
uniformSet GLint
ul Vec 3 UInt
v = forall (m :: * -> *).
MonadIO m =>
GLint -> UInt -> UInt -> UInt -> m ()
RawGL.glUniform3ui GLint
ul 
        (Vec 3 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 3 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 3 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0))
instance GLType (Vec 4 UInt) where
    showGlslType :: forall (a :: * -> *). a (Vec 4 UInt) -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec4"
    showGlslVal :: Vec 4 UInt -> String
showGlslVal Vec 4 UInt
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"uvec4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 4 UInt
v)
    glMap :: (GLElt (Vec 4 UInt) -> GLElt (Vec 4 UInt))
-> Vec 4 UInt -> Vec 4 UInt
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 4 UInt) -> GLElt (Vec 4 UInt) -> GLElt (Vec 4 UInt))
-> Vec 4 UInt -> Vec 4 UInt -> Vec 4 UInt
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 4 UInt)
 -> GLElt (Vec 4 UInt) -> GLElt (Vec 4 UInt) -> GLElt (Vec 4 UInt))
-> Vec 4 UInt -> Vec 4 UInt -> Vec 4 UInt -> Vec 4 UInt
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 4 UInt] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 4 UInt] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Vec 4 UInt -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 4 UInt] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> Vec 4 UInt -> IO ()
uniformSet GLint
ul Vec 4 UInt
v = forall (m :: * -> *).
MonadIO m =>
GLint -> UInt -> UInt -> UInt -> UInt -> m ()
RawGL.glUniform4ui GLint
ul 
        (Vec 4 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Vec 4 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Vec 4 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0)) (Vec 4 UInt
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
3, Int
0))
instance GLType (Vec 2 Bool) where
    showGlslType :: forall (a :: * -> *). a (Vec 2 Bool) -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec2"
    showGlslVal :: Vec 2 Bool -> String
showGlslVal Vec 2 Bool
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"bvec2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 2 Bool
v)
    glMap :: (GLElt (Vec 2 Bool) -> GLElt (Vec 2 Bool))
-> Vec 2 Bool -> Vec 2 Bool
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 2 Bool) -> GLElt (Vec 2 Bool) -> GLElt (Vec 2 Bool))
-> Vec 2 Bool -> Vec 2 Bool -> Vec 2 Bool
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 2 Bool)
 -> GLElt (Vec 2 Bool) -> GLElt (Vec 2 Bool) -> GLElt (Vec 2 Bool))
-> Vec 2 Bool -> Vec 2 Bool -> Vec 2 Bool -> Vec 2 Bool
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 2 Bool] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 2 Bool] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    arrayLen :: Vec 2 Bool -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 2 Bool] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> Vec 2 Bool -> IO ()
uniformSet GLint
ul Vec 2 Bool
v = forall (m :: * -> *). MonadIO m => GLint -> GLint -> GLint -> m ()
RawGL.glUniform2i GLint
ul 
        (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 2 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 2 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0))
instance GLType (Vec 3 Bool) where
    showGlslType :: forall (a :: * -> *). a (Vec 3 Bool) -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec3"
    showGlslVal :: Vec 3 Bool -> String
showGlslVal Vec 3 Bool
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"bvec3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 3 Bool
v)
    glMap :: (GLElt (Vec 3 Bool) -> GLElt (Vec 3 Bool))
-> Vec 3 Bool -> Vec 3 Bool
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 3 Bool) -> GLElt (Vec 3 Bool) -> GLElt (Vec 3 Bool))
-> Vec 3 Bool -> Vec 3 Bool -> Vec 3 Bool
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 3 Bool)
 -> GLElt (Vec 3 Bool) -> GLElt (Vec 3 Bool) -> GLElt (Vec 3 Bool))
-> Vec 3 Bool -> Vec 3 Bool -> Vec 3 Bool -> Vec 3 Bool
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 3 Bool] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 3 Bool] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    arrayLen :: Vec 3 Bool -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 3 Bool] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> Vec 3 Bool -> IO ()
uniformSet GLint
ul Vec 3 Bool
v = forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
RawGL.glUniform3i GLint
ul 
        (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 3 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 3 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 3 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0))
instance GLType (Vec 4 Bool) where
    showGlslType :: forall (a :: * -> *). a (Vec 4 Bool) -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec4" 
    showGlslVal :: Vec 4 Bool -> String
showGlslVal Vec 4 Bool
v = forall {a}. GLType a => String -> [a] -> String
printVec String
"bvec4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList Vec 4 Bool
v)
    glMap :: (GLElt (Vec 4 Bool) -> GLElt (Vec 4 Bool))
-> Vec 4 Bool -> Vec 4 Bool
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Vec 4 Bool) -> GLElt (Vec 4 Bool) -> GLElt (Vec 4 Bool))
-> Vec 4 Bool -> Vec 4 Bool -> Vec 4 Bool
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Vec 4 Bool)
 -> GLElt (Vec 4 Bool) -> GLElt (Vec 4 Bool) -> GLElt (Vec 4 Bool))
-> Vec 4 Bool -> Vec 4 Bool -> Vec 4 Bool -> Vec 4 Bool
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Vec 4 Bool] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Vec 4 Bool] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Vec 4 Bool -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Vec 4 Bool] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> Vec 4 Bool -> IO ()
uniformSet GLint
ul Vec 4 Bool
v = forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> GLint -> m ()
RawGL.glUniform4i GLint
ul 
        (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 4 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
0, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 4 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
1, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 4 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
2, Int
0)) (Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ Vec 4 Bool
v forall (p :: Nat) (q :: Nat) t. Mat p q t -> (Int, Int) -> t
`eltAt` (Int
3, Int
0))
instance GLType (Mat 2 2 Float) where
    showGlslVal :: Mat 2 2 Float -> String
showGlslVal Mat 2 2 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat2x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 2 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 2 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat2x2"
    glMap :: (GLElt (Mat 2 2 Float) -> GLElt (Mat 2 2 Float))
-> Mat 2 2 Float -> Mat 2 2 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 2 Float)
 -> GLElt (Mat 2 2 Float) -> GLElt (Mat 2 2 Float))
-> Mat 2 2 Float -> Mat 2 2 Float -> Mat 2 2 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 2 Float)
 -> GLElt (Mat 2 2 Float)
 -> GLElt (Mat 2 2 Float)
 -> GLElt (Mat 2 2 Float))
-> Mat 2 2 Float -> Mat 2 2 Float -> Mat 2 2 Float -> Mat 2 2 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 2 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 2 2 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Mat 2 2 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 2 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 2 2 Float -> IO ()
uniformSet GLint
ul Mat 2 2 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix2fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 2 Float
m)
instance GLType (Mat 2 3 Float) where
    showGlslVal :: Mat 2 3 Float -> String
showGlslVal Mat 2 3 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat3x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 3 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 3 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat3x2"
    glMap :: (GLElt (Mat 2 3 Float) -> GLElt (Mat 2 3 Float))
-> Mat 2 3 Float -> Mat 2 3 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 3 Float)
 -> GLElt (Mat 2 3 Float) -> GLElt (Mat 2 3 Float))
-> Mat 2 3 Float -> Mat 2 3 Float -> Mat 2 3 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 3 Float)
 -> GLElt (Mat 2 3 Float)
 -> GLElt (Mat 2 3 Float)
 -> GLElt (Mat 2 3 Float))
-> Mat 2 3 Float -> Mat 2 3 Float -> Mat 2 3 Float -> Mat 2 3 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 3 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 2 3 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
6
    arrayLen :: Mat 2 3 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 3 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 2 3 Float -> IO ()
uniformSet GLint
ul Mat 2 3 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix3x2fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 3 Float
m)
instance GLType (Mat 2 4 Float) where
    showGlslVal :: Mat 2 4 Float -> String
showGlslVal Mat 2 4 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat4x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 4 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 4 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat4x2"
    glMap :: (GLElt (Mat 2 4 Float) -> GLElt (Mat 2 4 Float))
-> Mat 2 4 Float -> Mat 2 4 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 4 Float)
 -> GLElt (Mat 2 4 Float) -> GLElt (Mat 2 4 Float))
-> Mat 2 4 Float -> Mat 2 4 Float -> Mat 2 4 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 4 Float)
 -> GLElt (Mat 2 4 Float)
 -> GLElt (Mat 2 4 Float)
 -> GLElt (Mat 2 4 Float))
-> Mat 2 4 Float -> Mat 2 4 Float -> Mat 2 4 Float -> Mat 2 4 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 4 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 2 4 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
8
    arrayLen :: Mat 2 4 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 4 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 2 4 Float -> IO ()
uniformSet GLint
ul Mat 2 4 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix4x2fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 4 Float
m)
instance GLType (Mat 3 2 Float) where
    showGlslVal :: Mat 3 2 Float -> String
showGlslVal Mat 3 2 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat2x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 2 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 2 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat2x3"
    glMap :: (GLElt (Mat 3 2 Float) -> GLElt (Mat 3 2 Float))
-> Mat 3 2 Float -> Mat 3 2 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 2 Float)
 -> GLElt (Mat 3 2 Float) -> GLElt (Mat 3 2 Float))
-> Mat 3 2 Float -> Mat 3 2 Float -> Mat 3 2 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 2 Float)
 -> GLElt (Mat 3 2 Float)
 -> GLElt (Mat 3 2 Float)
 -> GLElt (Mat 3 2 Float))
-> Mat 3 2 Float -> Mat 3 2 Float -> Mat 3 2 Float -> Mat 3 2 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 2 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 3 2 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
6
    arrayLen :: Mat 3 2 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 2 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 3 2 Float -> IO ()
uniformSet GLint
ul Mat 3 2 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix2x3fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 2 Float
m)
instance GLType (Mat 3 3 Float) where
    showGlslVal :: Mat 3 3 Float -> String
showGlslVal Mat 3 3 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat3x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 3 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 3 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat3x3"
    glMap :: (GLElt (Mat 3 3 Float) -> GLElt (Mat 3 3 Float))
-> Mat 3 3 Float -> Mat 3 3 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 3 Float)
 -> GLElt (Mat 3 3 Float) -> GLElt (Mat 3 3 Float))
-> Mat 3 3 Float -> Mat 3 3 Float -> Mat 3 3 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 3 Float)
 -> GLElt (Mat 3 3 Float)
 -> GLElt (Mat 3 3 Float)
 -> GLElt (Mat 3 3 Float))
-> Mat 3 3 Float -> Mat 3 3 Float -> Mat 3 3 Float -> Mat 3 3 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 3 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 3 3 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
9
    arrayLen :: Mat 3 3 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 3 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 3 3 Float -> IO ()
uniformSet GLint
ul Mat 3 3 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix3fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 3 Float
m)
instance GLType (Mat 3 4 Float) where
    showGlslVal :: Mat 3 4 Float -> String
showGlslVal Mat 3 4 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat4x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 4 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 4 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat4x3"
    glMap :: (GLElt (Mat 3 4 Float) -> GLElt (Mat 3 4 Float))
-> Mat 3 4 Float -> Mat 3 4 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 4 Float)
 -> GLElt (Mat 3 4 Float) -> GLElt (Mat 3 4 Float))
-> Mat 3 4 Float -> Mat 3 4 Float -> Mat 3 4 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 4 Float)
 -> GLElt (Mat 3 4 Float)
 -> GLElt (Mat 3 4 Float)
 -> GLElt (Mat 3 4 Float))
-> Mat 3 4 Float -> Mat 3 4 Float -> Mat 3 4 Float -> Mat 3 4 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 4 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 3 4 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
12
    arrayLen :: Mat 3 4 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 4 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 3 4 Float -> IO ()
uniformSet GLint
ul Mat 3 4 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix4x3fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 4 Float
m)
instance GLType (Mat 4 2 Float) where
    showGlslVal :: Mat 4 2 Float -> String
showGlslVal Mat 4 2 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat2x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 2 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 2 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat2x4"
    glMap :: (GLElt (Mat 4 2 Float) -> GLElt (Mat 4 2 Float))
-> Mat 4 2 Float -> Mat 4 2 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 2 Float)
 -> GLElt (Mat 4 2 Float) -> GLElt (Mat 4 2 Float))
-> Mat 4 2 Float -> Mat 4 2 Float -> Mat 4 2 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 2 Float)
 -> GLElt (Mat 4 2 Float)
 -> GLElt (Mat 4 2 Float)
 -> GLElt (Mat 4 2 Float))
-> Mat 4 2 Float -> Mat 4 2 Float -> Mat 4 2 Float -> Mat 4 2 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 4 2 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 4 2 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
8
    arrayLen :: Mat 4 2 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 4 2 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 4 2 Float -> IO ()
uniformSet GLint
ul Mat 4 2 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix2x4fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 2 Float
m)
instance GLType (Mat 4 3 Float) where
    showGlslVal :: Mat 4 3 Float -> String
showGlslVal Mat 4 3 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat3x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 3 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 3 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat3x4"
    glMap :: (GLElt (Mat 4 3 Float) -> GLElt (Mat 4 3 Float))
-> Mat 4 3 Float -> Mat 4 3 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 3 Float)
 -> GLElt (Mat 4 3 Float) -> GLElt (Mat 4 3 Float))
-> Mat 4 3 Float -> Mat 4 3 Float -> Mat 4 3 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 3 Float)
 -> GLElt (Mat 4 3 Float)
 -> GLElt (Mat 4 3 Float)
 -> GLElt (Mat 4 3 Float))
-> Mat 4 3 Float -> Mat 4 3 Float -> Mat 4 3 Float -> Mat 4 3 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 4 3 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 4 3 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
12
    arrayLen :: Mat 4 3 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 4 3 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 4 3 Float -> IO ()
uniformSet GLint
ul Mat 4 3 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix3x4fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 3 Float
m)
instance GLType (Mat 4 4 Float) where
    showGlslVal :: Mat 4 4 Float -> String
showGlslVal Mat 4 4 Float
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"mat4x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 4 Float
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 4 Float) -> String
showGlslType = forall a b. a -> b -> a
const String
"mat4x4"
    glMap :: (GLElt (Mat 4 4 Float) -> GLElt (Mat 4 4 Float))
-> Mat 4 4 Float -> Mat 4 4 Float
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 4 Float)
 -> GLElt (Mat 4 4 Float) -> GLElt (Mat 4 4 Float))
-> Mat 4 4 Float -> Mat 4 4 Float -> Mat 4 4 Float
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 4 Float)
 -> GLElt (Mat 4 4 Float)
 -> GLElt (Mat 4 4 Float)
 -> GLElt (Mat 4 4 Float))
-> Mat 4 4 Float -> Mat 4 4 Float -> Mat 4 4 Float -> Mat 4 4 Float
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 4 4 Float] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [Mat 4 4 Float] -> Int
numComponents = forall a b. a -> b -> a
const Int
16
    arrayLen :: Mat 4 4 Float -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 4 4 Float] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> Mat 4 4 Float -> IO ()
uniformSet GLint
ul Mat 4 4 Float
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Float -> m ()
RawGL.glUniformMatrix4fv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 4 Float
m)
instance GLType (Mat 2 2 Double) where
    showGlslVal :: Mat 2 2 Double -> String
showGlslVal Mat 2 2 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat2x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 2 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 2 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat2x2"
    glMap :: (GLElt (Mat 2 2 Double) -> GLElt (Mat 2 2 Double))
-> Mat 2 2 Double -> Mat 2 2 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 2 Double)
 -> GLElt (Mat 2 2 Double) -> GLElt (Mat 2 2 Double))
-> Mat 2 2 Double -> Mat 2 2 Double -> Mat 2 2 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 2 Double)
 -> GLElt (Mat 2 2 Double)
 -> GLElt (Mat 2 2 Double)
 -> GLElt (Mat 2 2 Double))
-> Mat 2 2 Double
-> Mat 2 2 Double
-> Mat 2 2 Double
-> Mat 2 2 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 2 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 2 2 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    arrayLen :: Mat 2 2 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 2 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 2 2 Double -> IO ()
uniformSet GLint
ul Mat 2 2 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix2dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 2 Double
m)
instance GLType (Mat 2 3 Double) where
    showGlslVal :: Mat 2 3 Double -> String
showGlslVal Mat 2 3 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat3x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 3 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 3 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat3x2"
    glMap :: (GLElt (Mat 2 3 Double) -> GLElt (Mat 2 3 Double))
-> Mat 2 3 Double -> Mat 2 3 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 3 Double)
 -> GLElt (Mat 2 3 Double) -> GLElt (Mat 2 3 Double))
-> Mat 2 3 Double -> Mat 2 3 Double -> Mat 2 3 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 3 Double)
 -> GLElt (Mat 2 3 Double)
 -> GLElt (Mat 2 3 Double)
 -> GLElt (Mat 2 3 Double))
-> Mat 2 3 Double
-> Mat 2 3 Double
-> Mat 2 3 Double
-> Mat 2 3 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 3 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 2 3 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
6
    arrayLen :: Mat 2 3 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 3 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 2 3 Double -> IO ()
uniformSet GLint
ul Mat 2 3 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix3x2dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 3 Double
m)
instance GLType (Mat 2 4 Double) where
    showGlslVal :: Mat 2 4 Double -> String
showGlslVal Mat 2 4 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat4x2" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 4 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 2 4 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat4x2"
    glMap :: (GLElt (Mat 2 4 Double) -> GLElt (Mat 2 4 Double))
-> Mat 2 4 Double -> Mat 2 4 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 2 4 Double)
 -> GLElt (Mat 2 4 Double) -> GLElt (Mat 2 4 Double))
-> Mat 2 4 Double -> Mat 2 4 Double -> Mat 2 4 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 2 4 Double)
 -> GLElt (Mat 2 4 Double)
 -> GLElt (Mat 2 4 Double)
 -> GLElt (Mat 2 4 Double))
-> Mat 2 4 Double
-> Mat 2 4 Double
-> Mat 2 4 Double
-> Mat 2 4 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 2 4 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 2 4 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
8
    arrayLen :: Mat 2 4 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 2 4 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 2 4 Double -> IO ()
uniformSet GLint
ul Mat 2 4 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix4x2dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 2 4 Double
m)
instance GLType (Mat 3 2 Double) where
    showGlslVal :: Mat 3 2 Double -> String
showGlslVal Mat 3 2 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat2x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 2 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 2 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat2x3"
    glMap :: (GLElt (Mat 3 2 Double) -> GLElt (Mat 3 2 Double))
-> Mat 3 2 Double -> Mat 3 2 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 2 Double)
 -> GLElt (Mat 3 2 Double) -> GLElt (Mat 3 2 Double))
-> Mat 3 2 Double -> Mat 3 2 Double -> Mat 3 2 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 2 Double)
 -> GLElt (Mat 3 2 Double)
 -> GLElt (Mat 3 2 Double)
 -> GLElt (Mat 3 2 Double))
-> Mat 3 2 Double
-> Mat 3 2 Double
-> Mat 3 2 Double
-> Mat 3 2 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 2 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 3 2 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
6
    arrayLen :: Mat 3 2 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 2 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 3 2 Double -> IO ()
uniformSet GLint
ul Mat 3 2 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix2x3dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 2 Double
m)
instance GLType (Mat 3 3 Double) where
    showGlslVal :: Mat 3 3 Double -> String
showGlslVal Mat 3 3 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat3x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 3 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 3 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat3x3"
    glMap :: (GLElt (Mat 3 3 Double) -> GLElt (Mat 3 3 Double))
-> Mat 3 3 Double -> Mat 3 3 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 3 Double)
 -> GLElt (Mat 3 3 Double) -> GLElt (Mat 3 3 Double))
-> Mat 3 3 Double -> Mat 3 3 Double -> Mat 3 3 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 3 Double)
 -> GLElt (Mat 3 3 Double)
 -> GLElt (Mat 3 3 Double)
 -> GLElt (Mat 3 3 Double))
-> Mat 3 3 Double
-> Mat 3 3 Double
-> Mat 3 3 Double
-> Mat 3 3 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 3 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 3 3 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
9
    arrayLen :: Mat 3 3 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 3 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 3 3 Double -> IO ()
uniformSet GLint
ul Mat 3 3 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix3dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 3 Double
m)
instance GLType (Mat 3 4 Double) where
    showGlslVal :: Mat 3 4 Double -> String
showGlslVal Mat 3 4 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat4x3" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 4 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 3 4 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat4x3"
    glMap :: (GLElt (Mat 3 4 Double) -> GLElt (Mat 3 4 Double))
-> Mat 3 4 Double -> Mat 3 4 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 3 4 Double)
 -> GLElt (Mat 3 4 Double) -> GLElt (Mat 3 4 Double))
-> Mat 3 4 Double -> Mat 3 4 Double -> Mat 3 4 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 3 4 Double)
 -> GLElt (Mat 3 4 Double)
 -> GLElt (Mat 3 4 Double)
 -> GLElt (Mat 3 4 Double))
-> Mat 3 4 Double
-> Mat 3 4 Double
-> Mat 3 4 Double
-> Mat 3 4 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 3 4 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 3 4 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
12
    arrayLen :: Mat 3 4 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 3 4 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 3 4 Double -> IO ()
uniformSet GLint
ul Mat 3 4 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix4x3dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 3 4 Double
m)
instance GLType (Mat 4 2 Double) where
    showGlslVal :: Mat 4 2 Double -> String
showGlslVal Mat 4 2 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat2x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 2 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 2 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat2x4"
    glMap :: (GLElt (Mat 4 2 Double) -> GLElt (Mat 4 2 Double))
-> Mat 4 2 Double -> Mat 4 2 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 2 Double)
 -> GLElt (Mat 4 2 Double) -> GLElt (Mat 4 2 Double))
-> Mat 4 2 Double -> Mat 4 2 Double -> Mat 4 2 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 2 Double)
 -> GLElt (Mat 4 2 Double)
 -> GLElt (Mat 4 2 Double)
 -> GLElt (Mat 4 2 Double))
-> Mat 4 2 Double
-> Mat 4 2 Double
-> Mat 4 2 Double
-> Mat 4 2 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 4 2 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 4 2 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
8
    arrayLen :: Mat 4 2 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 4 2 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 4 2 Double -> IO ()
uniformSet GLint
ul Mat 4 2 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix2x4dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 2 Double
m)
instance GLType (Mat 4 3 Double) where
    showGlslVal :: Mat 4 3 Double -> String
showGlslVal Mat 4 3 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat3x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 3 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 3 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat3x4"
    glMap :: (GLElt (Mat 4 3 Double) -> GLElt (Mat 4 3 Double))
-> Mat 4 3 Double -> Mat 4 3 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 3 Double)
 -> GLElt (Mat 4 3 Double) -> GLElt (Mat 4 3 Double))
-> Mat 4 3 Double -> Mat 4 3 Double -> Mat 4 3 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 3 Double)
 -> GLElt (Mat 4 3 Double)
 -> GLElt (Mat 4 3 Double)
 -> GLElt (Mat 4 3 Double))
-> Mat 4 3 Double
-> Mat 4 3 Double
-> Mat 4 3 Double
-> Mat 4 3 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    eltSize :: [Mat 4 3 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 4 3 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
12
    arrayLen :: Mat 4 3 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    getGlslType :: [Mat 4 3 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 4 3 Double -> IO ()
uniformSet GLint
ul Mat 4 3 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix3x4dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 3 Double
m)
instance GLType (Mat 4 4 Double) where
    showGlslVal :: Mat 4 4 Double -> String
showGlslVal Mat 4 4 Double
m = forall {a}. GLType a => String -> [a] -> String
printVec String
"dmat4x4" (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 4 Double
m)
    showGlslType :: forall (a :: * -> *). a (Mat 4 4 Double) -> String
showGlslType = forall a b. a -> b -> a
const String
"dmat4x4"
    glMap :: (GLElt (Mat 4 4 Double) -> GLElt (Mat 4 4 Double))
-> Mat 4 4 Double -> Mat 4 4 Double
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt (Mat 4 4 Double)
 -> GLElt (Mat 4 4 Double) -> GLElt (Mat 4 4 Double))
-> Mat 4 4 Double -> Mat 4 4 Double -> Mat 4 4 Double
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt (Mat 4 4 Double)
 -> GLElt (Mat 4 4 Double)
 -> GLElt (Mat 4 4 Double)
 -> GLElt (Mat 4 4 Double))
-> Mat 4 4 Double
-> Mat 4 4 Double
-> Mat 4 4 Double
-> Mat 4 4 Double
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: Mat 4 4 Double -> Int
arrayLen = forall a b. a -> b -> a
const Int
1
    eltSize :: [Mat 4 4 Double] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [Mat 4 4 Double] -> Int
numComponents = forall a b. a -> b -> a
const Int
16
    getGlslType :: [Mat 4 4 Double] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> Mat 4 4 Double -> IO ()
uniformSet GLint
ul Mat 4 4 Double
m = 
        forall {t} {t} {t} {t} {b}.
(MatrixComponent t, Num t, Num t) =>
(t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLboolean -> Ptr Double -> m ()
RawGL.glUniformMatrix4dv GLint
ul (forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList forall a b. (a -> b) -> a -> b
$ forall (p :: Nat) (q :: Nat) t. Mat p q t -> Mat q p t
transpose Mat 4 4 Double
m)
instance GLType [Float] where
    showGlslVal :: [Float] -> String
showGlslVal [Float]
xs = String
"float[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Float]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Float] -> String
showGlslType = forall a b. a -> b -> a
const String
"float[]"
    glMap :: (GLElt [Float] -> GLElt [Float]) -> [Float] -> [Float]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Float] -> GLElt [Float] -> GLElt [Float])
-> [Float] -> [Float] -> [Float]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Float] -> GLElt [Float] -> GLElt [Float] -> GLElt [Float])
-> [Float] -> [Float] -> [Float] -> [Float]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Float] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Float]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Float]] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    getGlslType :: [[Float]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> [Float] -> IO ()
uniformSet GLint
ul [Float]
xs = 
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Float]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Float -> m ()
RawGL.glUniform1fv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Float]
xs)
instance GLType [Vec 2 Float] where
    showGlslVal :: [Vec 2 Float] -> String
showGlslVal [Vec 2 Float]
xs = String
"vec2[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 2 Float]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 2 Float] -> String
showGlslType = forall a b. a -> b -> a
const String
"vec2[]"
    glMap :: (GLElt [Vec 2 Float] -> GLElt [Vec 2 Float])
-> [Vec 2 Float] -> [Vec 2 Float]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 2 Float] -> GLElt [Vec 2 Float] -> GLElt [Vec 2 Float])
-> [Vec 2 Float] -> [Vec 2 Float] -> [Vec 2 Float]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 2 Float]
 -> GLElt [Vec 2 Float]
 -> GLElt [Vec 2 Float]
 -> GLElt [Vec 2 Float])
-> [Vec 2 Float] -> [Vec 2 Float] -> [Vec 2 Float] -> [Vec 2 Float]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 2 Float] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 2 Float]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 2 Float]] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    getGlslType :: [[Vec 2 Float]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> [Vec 2 Float] -> IO ()
uniformSet GLint
ul [Vec 2 Float]
xs = let xs' :: [Float]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 2 Float]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Float]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Float -> m ()
RawGL.glUniform2fv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Float]
xs')
instance GLType [Vec 3 Float] where
    showGlslVal :: [Vec 3 Float] -> String
showGlslVal [Vec 3 Float]
xs = String
"vec3[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 3 Float]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 3 Float] -> String
showGlslType = forall a b. a -> b -> a
const String
"vec3[]"
    glMap :: (GLElt [Vec 3 Float] -> GLElt [Vec 3 Float])
-> [Vec 3 Float] -> [Vec 3 Float]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 3 Float] -> GLElt [Vec 3 Float] -> GLElt [Vec 3 Float])
-> [Vec 3 Float] -> [Vec 3 Float] -> [Vec 3 Float]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 3 Float]
 -> GLElt [Vec 3 Float]
 -> GLElt [Vec 3 Float]
 -> GLElt [Vec 3 Float])
-> [Vec 3 Float] -> [Vec 3 Float] -> [Vec 3 Float] -> [Vec 3 Float]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 3 Float] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 3 Float]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 3 Float]] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    getGlslType :: [[Vec 3 Float]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> [Vec 3 Float] -> IO ()
uniformSet GLint
ul [Vec 3 Float]
xs = let xs' :: [Float]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 3 Float]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Float]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Float -> m ()
RawGL.glUniform3fv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Float]
xs')
instance GLType [Vec 4 Float] where
    showGlslVal :: [Vec 4 Float] -> String
showGlslVal [Vec 4 Float]
xs = String
"vec4[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 4 Float]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 4 Float] -> String
showGlslType = forall a b. a -> b -> a
const String
"vec4[]"
    glMap :: (GLElt [Vec 4 Float] -> GLElt [Vec 4 Float])
-> [Vec 4 Float] -> [Vec 4 Float]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 4 Float] -> GLElt [Vec 4 Float] -> GLElt [Vec 4 Float])
-> [Vec 4 Float] -> [Vec 4 Float] -> [Vec 4 Float]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 4 Float]
 -> GLElt [Vec 4 Float]
 -> GLElt [Vec 4 Float]
 -> GLElt [Vec 4 Float])
-> [Vec 4 Float] -> [Vec 4 Float] -> [Vec 4 Float] -> [Vec 4 Float]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 4 Float] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 4 Float]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 4 Float]] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    getGlslType :: [[Vec 4 Float]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Float
    uniformSet :: GLint -> [Vec 4 Float] -> IO ()
uniformSet GLint
ul [Vec 4 Float]
xs = let xs' :: [Float]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 4 Float]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Float]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Float -> m ()
RawGL.glUniform4fv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Float]
xs')
instance GLType [Double] where
    showGlslVal :: [Double] -> String
showGlslVal [Double]
xs = String
"double[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Double]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Double] -> String
showGlslType = forall a b. a -> b -> a
const String
"double[]"
    glMap :: (GLElt [Double] -> GLElt [Double]) -> [Double] -> [Double]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Double] -> GLElt [Double] -> GLElt [Double])
-> [Double] -> [Double] -> [Double]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Double]
 -> GLElt [Double] -> GLElt [Double] -> GLElt [Double])
-> [Double] -> [Double] -> [Double] -> [Double]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Double] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Double]] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [[Double]] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    getGlslType :: [[Double]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> [Double] -> IO ()
uniformSet GLint
ul [Double]
xs = 
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Double -> m ()
RawGL.glUniform1dv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Double]
xs)
instance GLType [Vec 2 Double] where
    showGlslVal :: [Vec 2 Double] -> String
showGlslVal [Vec 2 Double]
xs = String
"dvec2[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 2 Double]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 2 Double] -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec2[]"
    glMap :: (GLElt [Vec 2 Double] -> GLElt [Vec 2 Double])
-> [Vec 2 Double] -> [Vec 2 Double]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 2 Double]
 -> GLElt [Vec 2 Double] -> GLElt [Vec 2 Double])
-> [Vec 2 Double] -> [Vec 2 Double] -> [Vec 2 Double]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 2 Double]
 -> GLElt [Vec 2 Double]
 -> GLElt [Vec 2 Double]
 -> GLElt [Vec 2 Double])
-> [Vec 2 Double]
-> [Vec 2 Double]
-> [Vec 2 Double]
-> [Vec 2 Double]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 2 Double] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 2 Double]] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [[Vec 2 Double]] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    getGlslType :: [[Vec 2 Double]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> [Vec 2 Double] -> IO ()
uniformSet GLint
ul [Vec 2 Double]
xs = let xs' :: [Double]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 2 Double]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Double -> m ()
RawGL.glUniform2dv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Double]
xs')
instance GLType [Vec 3 Double] where
    showGlslVal :: [Vec 3 Double] -> String
showGlslVal [Vec 3 Double]
xs = String
"dvec3[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 3 Double]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 3 Double] -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec3[]"
    glMap :: (GLElt [Vec 3 Double] -> GLElt [Vec 3 Double])
-> [Vec 3 Double] -> [Vec 3 Double]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 3 Double]
 -> GLElt [Vec 3 Double] -> GLElt [Vec 3 Double])
-> [Vec 3 Double] -> [Vec 3 Double] -> [Vec 3 Double]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 3 Double]
 -> GLElt [Vec 3 Double]
 -> GLElt [Vec 3 Double]
 -> GLElt [Vec 3 Double])
-> [Vec 3 Double]
-> [Vec 3 Double]
-> [Vec 3 Double]
-> [Vec 3 Double]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 3 Double] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 3 Double]] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [[Vec 3 Double]] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    getGlslType :: [[Vec 3 Double]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> [Vec 3 Double] -> IO ()
uniformSet GLint
ul [Vec 3 Double]
xs = let xs' :: [Double]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 3 Double]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Double -> m ()
RawGL.glUniform3dv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Double]
xs')
instance GLType [Vec 4 Double] where
    showGlslVal :: [Vec 4 Double] -> String
showGlslVal [Vec 4 Double]
xs = String
"dvec4[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 4 Double]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 4 Double] -> String
showGlslType = forall a b. a -> b -> a
const String
"dvec4[]"
    glMap :: (GLElt [Vec 4 Double] -> GLElt [Vec 4 Double])
-> [Vec 4 Double] -> [Vec 4 Double]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 4 Double]
 -> GLElt [Vec 4 Double] -> GLElt [Vec 4 Double])
-> [Vec 4 Double] -> [Vec 4 Double] -> [Vec 4 Double]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 4 Double]
 -> GLElt [Vec 4 Double]
 -> GLElt [Vec 4 Double]
 -> GLElt [Vec 4 Double])
-> [Vec 4 Double]
-> [Vec 4 Double]
-> [Vec 4 Double]
-> [Vec 4 Double]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 4 Double] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 4 Double]] -> Int
eltSize = forall a b. a -> b -> a
const Int
8
    numComponents :: [[Vec 4 Double]] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    getGlslType :: [[Vec 4 Double]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Double
    uniformSet :: GLint -> [Vec 4 Double] -> IO ()
uniformSet GLint
ul [Vec 4 Double]
xs = let xs' :: [Double]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 4 Double]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr Double -> m ()
RawGL.glUniform4dv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Double]
xs')
instance GLType [Int] where
    showGlslVal :: [Int] -> String
showGlslVal [Int]
xs = String
"int[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Int]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Int] -> String
showGlslType = forall a b. a -> b -> a
const String
"int[]"
    glMap :: (GLElt [Int] -> GLElt [Int]) -> [Int] -> [Int]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Int] -> GLElt [Int] -> GLElt [Int])
-> [Int] -> [Int] -> [Int]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Int] -> GLElt [Int] -> GLElt [Int] -> GLElt [Int])
-> [Int] -> [Int] -> [Int] -> [Int]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Int] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Int]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Int]] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    getGlslType :: [[Int]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> [Int] -> IO ()
uniformSet GLint
ul [Int]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
toEnum [Int]
xs in
            forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform1iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 2 Int] where
    showGlslVal :: [Vec 2 Int] -> String
showGlslVal [Vec 2 Int]
xs = String
"ivec2[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 2 Int]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 2 Int] -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec2[]"
    glMap :: (GLElt [Vec 2 Int] -> GLElt [Vec 2 Int])
-> [Vec 2 Int] -> [Vec 2 Int]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 2 Int] -> GLElt [Vec 2 Int] -> GLElt [Vec 2 Int])
-> [Vec 2 Int] -> [Vec 2 Int] -> [Vec 2 Int]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 2 Int]
 -> GLElt [Vec 2 Int] -> GLElt [Vec 2 Int] -> GLElt [Vec 2 Int])
-> [Vec 2 Int] -> [Vec 2 Int] -> [Vec 2 Int] -> [Vec 2 Int]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 2 Int] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 2 Int]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 2 Int]] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    getGlslType :: [[Vec 2 Int]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> [Vec 2 Int] -> IO ()
uniformSet GLint
ul [Vec 2 Int]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 2 Int]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform2iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 3 Int] where
    showGlslVal :: [Vec 3 Int] -> String
showGlslVal [Vec 3 Int]
xs = String
"ivec3[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 3 Int]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 3 Int] -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec3[]"
    glMap :: (GLElt [Vec 3 Int] -> GLElt [Vec 3 Int])
-> [Vec 3 Int] -> [Vec 3 Int]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 3 Int] -> GLElt [Vec 3 Int] -> GLElt [Vec 3 Int])
-> [Vec 3 Int] -> [Vec 3 Int] -> [Vec 3 Int]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 3 Int]
 -> GLElt [Vec 3 Int] -> GLElt [Vec 3 Int] -> GLElt [Vec 3 Int])
-> [Vec 3 Int] -> [Vec 3 Int] -> [Vec 3 Int] -> [Vec 3 Int]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 3 Int] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 3 Int]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 3 Int]] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    getGlslType :: [[Vec 3 Int]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> [Vec 3 Int] -> IO ()
uniformSet GLint
ul [Vec 3 Int]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 3 Int]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform3iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 4 Int] where
    showGlslVal :: [Vec 4 Int] -> String
showGlslVal [Vec 4 Int]
xs = String
"ivec4[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 4 Int]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 4 Int] -> String
showGlslType = forall a b. a -> b -> a
const String
"ivec4[]"
    glMap :: (GLElt [Vec 4 Int] -> GLElt [Vec 4 Int])
-> [Vec 4 Int] -> [Vec 4 Int]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 4 Int] -> GLElt [Vec 4 Int] -> GLElt [Vec 4 Int])
-> [Vec 4 Int] -> [Vec 4 Int] -> [Vec 4 Int]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 4 Int]
 -> GLElt [Vec 4 Int] -> GLElt [Vec 4 Int] -> GLElt [Vec 4 Int])
-> [Vec 4 Int] -> [Vec 4 Int] -> [Vec 4 Int] -> [Vec 4 Int]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 4 Int] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 4 Int]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 4 Int]] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    getGlslType :: [[Vec 4 Int]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Int
    uniformSet :: GLint -> [Vec 4 Int] -> IO ()
uniformSet GLint
ul [Vec 4 Int]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 4 Int]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform4iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [UInt] where
    showGlslVal :: [UInt] -> String
showGlslVal [UInt]
xs = String
"uint[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [UInt]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [UInt] -> String
showGlslType = forall a b. a -> b -> a
const String
"uint[]"
    glMap :: (GLElt [UInt] -> GLElt [UInt]) -> [UInt] -> [UInt]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [UInt] -> GLElt [UInt] -> GLElt [UInt])
-> [UInt] -> [UInt] -> [UInt]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [UInt] -> GLElt [UInt] -> GLElt [UInt] -> GLElt [UInt])
-> [UInt] -> [UInt] -> [UInt] -> [UInt]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [UInt] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[UInt]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[UInt]] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    getGlslType :: [[UInt]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> [UInt] -> IO ()
uniformSet GLint
ul [UInt]
xs = 
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [UInt]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr UInt -> m ()
RawGL.glUniform1uiv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [UInt]
xs)
instance GLType [Vec 2 UInt] where
    showGlslVal :: [Vec 2 UInt] -> String
showGlslVal [Vec 2 UInt]
xs = String
"uvec2[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 2 UInt]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 2 UInt] -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec2[]"
    glMap :: (GLElt [Vec 2 UInt] -> GLElt [Vec 2 UInt])
-> [Vec 2 UInt] -> [Vec 2 UInt]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 2 UInt] -> GLElt [Vec 2 UInt] -> GLElt [Vec 2 UInt])
-> [Vec 2 UInt] -> [Vec 2 UInt] -> [Vec 2 UInt]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 2 UInt]
 -> GLElt [Vec 2 UInt] -> GLElt [Vec 2 UInt] -> GLElt [Vec 2 UInt])
-> [Vec 2 UInt] -> [Vec 2 UInt] -> [Vec 2 UInt] -> [Vec 2 UInt]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 2 UInt] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 2 UInt]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 2 UInt]] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    getGlslType :: [[Vec 2 UInt]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> [Vec 2 UInt] -> IO ()
uniformSet GLint
ul [Vec 2 UInt]
xs = let xs' :: [UInt]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 2 UInt]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [UInt]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr UInt -> m ()
RawGL.glUniform2uiv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [UInt]
xs')
instance GLType [Vec 3 UInt] where
    showGlslVal :: [Vec 3 UInt] -> String
showGlslVal [Vec 3 UInt]
xs = String
"uvec3[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 3 UInt]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 3 UInt] -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec3[]"
    glMap :: (GLElt [Vec 3 UInt] -> GLElt [Vec 3 UInt])
-> [Vec 3 UInt] -> [Vec 3 UInt]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 3 UInt] -> GLElt [Vec 3 UInt] -> GLElt [Vec 3 UInt])
-> [Vec 3 UInt] -> [Vec 3 UInt] -> [Vec 3 UInt]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 3 UInt]
 -> GLElt [Vec 3 UInt] -> GLElt [Vec 3 UInt] -> GLElt [Vec 3 UInt])
-> [Vec 3 UInt] -> [Vec 3 UInt] -> [Vec 3 UInt] -> [Vec 3 UInt]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 3 UInt] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 3 UInt]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 3 UInt]] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    getGlslType :: [[Vec 3 UInt]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> [Vec 3 UInt] -> IO ()
uniformSet GLint
ul [Vec 3 UInt]
xs = let xs' :: [UInt]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 3 UInt]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [UInt]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr UInt -> m ()
RawGL.glUniform3uiv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [UInt]
xs')
instance GLType [Vec 4 UInt] where
    showGlslVal :: [Vec 4 UInt] -> String
showGlslVal [Vec 4 UInt]
xs = String
"uvec4[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 4 UInt]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 4 UInt] -> String
showGlslType = forall a b. a -> b -> a
const String
"uvec4[]"
    glMap :: (GLElt [Vec 4 UInt] -> GLElt [Vec 4 UInt])
-> [Vec 4 UInt] -> [Vec 4 UInt]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 4 UInt] -> GLElt [Vec 4 UInt] -> GLElt [Vec 4 UInt])
-> [Vec 4 UInt] -> [Vec 4 UInt] -> [Vec 4 UInt]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 4 UInt]
 -> GLElt [Vec 4 UInt] -> GLElt [Vec 4 UInt] -> GLElt [Vec 4 UInt])
-> [Vec 4 UInt] -> [Vec 4 UInt] -> [Vec 4 UInt] -> [Vec 4 UInt]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 4 UInt] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 4 UInt]] -> Int
eltSize = forall a b. a -> b -> a
const Int
4
    numComponents :: [[Vec 4 UInt]] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    getGlslType :: [[Vec 4 UInt]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.UnsignedInt
    uniformSet :: GLint -> [Vec 4 UInt] -> IO ()
uniformSet GLint
ul [Vec 4 UInt]
xs = let xs' :: [UInt]
xs' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 4 UInt]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [UInt]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr UInt -> m ()
RawGL.glUniform4uiv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [UInt]
xs')
instance GLType [Bool] where
    showGlslVal :: [Bool] -> String
showGlslVal [Bool]
xs = String
"bool[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Bool]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Bool] -> String
showGlslType = forall a b. a -> b -> a
const String
"bool[]"
    glMap :: (GLElt [Bool] -> GLElt [Bool]) -> [Bool] -> [Bool]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Bool] -> GLElt [Bool] -> GLElt [Bool])
-> [Bool] -> [Bool] -> [Bool]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Bool] -> GLElt [Bool] -> GLElt [Bool] -> GLElt [Bool])
-> [Bool] -> [Bool] -> [Bool] -> [Bool]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Bool] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Bool]] -> Int
eltSize = forall a b. a -> b -> a
const Int
1
    numComponents :: [[Bool]] -> Int
numComponents = forall a b. a -> b -> a
const Int
1
    getGlslType :: [[Bool]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> [Bool] -> IO ()
uniformSet GLint
ul [Bool]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map Bool -> GLint
fromBool [Bool]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform1iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 2 Bool] where
    showGlslVal :: [Vec 2 Bool] -> String
showGlslVal [Vec 2 Bool]
xs = String
"bvec2[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 2 Bool]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 2 Bool] -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec2[]"
    glMap :: (GLElt [Vec 2 Bool] -> GLElt [Vec 2 Bool])
-> [Vec 2 Bool] -> [Vec 2 Bool]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 2 Bool] -> GLElt [Vec 2 Bool] -> GLElt [Vec 2 Bool])
-> [Vec 2 Bool] -> [Vec 2 Bool] -> [Vec 2 Bool]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 2 Bool]
 -> GLElt [Vec 2 Bool] -> GLElt [Vec 2 Bool] -> GLElt [Vec 2 Bool])
-> [Vec 2 Bool] -> [Vec 2 Bool] -> [Vec 2 Bool] -> [Vec 2 Bool]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 2 Bool] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 2 Bool]] -> Int
eltSize = forall a b. a -> b -> a
const Int
1
    numComponents :: [[Vec 2 Bool]] -> Int
numComponents = forall a b. a -> b -> a
const Int
2
    getGlslType :: [[Vec 2 Bool]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> [Vec 2 Bool] -> IO ()
uniformSet GLint
ul [Vec 2 Bool]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 2 Bool]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform2iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 3 Bool] where
    showGlslVal :: [Vec 3 Bool] -> String
showGlslVal [Vec 3 Bool]
xs = String
"bvec3[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 3 Bool]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 3 Bool] -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec3[]"
    glMap :: (GLElt [Vec 3 Bool] -> GLElt [Vec 3 Bool])
-> [Vec 3 Bool] -> [Vec 3 Bool]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 3 Bool] -> GLElt [Vec 3 Bool] -> GLElt [Vec 3 Bool])
-> [Vec 3 Bool] -> [Vec 3 Bool] -> [Vec 3 Bool]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 3 Bool]
 -> GLElt [Vec 3 Bool] -> GLElt [Vec 3 Bool] -> GLElt [Vec 3 Bool])
-> [Vec 3 Bool] -> [Vec 3 Bool] -> [Vec 3 Bool] -> [Vec 3 Bool]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 3 Bool] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 3 Bool]] -> Int
eltSize = forall a b. a -> b -> a
const Int
1
    numComponents :: [[Vec 3 Bool]] -> Int
numComponents = forall a b. a -> b -> a
const Int
3
    getGlslType :: [[Vec 3 Bool]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> [Vec 3 Bool] -> IO ()
uniformSet GLint
ul [Vec 3 Bool]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 3 Bool]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform3iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')
instance GLType [Vec 4 Bool] where
    showGlslVal :: [Vec 4 Bool] -> String
showGlslVal [Vec 4 Bool]
xs = String
"bvec4[](" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [Vec 4 Bool]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
    showGlslType :: forall (a :: * -> *). a [Vec 4 Bool] -> String
showGlslType = forall a b. a -> b -> a
const String
"bvec4[]"
    glMap :: (GLElt [Vec 4 Bool] -> GLElt [Vec 4 Bool])
-> [Vec 4 Bool] -> [Vec 4 Bool]
glMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    glZipWith :: (GLElt [Vec 4 Bool] -> GLElt [Vec 4 Bool] -> GLElt [Vec 4 Bool])
-> [Vec 4 Bool] -> [Vec 4 Bool] -> [Vec 4 Bool]
glZipWith = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
    glZipWith3 :: (GLElt [Vec 4 Bool]
 -> GLElt [Vec 4 Bool] -> GLElt [Vec 4 Bool] -> GLElt [Vec 4 Bool])
-> [Vec 4 Bool] -> [Vec 4 Bool] -> [Vec 4 Bool] -> [Vec 4 Bool]
glZipWith3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
    arrayLen :: [Vec 4 Bool] -> Int
arrayLen = forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length
    eltSize :: [[Vec 4 Bool]] -> Int
eltSize = forall a b. a -> b -> a
const Int
1
    numComponents :: [[Vec 4 Bool]] -> Int
numComponents = forall a b. a -> b -> a
const Int
4
    getGlslType :: [[Vec 4 Bool]] -> DataType
getGlslType = forall a b. a -> b -> a
const DataType
OpenGL.Byte
    uniformSet :: GLint -> [Vec 4 Bool] -> IO ()
uniformSet GLint
ul [Vec 4 Bool]
xs = let xs' :: [GLint]
xs' = forall a b. (a -> b) -> [a] -> [b]
map Bool -> GLint
fromBool forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList [Vec 4 Bool]
xs in
        forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint]
xs' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> Ptr GLint -> m ()
RawGL.glUniform4iv GLint
ul (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [GLint]
xs')

fromBool :: Bool -> GLint
fromBool = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

printVec :: String -> [a] -> String
printVec String
name [a]
xs = String
name forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall t. GLType t => t -> String
showGlslVal [a]
xs) forall a. [a] -> [a] -> [a]
++ String
")"

makeMatSetter :: (t -> t -> t -> Ptr t -> IO b) -> t -> [t] -> IO b
makeMatSetter t -> t -> t -> Ptr t -> IO b
rawSetter t
ul [t]
xs = do
    GLmatrix t
m :: OpenGL.GLmatrix t <- forall (m :: * -> *) c.
(Matrix m, MatrixComponent c) =>
MatrixOrder -> [c] -> IO (m c)
OpenGL.newMatrix MatrixOrder
OpenGL.RowMajor [t]
xs
    forall (m :: * -> *) c a.
(Matrix m, MatrixComponent c) =>
m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
OpenGL.withMatrix GLmatrix t
m forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ t -> t -> t -> Ptr t -> IO b
rawSetter t
ul t
1 t
0


-- | A primitive type or a vector type
class GLType t => GLPrimOrVec t

instance GLPrimOrVec Float
instance GLPrimOrVec Double
instance GLPrimOrVec Int
instance GLPrimOrVec UInt
instance GLPrimOrVec (Vec 2 Float)
instance GLPrimOrVec (Vec 3 Float)
instance GLPrimOrVec (Vec 4 Float)
instance GLPrimOrVec (Vec 2 Double)
instance GLPrimOrVec (Vec 3 Double)
instance GLPrimOrVec (Vec 4 Double)
instance GLPrimOrVec (Vec 2 Int)
instance GLPrimOrVec (Vec 3 Int)
instance GLPrimOrVec (Vec 4 Int)
instance GLPrimOrVec (Vec 2 UInt)
instance GLPrimOrVec (Vec 3 UInt)
instance GLPrimOrVec (Vec 4 UInt)

-- | The underlying type of a vertex input variable.
-- Double-precision types are currently not permitted due to an issue in the
-- OpenGL bindings.
class (GLPrimOrVec t, Storable (StoreElt t)) => GLInputType t where
    type StoreElt t
    toStorableList :: [t] -> [StoreElt t]

instance GLInputType Float where
    type StoreElt Float = Float
    toStorableList :: [Float] -> [StoreElt Float]
toStorableList = forall a. a -> a
id
-- Not currently supported due to 
-- https://github.com/haskell-opengl/OpenGL/issues/94
{-instance GLInputType Double where
    type StoreElt Double = Double
    toStorableList = id-}
instance GLInputType Int where
    type StoreElt Int = Int32
    toStorableList :: [Int] -> [StoreElt Int]
toStorableList = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance GLInputType UInt where
    type StoreElt UInt = Word32
    toStorableList :: [UInt] -> [StoreElt UInt]
toStorableList = forall a. a -> a
id
instance GLInputType (Vec 2 Float) where
    type StoreElt (Vec 2 Float) = Float
    toStorableList :: [Vec 2 Float] -> [StoreElt (Vec 2 Float)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList
instance GLInputType (Vec 3 Float) where
    type StoreElt (Vec 3 Float) = Float
    toStorableList :: [Vec 3 Float] -> [StoreElt (Vec 3 Float)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList
instance GLInputType (Vec 4 Float) where
    type StoreElt (Vec 4 Float) = Float
    toStorableList :: [Vec 4 Float] -> [StoreElt (Vec 4 Float)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList
-- Not currently supported due to 
-- https://github.com/haskell-opengl/OpenGL/issues/94
{-instance GLInputType (Vec 2 Double) where
    type StoreElt (Vec 2 Double) = Double
    toStorableList = concatMap toList
instance GLInputType (Vec 3 Double) where
    type StoreElt (Vec 3 Double) = Double
    toStorableList = concatMap toList
instance GLInputType (Vec 4 Double) where
    type StoreElt (Vec 4 Double) = Double
    toStorableList = concatMap toList-}
instance GLInputType (Vec 2 Int) where
    type StoreElt (Vec 2 Int) = Int32
    toStorableList :: [Vec 2 Int] -> [StoreElt (Vec 2 Int)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList)
instance GLInputType (Vec 3 Int) where
    type StoreElt (Vec 3 Int) = Int32
    toStorableList :: [Vec 3 Int] -> [StoreElt (Vec 3 Int)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList)
instance GLInputType (Vec 4 Int) where
    type StoreElt (Vec 4 Int) = Int32
    toStorableList :: [Vec 4 Int] -> [StoreElt (Vec 4 Int)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList)
instance GLInputType (Vec 2 UInt) where
    type StoreElt (Vec 2 UInt) = Word32
    toStorableList :: [Vec 2 UInt] -> [StoreElt (Vec 2 UInt)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList
instance GLInputType (Vec 3 UInt) where
    type StoreElt (Vec 3 UInt) = Word32
    toStorableList :: [Vec 3 UInt] -> [StoreElt (Vec 3 UInt)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList
instance GLInputType (Vec 4 UInt) where
    type StoreElt (Vec 4 UInt) = Word32
    toStorableList :: [Vec 4 UInt] -> [StoreElt (Vec 4 UInt)]
toStorableList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (p :: Nat) (q :: Nat) t. Mat p q t -> [t]
toList

-- | Any type whose values can be interpolated smoothly when constructing a 
-- fragment variable
class GLInputType t => GLSupportsSmoothInterp t

instance GLSupportsSmoothInterp Float
instance GLSupportsSmoothInterp (Vec 2 Float)
instance GLSupportsSmoothInterp (Vec 3 Float)
instance GLSupportsSmoothInterp (Vec 4 Float)

-- | Any type which supports bitwise operations
class (GLType t, Integral (GLElt t), Bits (GLElt t)) => GLSupportsBitwiseOps t

instance GLSupportsBitwiseOps Int
instance GLSupportsBitwiseOps UInt
instance GLSupportsBitwiseOps (Vec 2 Int)
instance GLSupportsBitwiseOps (Vec 3 Int)
instance GLSupportsBitwiseOps (Vec 4 Int)
instance GLSupportsBitwiseOps (Vec 2 UInt)
instance GLSupportsBitwiseOps (Vec 3 UInt)
instance GLSupportsBitwiseOps (Vec 4 UInt)


-- | The type of the elements of @t@ or @t@ itself if @t@ is primitive
type family GLElt t where
    GLElt (Mat r c t) = t
    GLElt [t] = t
    GLElt Float = Float
    GLElt Double = Double
    GLElt Int = Int
    GLElt UInt = UInt
    GLElt Bool = Bool


-- * Primitive GLTypes

-- | Any primitive type
class (GLType t, Storable t, Enum t, Eq t, Ord t) => GLPrim t where
    glCast :: GLPrim t0 => t0 -> t
instance GLPrim Float where
    glCast :: forall t0. GLPrim t0 => t0 -> Float
glCast = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
instance GLPrim Double where
    glCast :: forall t0. GLPrim t0 => t0 -> Double
glCast = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
instance GLPrim Int where
    glCast :: forall t0. GLPrim t0 => t0 -> Int
glCast = forall a. Enum a => a -> Int
fromEnum
instance GLPrim UInt where
    glCast :: forall t0. GLPrim t0 => t0 -> UInt
glCast = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
instance GLPrim Bool where
    glCast :: forall t0. GLPrim t0 => t0 -> Bool
glCast = (forall a. Eq a => a -> a -> Bool
/= forall a. Enum a => Int -> a
toEnum Int
0)

-- | Any single-precision primitive type
class (GLPrim t, Storable t, Enum t, Eq t, Ord t) => GLSingle t
instance GLSingle Float
instance GLSingle Int
instance GLSingle UInt
instance GLSingle Bool

-- | Any numeric primitive type
class (GLPrim t, Num t) => GLNumeric t where
    genDiv :: t -> t -> t
instance GLNumeric Float where genDiv :: Float -> Float -> Float
genDiv = forall a. Fractional a => a -> a -> a
(/)
instance GLNumeric Double where genDiv :: Double -> Double -> Double
genDiv = forall a. Fractional a => a -> a -> a
(/)
instance GLNumeric Int where genDiv :: Int -> Int -> Int
genDiv = forall a. Integral a => a -> a -> a
div
instance GLNumeric UInt where genDiv :: UInt -> UInt -> UInt
genDiv = forall a. Integral a => a -> a -> a
div

-- | Any signed primitive type
class GLNumeric t => GLSigned t where
instance GLSigned Float
instance GLSigned Double
instance GLSigned Int

-- | Any single- or double-precision floating-point type
class (GLSigned t, RealFrac t, Floating t) => GLFloating t
instance GLFloating Float
instance GLFloating Double

-- | Any single-precision signed primitive type
class GLSigned t => GLSingleNumeric t
instance GLSingleNumeric Float
instance GLSingleNumeric Int

-- | Any signed or unsigned integer type
class (GLPrim t, Integral t, Bits t) => GLInteger t
instance GLInteger Int
instance GLInteger UInt