module Graphics.OpenGLES.Types (
Vec2, Vec3, Vec4,
BVec2, BVec3, BVec4,
IVec2, IVec3, IVec4,
UVec2, UVec3, UVec4,
Mat2, Mat3, Mat4,
Mat2x3, Mat2x4, Mat3x2,
Mat3x4, Mat4x2, Mat4x3,
Uniform, UnifVal,
Attrib, ShaderAttribute, AttrStruct,
HalfFloat(..), FixedFloat(..),
Int10x3_2(..), Word10x3_2(..)
) where
import Control.Monad (when)
import Foreign
import Linear.Class (Transpose, transpose)
import Linear.Vect
import Linear.Mat
import Graphics.OpenGLES.Base
import Graphics.OpenGLES.Internal
type Vec2 = V2 Float
type Vec3 = V3 Float
type Vec4 = V4 Float
type BVec2 = V2 Bool
type BVec3 = V3 Bool
type BVec4 = V4 Bool
type IVec2 = V2 Int32
type IVec3 = V3 Int32
type IVec4 = V4 Int32
type UVec2 = V2 Word32
type UVec3 = V3 Word32
type UVec4 = V4 Word32
type Mat2 = M2 Float
type Mat3 = M3 Float
type Mat4 = M4 Float
type Mat2x3 = M2x3 Float
type Mat2x4 = M2x4 Float
type Mat3x2 = M3x2 Float
type Mat3x4 = M3x4 Float
type Mat4x2 = M4x2 Float
type Mat4x3 = M4x3 Float
#define Uniform(_typ, _arg, _suffix, _rhs) \
instance UnifVal (_typ) where \
glUniform (loc, _, _) _arg = glUniform/**/_suffix loc _rhs \
Uniform(Float,x,1f,x)
Uniform(Vec2,(V2 x y),2f,x y)
Uniform(Vec3,(V3 x y z),3f,x y z)
Uniform(Vec4,(V4 x y z w),4f,x y z w)
Uniform(Int32,x,1i,x)
Uniform(IVec2,(V2 x y),2i,x y)
Uniform(IVec3,(V3 x y z),3i,x y z)
Uniform(IVec4,(V4 x y z w),4i,x y z w)
Uniform(Word32,x,1ui,x)
Uniform(UVec2,(V2 x y),2ui,x y)
Uniform(UVec3,(V3 x y z),3ui,x y z)
Uniform(UVec4,(V4 x y z w),4ui,x y z w)
pokeUniformArray
:: Storable b => (GLint -> GLsizei -> Ptr a -> GL ())
-> (GLint, GLsizei, Ptr ()) -> [b] -> GL ()
pokeUniformArray glUniformV (loc, len, ptr) values = do
let len' = fromIntegral len
pokeArray (castPtr ptr :: Ptr b) (take len' values)
glUniformV loc len (castPtr ptr)
instance UnifVal [Float] where glUniform = pokeUniformArray glUniform1fv
instance UnifVal [Vec2] where glUniform = pokeUniformArray glUniform2fv
instance UnifVal [Vec3] where glUniform = pokeUniformArray glUniform3fv
instance UnifVal [Vec4] where glUniform = pokeUniformArray glUniform4fv
instance UnifVal [Int32] where glUniform = pokeUniformArray glUniform1iv
instance UnifVal [IVec2] where glUniform = pokeUniformArray glUniform2iv
instance UnifVal [IVec3] where glUniform = pokeUniformArray glUniform3iv
instance UnifVal [IVec4] where glUniform = pokeUniformArray glUniform4iv
instance UnifVal [Word32] where glUniform = pokeUniformArray glUniform1uiv
instance UnifVal [UVec2] where glUniform = pokeUniformArray glUniform2uiv
instance UnifVal [UVec3] where glUniform = pokeUniformArray glUniform3uiv
instance UnifVal [UVec4] where glUniform = pokeUniformArray glUniform4uiv
pokeMatrix :: (Transpose a b, Storable b)
=> (GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> GL ())
-> (GLint, GLsizei, Ptr ()) -> a -> GL ()
pokeMatrix glUniformMatrixV (loc, 1, ptr) matrix = do
poke (castPtr ptr :: Ptr b) (transpose matrix)
glUniformMatrixV loc 1 0 (castPtr ptr)
pokeMatrix _ _ _ = return ()
instance UnifVal Mat2 where glUniform = pokeMatrix glUniformMatrix2fv
instance UnifVal Mat3 where glUniform = pokeMatrix glUniformMatrix3fv
instance UnifVal Mat4 where glUniform = pokeMatrix glUniformMatrix4fv
pokeMatrixT :: Storable a
=> (GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> GL ())
-> (GLint, GLsizei, Ptr ()) -> a -> GL ()
pokeMatrixT glUniformMatrixV (loc, 1, ptr) matrix = do
poke (castPtr ptr :: Ptr a) matrix
glUniformMatrixV loc 1 1 (castPtr ptr)
pokeMatrixT _ _ _ = return ()
instance UnifVal Mat2x3 where glUniform = pokeMatrixT glUniformMatrix2x3fv
instance UnifVal Mat2x4 where glUniform = pokeMatrixT glUniformMatrix2x4fv
instance UnifVal Mat3x2 where glUniform = pokeMatrixT glUniformMatrix3x2fv
instance UnifVal Mat3x4 where glUniform = pokeMatrixT glUniformMatrix3x4fv
instance UnifVal Mat4x2 where glUniform = pokeMatrixT glUniformMatrix4x2fv
instance UnifVal Mat4x3 where glUniform = pokeMatrixT glUniformMatrix4x3fv
pokeMatrices :: (Transpose a b, Storable b)
=> (GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> GL ())
-> (GLint, GLsizei, Ptr ()) -> [a] -> GL ()
pokeMatrices glUniformMatrixV (loc, len, ptr) matrices = do
let len' = fromIntegral len
pokeArray (castPtr ptr :: Ptr b)
(map transpose $ take len' matrices)
glUniformMatrixV loc len 0 (castPtr ptr)
instance UnifVal [Mat2] where glUniform = pokeMatrices glUniformMatrix2fv
instance UnifVal [Mat3] where glUniform = pokeMatrices glUniformMatrix3fv
instance UnifVal [Mat4] where glUniform = pokeMatrices glUniformMatrix4fv
pokeMatricesT :: Storable a
=> (GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> GL ())
-> (GLint, GLsizei, Ptr ()) -> [a] -> GL ()
pokeMatricesT glUniformMatrixV (loc, len, ptr) matrices = do
let len' = fromIntegral len
pokeArray (castPtr ptr :: Ptr a) (take len' matrices)
glUniformMatrixV loc len 1 (castPtr ptr)
instance UnifVal [Mat2x3] where glUniform = pokeMatricesT glUniformMatrix2x3fv
instance UnifVal [Mat2x4] where glUniform = pokeMatricesT glUniformMatrix2x4fv
instance UnifVal [Mat3x2] where glUniform = pokeMatricesT glUniformMatrix3x2fv
instance UnifVal [Mat3x4] where glUniform = pokeMatricesT glUniformMatrix3x4fv
instance UnifVal [Mat4x2] where glUniform = pokeMatricesT glUniformMatrix4x2fv
instance UnifVal [Mat4x3] where glUniform = pokeMatricesT glUniformMatrix4x3fv
instance GenericVertexAttribute a => ShaderAttribute a where
glVertexAttrib idx x =
with (V4 x 0 0 1) $ glVertexAttrib4v idx
instance GenericVertexAttribute a => ShaderAttribute (V2 a) where
glVertexAttrib idx (V2 x y) =
with (V4 x y 0 1) $ glVertexAttrib4v idx
instance GenericVertexAttribute a => ShaderAttribute (V3 a) where
glVertexAttrib idx (V3 x y z) =
with (V4 x y z 1) $ glVertexAttrib4v idx
instance GenericVertexAttribute a => ShaderAttribute (V4 a) where
glVertexAttrib idx v4 =
with v4 $ glVertexAttrib4v idx
instance ShaderAttribute Mat2 where
glVertexAttrib idx (M2 (V2 a b) (V2 c d)) = do
with (V4 a c 0 1) $ glVertexAttrib4v idx
with (V4 b d 0 1) $ glVertexAttrib4v (idx + 1)
instance ShaderAttribute Mat3 where
glVertexAttrib idx (M3 (V3 a b c) (V3 d e f) (V3 g h i)) = do
with (V4 a d g 1) $ glVertexAttrib4v idx
with (V4 b e h 1) $ glVertexAttrib4v (idx + 1)
with (V4 c f i 1) $ glVertexAttrib4v (idx + 2)
instance ShaderAttribute Mat4 where
glVertexAttrib idx (M4 (V4 a b c d) (V4 e f g h) (V4 i j k l) (V4 m n o p)) = do
with (V4 a e i m) $ glVertexAttrib4v idx
with (V4 b f j n) $ glVertexAttrib4v (idx + 1)
with (V4 c g k o) $ glVertexAttrib4v (idx + 2)
with (V4 d h l p) $ glVertexAttrib4v (idx + 3)
instance ShaderAttribute Mat3x2 where
glVertexAttrib idx (M3x2 a b c d e f) = do
with (V4 a c e 1) $ glVertexAttrib4v idx
with (V4 b d f 1) $ glVertexAttrib4v (idx + 1)
instance ShaderAttribute Mat4x2 where
glVertexAttrib idx (M4x2 a b c d e f g h) = do
with (V4 a c e g) $ glVertexAttrib4v idx
with (V4 b d f h) $ glVertexAttrib4v (idx + 1)
instance ShaderAttribute Mat2x3 where
glVertexAttrib idx (M2x3 a b c d e f) = do
with (V4 a d 0 1) $ glVertexAttrib4v idx
with (V4 b e 0 1) $ glVertexAttrib4v (idx + 1)
with (V4 c f 0 1) $ glVertexAttrib4v (idx + 2)
instance ShaderAttribute Mat4x3 where
glVertexAttrib idx (M4x3 a b c d e f g h i j k l) = do
with (V4 a d g j) $ glVertexAttrib4v idx
with (V4 b e h k) $ glVertexAttrib4v (idx + 1)
with (V4 c f i l) $ glVertexAttrib4v (idx + 2)
instance ShaderAttribute Mat2x4 where
glVertexAttrib idx (M2x4 a b c d e f g h) = do
with (V4 a e 0 1) $ glVertexAttrib4v idx
with (V4 b f 0 1) $ glVertexAttrib4v (idx + 1)
with (V4 c g 0 1) $ glVertexAttrib4v (idx + 2)
with (V4 d h 0 1) $ glVertexAttrib4v (idx + 3)
instance ShaderAttribute Mat3x4 where
glVertexAttrib idx (M3x4 a b c d e f g h i j k l) = do
with (V4 a e i 1) $ glVertexAttrib4v idx
with (V4 b f j 1) $ glVertexAttrib4v (idx + 1)
with (V4 c g k 1) $ glVertexAttrib4v (idx + 2)
with (V4 d h l 1) $ glVertexAttrib4v (idx + 3)
instance AttrStruct Float (Attrib p Float) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $
glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 1 (glType buf) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct Vec2 (Attrib p Vec2) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 2 (glType ([] :: [Float])) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct Vec3 (Attrib p Vec3) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 3 (glType ([] :: [Float])) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct Vec4 (Attrib p Vec4) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 4 (glType ([] :: [Float])) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct Word8 (Attrib p Float) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 1 (glType ([] :: [Word8])) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct (V2 Word8) (Attrib p Vec2) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 2 (glType ([] :: [Word8])) normalized 4 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct (V3 Word8) (Attrib p Vec3) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 2 (glType ([] :: [Word8])) normalized 4 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr
instance AttrStruct (V4 Word8) (Attrib p Vec4) p where
glVertexAttribPtr (Attrib (idx, 1, normalized, divisor)) buf = do
glEnableVertexAttribArray idx
when (divisor /= 0) $ glVertexAttribDivisor idx divisor
glVertexAttribPointer idx 2 (glType ([] :: [Word8])) normalized 0 nullPtr
glVertexAttribPtr attr buf = glLog $ "Ignoring attirb: " ++ show attr