{-# LANGUAGE TypeFamilies #-} module VertexBuffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Foreign -- internal imports import BindableClass import BufferClass -- layout of the VertexBuffer data object data VertexBuffer a = VertexBuffer { vBufId :: GL.BufferObject -- buffer id , vBufSize :: GL.GLsizeiptr -- size of data , vBufData :: Ptr a -- pointer to data } -- instanciate typeclass from BufferClass and fill in missing implementations instance Buffer (VertexBuffer a) where type ObjName (VertexBuffer a) = 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 , vBufData buf , GL.StaticDraw ) -- release the buffer using the default implementation of the typeclass unbind buf instance Bindable (VertexBuffer a) where -- bind the buffer bind buf = GL.bindBuffer (target buf) $= Just (glId buf) -- unbind the buffer unbind buf = GL.bindBuffer (target buf) $= Nothing newVertexBuffer :: (Storable a) => -- we have to be able to get a pointer to provided data [a] -> -- list of data elements IO (VertexBuffer a) -- newly built VertexBuffer data object newVertexBuffer list = do -- create the buffer object in applicative style buf <- VertexBuffer -- generate the ID <$> GL.genObjectName -- compute buffer size <*> pure (fromIntegral $ length list * sizeOf (head list)) -- make pointer out of list <*> newArray list -- fill the data in to the buffer initialize buf -- return the data object return buf