-- | A thin layer over OpenGL 3.1+ vertex array objects.
module Graphics.GLUtil.VertexArrayObjects
  (makeVAO, withVAO, deleteVAO, deleteVAOs, VAO) where
import Graphics.Rendering.OpenGL
import Graphics.GL.Core31 (glDeleteVertexArrays)
import Foreign.Marshal.Array (withArrayLen)
import Foreign.Marshal.Utils (with)
import Unsafe.Coerce (unsafeCoerce)

-- |Short alias for 'VertexArrayObject'.
type VAO = VertexArrayObject

-- |Allocate a 'VertexArrayObject', and initialize it with the
-- provided action. This action should bind the buffer data, index
-- data (if necessary), and setup vertex attributes.
makeVAO :: IO () -> IO VertexArrayObject
makeVAO :: IO () -> IO VertexArrayObject
makeVAO setup :: IO ()
setup = do [vao :: VertexArrayObject
vao] <- Int -> IO [VertexArrayObject]
forall a (m :: * -> *).
(GeneratableObjectName a, MonadIO m) =>
Int -> m [a]
genObjectNames 1
                   StateVar (Maybe VertexArrayObject)
bindVertexArrayObject StateVar (Maybe VertexArrayObject)
-> Maybe VertexArrayObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= VertexArrayObject -> Maybe VertexArrayObject
forall a. a -> Maybe a
Just VertexArrayObject
vao
                   IO ()
setup
                   StateVar (Maybe VertexArrayObject)
bindVertexArrayObject StateVar (Maybe VertexArrayObject)
-> Maybe VertexArrayObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Maybe VertexArrayObject
forall a. Maybe a
Nothing
                   VertexArrayObject -> IO VertexArrayObject
forall (m :: * -> *) a. Monad m => a -> m a
return VertexArrayObject
vao

-- |Run an action with the given 'VertexArrayObject' bound.
withVAO :: VertexArrayObject -> IO r -> IO r
withVAO :: VertexArrayObject -> IO r -> IO r
withVAO vao :: VertexArrayObject
vao useIt :: IO r
useIt = do StateVar (Maybe VertexArrayObject)
bindVertexArrayObject StateVar (Maybe VertexArrayObject)
-> Maybe VertexArrayObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= VertexArrayObject -> Maybe VertexArrayObject
forall a. a -> Maybe a
Just VertexArrayObject
vao
                       r
r <- IO r
useIt
                       StateVar (Maybe VertexArrayObject)
bindVertexArrayObject StateVar (Maybe VertexArrayObject)
-> Maybe VertexArrayObject -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Maybe VertexArrayObject
forall a. Maybe a
Nothing
                       r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r

-- | Delete a 'VertexArrayObject'.
deleteVAO :: VertexArrayObject -> IO ()
deleteVAO :: VertexArrayObject -> IO ()
deleteVAO vao :: VertexArrayObject
vao = GLuint -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (VertexArrayObject -> GLuint
vaoID VertexArrayObject
vao) ((Ptr GLuint -> IO ()) -> IO ()) -> (Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLsizei -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLuint -> m ()
glDeleteVertexArrays 1
  where vaoID :: VertexArrayObject -> GLuint
vaoID = VertexArrayObject -> GLuint
forall a b. a -> b
unsafeCoerce :: VertexArrayObject -> GLuint

-- | Delete a list of 'VertexArrayObject's.
deleteVAOs :: [VertexArrayObject] -> IO ()
deleteVAOs :: [VertexArrayObject] -> IO ()
deleteVAOs vaos :: [VertexArrayObject]
vaos = [GLuint] -> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((VertexArrayObject -> GLuint) -> [VertexArrayObject] -> [GLuint]
forall a b. (a -> b) -> [a] -> [b]
map VertexArrayObject -> GLuint
vaoID [VertexArrayObject]
vaos) ((Int -> Ptr GLuint -> IO ()) -> IO ())
-> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                    GLsizei -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLsizei -> Ptr GLuint -> m ()
glDeleteVertexArrays (GLsizei -> Ptr GLuint -> IO ())
-> (Int -> GLsizei) -> Int -> Ptr GLuint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  where vaoID :: VertexArrayObject -> GLuint
vaoID = VertexArrayObject -> GLuint
forall a b. a -> b
unsafeCoerce :: VertexArrayObject -> GLuint