{-# LANGUAGE TypeFamilies #-} module Types.Graphics.VertexArray where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Foreign import Control.Concurrent.MVar -- internal imports import Classes.Graphics.Bindable import Classes.Graphics.Buffer import Types.Graphics.VertexBuffer data VertexArray = VertexArray { vArrId :: GL.VertexArrayObject } deriving (Eq, Show) instance Buffer VertexArray where type ObjName VertexArray = GL.VertexArrayObject target _ = undefined glId = return . vArrId initialize va = return () instance Bindable VertexArray where bind va = GL.bindVertexArrayObject $= Just (vArrId va) unbind va = GL.bindVertexArrayObject $= Nothing newVertexArray :: IO VertexArray newVertexArray = VertexArray <$> GL.genObjectName addBuffer :: (Buffer buf) => VertexArray -> buf -> VertexBufferLayout -> IO () addBuffer va vb layout = do -- bind the provided vertex buffer bind va bind vb -- enable and fill out the vertex attrib pointer(s) list <- readMVar (vblElements layout) let dataElementSize e = case e of GL.Float -> sizeOf (undefined :: GL.GLfloat) x -> error ("No size computation implemented fof: " <> show x) mapM_ (\(VertexBufferLayoutElement index type_ count offset handling) -> do GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled GL.vertexAttribPointer (GL.AttribLocation index) $= ( handling , GL.VertexArrayDescriptor -- number of components to our attribute count -- datatype of elements type_ -- Stride (How big is one Vertex in bytes) (vblStride layout) -- offset from beginnning of vertex in bytes (plusPtr nullPtr offset) ) ) list unbind va unbind vb data VertexBufferLayout = VertexBufferLayout { vblElements :: MVar [VertexBufferLayoutElement] , vblStride :: GL.GLsizei } data VertexBufferLayoutElement = VertexBufferLayoutElement { vbleIndex :: GL.GLuint , vbleType :: GL.DataType , vbleCount :: GL.GLint , vbleOffset :: Int , vbleHandling :: GL.IntegerHandling } newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout newVertexBufferLayout stride = VertexBufferLayout <$> newMVar [] <*> pure stride pushElements :: VertexBufferLayout -> GL.GLuint -> GL.DataType -> GL.GLint -> Int -> IO () pushElements vbl index type_ count offset = do modifyMVar_ (vblElements vbl) $ \list -> return (list ++ [VertexBufferLayoutElement index type_ count offset GL.ToNormalizedFloat ] )