{-# LANGUAGE TypeFamilies #-} module VertexBufferDynamic where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Linear import Foreign import Foreign.C.Types -- internal imports import BindableClass import BufferClass -- layout of the VertexBuffer data object data VertexBufferDynamic = VertexBufferDynamic { vBufId :: GL.BufferObject -- buffer id , vBufSize :: GL.GLsizeiptr -- size of data -- , vBufData :: Ptr a -- pointer to data } data Vertex = Vertex { vertPosition :: V3 GL.GLfloat , vertColor :: V4 GL.GLfloat , vertTexCoord :: V2 GL.GLfloat , vertTexID :: GL.GLfloat , vertSize :: GL.GLsizei } -- | Smart constructor for a new Vertex newVertex :: V3 GL.GLfloat -> V4 GL.GLfloat -> V2 GL.GLfloat -> GL.GLfloat -> Vertex newVertex pos color texcoord index = Vertex pos color texcoord index (fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat))) -- instanciate typeclass from BufferClass and fill in missing implementations instance Buffer VertexBufferDynamic where type ObjName VertexBufferDynamic = GL.BufferObject target _ = GL.ArrayBuffer glId = vBufId initialize buf = do -- bind the buffer using the default iplementation of the typeclass bind buf -- fill in the data GL.bufferData (target buf) $= ( vBufSize buf , nullPtr , GL.DynamicDraw ) -- release the buffer using the default implementation of the typeclass unbind buf instance Bindable VertexBufferDynamic where -- bind the buffer bind buf = GL.bindBuffer (target buf) $= Just (glId buf) -- unbind the buffer unbind buf = GL.bindBuffer (target buf) $= Nothing newVertexBufferDynamic :: IO VertexBufferDynamic -- newly built VertexBuffer data object newVertexBufferDynamic = do let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0 -- create the buffer object in applicative style buf <- VertexBufferDynamic -- generate the ID <$> GL.genObjectName -- compute buffer size <*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex)) -- make pointer out of list -- <*> newArray list -- fill the data in to the buffer initialize buf -- return the data object return buf