diff --git a/src/VertexArray.hs b/src/VertexArray.hs new file mode 100644 index 0000000..5822141 --- /dev/null +++ b/src/VertexArray.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE TypeFamilies #-} +module VertexArray where + +import qualified Graphics.Rendering.OpenGL as GL + +import SDL (($=), get) + +import Foreign + +import Control.Concurrent.MVar + +-- internal imports + +import BufferClass +import VertexBuffer + +data VertexArray = VertexArray + { vArrId :: GL.VertexArrayObject + } + deriving (Eq, Show) + +instance Buffer VertexArray where + + type ObjName VertexArray = GL.VertexArrayObject + + target _ = undefined + + glId = vArrId + + initialize va = return () + + bind va = GL.bindVertexArrayObject $= Just (vArrId va) + + unbind va = GL.bindVertexArrayObject $= Nothing + +newVertexArray :: IO VertexArray +newVertexArray = VertexArray + <$> GL.genObjectName + +addBuffer + :: VertexArray + -> VertexBuffer a + -> 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 indexed = zip [0 ..] list + dataElementSize e = case e of + GL.Float -> sizeOf (undefined :: GL.GLfloat) + x -> error ("No size computation implemented fof: " <> show x) + mapM_ + (\(index, elem) -> do + let offset = fromIntegral $ + foldl + (\acc (index, _) -> acc + index ) + 0 + (filter ((<= index) . fst) indexed) :: Int + GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled + GL.vertexAttribPointer (GL.AttribLocation index) $= + ( vbleHandling elem + , GL.VertexArrayDescriptor + -- number of components to our attribute + (vbleCount elem) + -- datatype of elements + (vbleType elem) + -- ??? + 0 + -- offset from beginnning of vertex + (plusPtr nullPtr (offset * dataElementSize (vbleType elem))) + ) + ) + indexed + unbind va + unbind vb + +newtype VertexBufferLayout = VertexBufferLayout + { vblElements :: MVar [VertexBufferLayoutElement] + } + +data VertexBufferLayoutElement = VertexBufferLayoutElement + { vbleType :: GL.DataType + , vbleCount :: GL.GLint + , vbleHandling :: GL.IntegerHandling + } + +newVertexBufferLayout :: IO VertexBufferLayout +newVertexBufferLayout = VertexBufferLayout + <$> newMVar [] + +pushElements :: VertexBufferLayout -> GL.DataType -> GL.GLint -> IO () +pushElements vbl type_ count = do + modifyMVar_ (vblElements vbl) $ \list -> + return (list ++ [VertexBufferLayoutElement type_ count GL.ToNormalizedFloat])