{-# LANGUAGE TypeFamilies #-} module Types.Graphics.VertexArray where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import qualified Data.Vector as V import Foreign (sizeOf) import Foreign.Ptr import Control.Concurrent.STM import Control.Monad (void) -- internal imports import Classes.Graphics.Bindable import Classes.Graphics.Buffer import Classes.Graphics.VertexLayout import Types.Graphics.VertexBuffer newtype VertexArray = VertexArray { vArrId :: GL.VertexArrayObject } deriving (Eq, Show) instance Bindable VertexArray where bind va = GL.bindVertexArrayObject $= Just (vArrId va) unbind va = GL.bindVertexArrayObject $= Nothing newVertexArray :: IO VertexArray newVertexArray = VertexArray <$> GL.genObjectName instance VertexLayout Vertex where type VertArray Vertex = VertexArray layoutElements vert = foldr (\a@(index, count) acc -> ( index , GL.VertexArrayDescriptor count GL.Float (fromIntegral $ sizeOf (undefined :: Vertex)) (nullPtr `plusPtr` (sizeOf (undefined :: GL.GLfloat) * fromIntegral (sum (map ((\(GL.VertexArrayDescriptor c _ _ _) -> c) . snd) acc)))) ) : acc ) [] (zip [0 ..] [3, 4, 2, 1]) addBuffer vert va vb = do -- bind vertex array and vertex buffer ot associate them bind va bind vb -- enable and fill vertex attrib pointer(s) let list = layoutElements vert mapM_ (\(index, descriptor) -> do GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled GL.vertexAttribPointer (GL.AttribLocation index) $= ( GL.ToNormalizedFloat , descriptor ) ) list unbind va unbind vb