module Graphics.Caramia.VAO
(
newVAO
, VAO()
, sourceVertexData
, Sourcing(..)
, defaultSourcing
, defaultSourcingType
, SourceableType(..)
, SourceType(..)
, sourceTypeSize )
where
import Control.Monad.IO.Class
import Control.Monad.Catch
import Data.Unique
import qualified Graphics.Caramia.Buffer.Internal as Buf
import Graphics.Caramia.Internal.Exception
import Graphics.Caramia.Internal.OpenGLCApi
import Graphics.Caramia.Prelude
import Graphics.Caramia.Resource
import Graphics.Caramia.VAO.Internal
import Graphics.GL.Ext.ARB.VertexArrayObject
newVAO :: MonadIO m => m VAO
newVAO = liftIO $ mask_ $ do
checkOpenGLOrExtensionM (OpenGLVersion 3 0)
"GL_ARB_vertex_array_object"
gl_ARB_vertex_array_object $ do
res <- newResource create
(\(VAO_ vao) -> mglDeleteVertexArray vao)
(return ())
ref <- newIORef []
unique <- newUnique
return VAO { resource = res
, boundBuffers = ref
, vaoIndex = unique }
where
create = VAO_ <$> mglGenVertexArray
data SourceType =
SWord8
| SWord16
| SWord32
| SInt8
| SInt16
| SInt32
| SHalfFloat
| SFloat
| SDouble
deriving ( Eq, Ord, Show, Read )
sourceTypeSize :: SourceType -> Int
sourceTypeSize SWord8 = 1
sourceTypeSize SWord16 = 2
sourceTypeSize SWord32 = 4
sourceTypeSize SInt8 = 1
sourceTypeSize SInt16 = 2
sourceTypeSize SInt32 = 4
sourceTypeSize SHalfFloat = 2
sourceTypeSize SFloat = 4
sourceTypeSize SDouble = 8
isIntegerType :: SourceType -> Bool
isIntegerType SWord8 = True
isIntegerType SWord16 = True
isIntegerType SWord32 = True
isIntegerType SInt8 = True
isIntegerType SInt16 = True
isIntegerType SInt32 = True
isIntegerType SHalfFloat = False
isIntegerType SFloat = False
isIntegerType SDouble = False
toConstant :: SourceType -> GLenum
toConstant SWord8 = GL_UNSIGNED_BYTE
toConstant SWord16 = GL_UNSIGNED_SHORT
toConstant SWord32 = GL_UNSIGNED_INT
toConstant SInt8 = GL_BYTE
toConstant SInt16 = GL_SHORT
toConstant SInt32 = GL_INT
toConstant SHalfFloat = GL_HALF_FLOAT
toConstant SFloat = GL_FLOAT
toConstant SDouble = GL_DOUBLE
class SourceableType a where
reifyType :: a -> SourceType
instance SourceableType Word8 where
reifyType _ = SWord8
instance SourceableType Word16 where
reifyType _ = SWord16
instance SourceableType Word32 where
reifyType _ = SWord32
instance SourceableType Int8 where
reifyType _ = SInt8
instance SourceableType Int16 where
reifyType _ = SInt16
instance SourceableType Int32 where
reifyType _ = SInt32
instance SourceableType Float where
reifyType _ = SFloat
instance SourceableType Double where
reifyType _ = SDouble
data Sourcing = Sourcing
{ offset :: Int
, attributeIndex :: Int
, components :: Int
, stride :: Int
, normalize :: Bool
, integerMapping :: Bool
, instancingDivisor :: Int
, sourceType :: SourceType
}
defaultSourcing :: Sourcing
defaultSourcing = Sourcing
{ offset = 0
, components =
error "defaultSourcing: number of components is not set."
, stride = 0
, instancingDivisor = 0
, attributeIndex =
error "defaultSourcing: attribute index is not set."
, integerMapping =
error "defaultSourcing: whether to do integer mapping is not set."
, normalize =
error "defaultSourcing: normalize is not set for an integer type."
, sourceType =
error "defaultSourcing: source type is not set." }
defaultSourcingType :: SourceableType a
=> a
-> Sourcing
defaultSourcingType x =
defaultSourcing { sourceType = reifyType x }
sourceVertexData :: MonadIO m
=> Buf.Buffer
-> Sourcing
-> VAO
-> m ()
sourceVertexData buffer sourcing vao = liftIO $ mask_ $
withResource (resource vao) $ \(VAO_ name) ->
withResource (Buf.resource buffer) $ \(Buf.Buffer_ bufname) -> do
errorChecking
if isIntegerType stype && integerMapping sourcing
then doIntegerMapping name bufname
else doOrdinaryMapping name bufname
mglVertexArrayVertexAttribDivisor
name
(safeFromIntegral $ attributeIndex sourcing)
(safeFromIntegral $ instancingDivisor sourcing)
atomicModifyIORef' (boundBuffers vao) $ \old ->
( addIfNotUnique buffer old, () )
where
addIfNotUnique new old =
maybe (new:old)
(const old)
(find (new ==) old)
stype = sourceType sourcing
ncomponents = components sourcing
doIntegerMapping name bufname =
mglVertexArrayVertexAttribIOffsetAndEnable
name
bufname
(safeFromIntegral $ attributeIndex sourcing)
(safeFromIntegral ncomponents)
(toConstant stype)
(safeFromIntegral $ stride sourcing)
(safeFromIntegral $ offset sourcing)
doOrdinaryMapping name bufname =
mglVertexArrayVertexAttribOffsetAndEnable
name
bufname
(safeFromIntegral $ attributeIndex sourcing)
(safeFromIntegral ncomponents)
(toConstant stype)
(if isIntegerType stype && normalize sourcing
then GL_TRUE
else GL_FALSE)
(safeFromIntegral $ stride sourcing)
(safeFromIntegral $ offset sourcing)
errorChecking = do
when (isIntegerType stype) $
unless (integerMapping sourcing) $
let x = normalize sourcing
in x `seq` return ()
attributeIndex sourcing `seq` return ()
when (stride sourcing < 0) $
error "sourceVertexData: stride is negative."
when (offset sourcing < 0) $
error "sourceVertexData: offset is negative."
when (ncomponents < 1 ||
ncomponents > 4) $ error $
"sourceVertexData: number of components must be between " <>
"1 and 4. I was given " <> show ncomponents