{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} module Types.Graphics.VertexBuffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Control.Monad.Loops (whileM_) import Control.Concurrent.STM import qualified Data.Vector.Storable as VS import Linear import Foreign 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 } 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 -- | Instanciate typeclass Buffer and fill in missing implementations instance Buffer VertexBuffer where type StoreType VertexBuffer = Vertex type StoreContainer VertexBuffer = VS.Vector 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 write buf offset dat = do currentBufSize <- readTVarIO (vBufSize buf) whileM_ (pure $ fromIntegral offset + VS.length dat * sizeOf (undefined :: StoreType VertexBuffer) > fromIntegral currentBufSize) $ do allocaArray (fromIntegral currentBufSize `div` sizeOf (undefined :: StoreType VertexBuffer)) $ \ (ptr :: Ptr (StoreType VertexBuffer)) -> do GL.bufferSubData (target buf) GL.ReadFromBuffer 0 currentBufSize ptr expand buf bind buf GL.bufferSubData (target buf) GL.WriteToBuffer 0 currentBufSize ptr -- bind buffer, just to be safe bind buf VS.unsafeWith dat $ \ ptr -> GL.bufferSubData (target buf) -- target buffer type GL.WriteToBuffer -- data access direction (CPtrdiff $ fromIntegral offset) -- offset from buffer start (CPtrdiff $ fromIntegral $ VS.length dat * sizeOf (undefined :: StoreType VertexBuffer)) -- length of data to write ptr -- pointer to first data object --le | 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 -> IO VertexBuffer -- ^ newly built VertexBuffer data object newVertexBuffer initSize = 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 * sizeOf (undefined :: StoreType VertexBuffer)))) -- make pointer out of list -- <*> newArray list -- fill the data in to the buffer initialize buf -- return the data object return buf