-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrayObjects
-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <[email protected]>
-- Stability   :  stable
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.VertexArrayObjects (
   VertexArrayObject,
   bindVertexArrayObject
) where

import Control.Monad.IO.Class
import Data.ObjectName
import Data.StateVar
import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )
import Graphics.Rendering.OpenGL.GL.DebugOutput
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL

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

newtype VertexArrayObject = VertexArrayObject { VertexArrayObject -> GLuint
vertexArrayID :: GLuint }
   deriving( VertexArrayObject -> VertexArrayObject -> Bool
(VertexArrayObject -> VertexArrayObject -> Bool)
-> (VertexArrayObject -> VertexArrayObject -> Bool)
-> Eq VertexArrayObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VertexArrayObject -> VertexArrayObject -> Bool
== :: VertexArrayObject -> VertexArrayObject -> Bool
$c/= :: VertexArrayObject -> VertexArrayObject -> Bool
/= :: VertexArrayObject -> VertexArrayObject -> Bool
Eq, Eq VertexArrayObject
Eq VertexArrayObject =>
(VertexArrayObject -> VertexArrayObject -> Ordering)
-> (VertexArrayObject -> VertexArrayObject -> Bool)
-> (VertexArrayObject -> VertexArrayObject -> Bool)
-> (VertexArrayObject -> VertexArrayObject -> Bool)
-> (VertexArrayObject -> VertexArrayObject -> Bool)
-> (VertexArrayObject -> VertexArrayObject -> VertexArrayObject)
-> (VertexArrayObject -> VertexArrayObject -> VertexArrayObject)
-> Ord VertexArrayObject
VertexArrayObject -> VertexArrayObject -> Bool
VertexArrayObject -> VertexArrayObject -> Ordering
VertexArrayObject -> VertexArrayObject -> VertexArrayObject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VertexArrayObject -> VertexArrayObject -> Ordering
compare :: VertexArrayObject -> VertexArrayObject -> Ordering
$c< :: VertexArrayObject -> VertexArrayObject -> Bool
< :: VertexArrayObject -> VertexArrayObject -> Bool
$c<= :: VertexArrayObject -> VertexArrayObject -> Bool
<= :: VertexArrayObject -> VertexArrayObject -> Bool
$c> :: VertexArrayObject -> VertexArrayObject -> Bool
> :: VertexArrayObject -> VertexArrayObject -> Bool
$c>= :: VertexArrayObject -> VertexArrayObject -> Bool
>= :: VertexArrayObject -> VertexArrayObject -> Bool
$cmax :: VertexArrayObject -> VertexArrayObject -> VertexArrayObject
max :: VertexArrayObject -> VertexArrayObject -> VertexArrayObject
$cmin :: VertexArrayObject -> VertexArrayObject -> VertexArrayObject
min :: VertexArrayObject -> VertexArrayObject -> VertexArrayObject
Ord, Int -> VertexArrayObject -> ShowS
[VertexArrayObject] -> ShowS
VertexArrayObject -> String
(Int -> VertexArrayObject -> ShowS)
-> (VertexArrayObject -> String)
-> ([VertexArrayObject] -> ShowS)
-> Show VertexArrayObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VertexArrayObject -> ShowS
showsPrec :: Int -> VertexArrayObject -> ShowS
$cshow :: VertexArrayObject -> String
show :: VertexArrayObject -> String
$cshowList :: [VertexArrayObject] -> ShowS
showList :: [VertexArrayObject] -> ShowS
Show )

instance ObjectName VertexArrayObject where
   isObjectName :: forall (m :: * -> *). MonadIO m => VertexArrayObject -> m Bool
isObjectName =
     IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> (VertexArrayObject -> IO Bool) -> VertexArrayObject -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLboolean -> Bool) -> IO GLboolean -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean (IO GLboolean -> IO Bool)
-> (VertexArrayObject -> IO GLboolean)
-> VertexArrayObject
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLuint -> IO GLboolean
forall (m :: * -> *). MonadIO m => GLuint -> m GLboolean
glIsVertexArray (GLuint -> IO GLboolean)
-> (VertexArrayObject -> GLuint)
-> VertexArrayObject
-> IO GLboolean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexArrayObject -> GLuint
vertexArrayID

   deleteObjectNames :: forall (m :: * -> *). MonadIO m => [VertexArrayObject] -> m ()
deleteObjectNames [VertexArrayObject]
bufferObjects =
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Int -> Ptr GLuint -> IO ()) -> IO ())
-> (Int -> Ptr GLuint -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
vertexArrayID [VertexArrayObject]
bufferObjects) ((Int -> Ptr GLuint -> IO ()) -> m ())
-> (Int -> Ptr GLuint -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$
         GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteVertexArrays (GLint -> Ptr GLuint -> IO ())
-> (Int -> GLint) -> Int -> Ptr GLuint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance GeneratableObjectName VertexArrayObject where
   genObjectNames :: forall (m :: * -> *). MonadIO m => Int -> m [VertexArrayObject]
genObjectNames Int
n = IO [VertexArrayObject] -> m [VertexArrayObject]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VertexArrayObject] -> m [VertexArrayObject])
-> ((Ptr GLuint -> IO [VertexArrayObject])
    -> IO [VertexArrayObject])
-> (Ptr GLuint -> IO [VertexArrayObject])
-> m [VertexArrayObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (Ptr GLuint -> IO [VertexArrayObject]) -> IO [VertexArrayObject]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr GLuint -> IO [VertexArrayObject]) -> m [VertexArrayObject])
-> (Ptr GLuint -> IO [VertexArrayObject]) -> m [VertexArrayObject]
forall a b. (a -> b) -> a -> b
$ \Ptr GLuint
buf -> do
      GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenVertexArrays (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Ptr GLuint
buf
      ([GLuint] -> [VertexArrayObject])
-> IO [GLuint] -> IO [VertexArrayObject]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GLuint -> VertexArrayObject) -> [GLuint] -> [VertexArrayObject]
forall a b. (a -> b) -> [a] -> [b]
map GLuint -> VertexArrayObject
VertexArrayObject) (IO [GLuint] -> IO [VertexArrayObject])
-> IO [GLuint] -> IO [VertexArrayObject]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr GLuint -> IO [GLuint]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr GLuint
buf

instance CanBeLabeled VertexArrayObject where
   objectLabel :: VertexArrayObject -> StateVar (Maybe String)
objectLabel = GLuint -> GLuint -> StateVar (Maybe String)
objectNameLabel GLuint
GL_VERTEX_ARRAY (GLuint -> StateVar (Maybe String))
-> (VertexArrayObject -> GLuint)
-> VertexArrayObject
-> StateVar (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexArrayObject -> GLuint
vertexArrayID

bindVertexArrayObject :: StateVar (Maybe VertexArrayObject)
bindVertexArrayObject :: StateVar (Maybe VertexArrayObject)
bindVertexArrayObject = IO (Maybe VertexArrayObject)
-> (Maybe VertexArrayObject -> IO ())
-> StateVar (Maybe VertexArrayObject)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (Maybe VertexArrayObject)
getVAO Maybe VertexArrayObject -> IO ()
bindVAO

getVAO :: IO (Maybe VertexArrayObject)
getVAO :: IO (Maybe VertexArrayObject)
getVAO = do
   vao <- (GLint -> VertexArrayObject) -> PName1I -> IO VertexArrayObject
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getInteger1 (GLuint -> VertexArrayObject
VertexArrayObject (GLuint -> VertexArrayObject)
-> (GLint -> GLuint) -> GLint -> VertexArrayObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PName1I
GetVertexArrayBinding
   return $ if vao == noVAO then Nothing else Just vao

bindVAO :: Maybe VertexArrayObject -> IO ()
bindVAO :: Maybe VertexArrayObject -> IO ()
bindVAO = GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glBindVertexArray (GLuint -> IO ())
-> (Maybe VertexArrayObject -> GLuint)
-> Maybe VertexArrayObject
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexArrayObject -> GLuint
vertexArrayID (VertexArrayObject -> GLuint)
-> (Maybe VertexArrayObject -> VertexArrayObject)
-> Maybe VertexArrayObject
-> GLuint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexArrayObject
-> (VertexArrayObject -> VertexArrayObject)
-> Maybe VertexArrayObject
-> VertexArrayObject
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VertexArrayObject
noVAO VertexArrayObject -> VertexArrayObject
forall a. a -> a
id

noVAO :: VertexArrayObject
noVAO :: VertexArrayObject
noVAO = GLuint -> VertexArrayObject
VertexArrayObject GLuint
0