{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} module Types.Graphics.VertexBuffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Control.Concurrent.STM import Linear import Foreign import Foreign.C.Types import Foreign.Storable.Generic import GHC.Generics -- internal imports import Classes.Graphics.Bindable import Classes.Graphics.Buffer -- | layout of the VertexBuffer data object data VertexBuffer = VertexBuffer { vBufId :: TVar GL.BufferObject -- ^ buffer id , vBufSize :: TVar 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 } deriving (Generic) -- | make vertices instances of 'Storable'. it's a kind of magic ^.^ instance GStorable Vertex instance GStorable (V2 GL.GLfloat) instance GStorable (V3 GL.GLfloat) instance GStorable (V4 GL.GLfloat) -- | 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 Buffer and fill in missing implementations instance Buffer VertexBuffer where type ObjName VertexBuffer = GL.BufferObject target _ = GL.ArrayBuffer glId = readTVarIO . vBufId initialize buf = do -- bind the buffer using the default iplementation of the typeclass bind buf size <- readTVarIO (vBufSize buf) -- fill in the data GL.bufferData (target buf) $= ( size , nullPtr , GL.DynamicDraw ) -- release the buffer using the default implementation of the typeclass unbind buf -- | expand the buffer to double of it's previous size. -- This discards all previously written data and layouts, as internally the -- old buffer is discarded and a new buffer allocated. expand buf = do -- unbind the buffer before meddling with its innards unbind buf -- free the old buffer delete buf -- generate new buffer newId <- GL.genObjectName -- calculate new size newSize <- (2 *) <$> readTVarIO (vBufSize buf) -- update data object atomically $ do writeTVar (vBufId buf) newId writeTVar (vBufSize buf) newSize -- allocate and fill buffer with null data initialize buf delete buf = do unbind buf GL.deleteObjectName =<< (readTVarIO $ vBufId buf) -- | Instanciate Bindable typeclass required by Buffer typeclass implement it instance Bindable VertexBuffer where -- bind the buffer bind buf = (\a -> GL.bindBuffer (target buf) $= Just a) =<< glId buf -- unbind the buffer unbind buf = GL.bindBuffer (target buf) $= Nothing -- | smart constructor for a VertexBuffer data object newVertexBuffer :: Word -- ^ initial Buffer size -> Vertex -- ^ (empty) dummy vertex for determining buffer size -> IO VertexBuffer -- ^ newly built VertexBuffer data object newVertexBuffer initSize dummyVertex = 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 <- VertexBuffer -- generate the ID <$> (newTVarIO =<< GL.genObjectName) -- compute buffer size <*> (newTVarIO (CPtrdiff (fromIntegral $ fromIntegral initSize * vertSize dummyVertex))) -- make pointer out of list -- <*> newArray list -- fill the data in to the buffer initialize buf -- return the data object return buf