{-# LANGUAGE TypeFamilies #-} module Types.Graphics.IndexBuffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import qualified Data.Vector.Storable as VS import Control.Monad.Loops (whileM_) import Control.Concurent.STM import Foreign -- internal imports import Classes.Graphics.Bindable import Classes.Graphics.Buffer -- layout of the IndexBuffer data object data IndexBuffer = IndexBuffer { iBufId :: TVar GL.BufferObject -- buffer id , iBufSize :: TVar GL.GLsizeiptr -- size of data -- , iBufData :: Ptr a -- pointer to data -- , iBufCount :: GL.GLint -- number of data elements } -- instanciate typeclass from Buffer and fill in missing implementations instance Buffer IndexBuffer where type StoreType IndexBuffer = GL.GLuint type StoreContainer IndexBuffer = VS.Vector target _ = GL.ElementArrayBuffer glId = readTVarIO . iBufId initialize buf = do -- bind the buffer using the default iplementation of the typeclass bind buf -- fill in the data GL.bufferData (target buf) $= ( iBufSize buf , nullPtr , GL.DynamicDraw ) -- release the buffer using the default implementation of the typeclass unbind buf write buf offset dat = do currentBufSize <- readTVarIO (iBufSize buf) whileM_ (pure $ offset + VS.length dat * sizeOf (undefined :: StoreType IndexBuffer) > currentBufSize) $ do allocaArray (currentBufSize `div` sizeOf (undefined :: StoreType IndexBuffer)) $ \ ptr -> 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) GL.WriteToBuffer (CPtrdiff $ fromIntegral offset) (CPtrdiff $ fromIntegral $ VS.length dat * sizeOf (undefined ::StoreType IndexBuffer)) ptr expand buf = do unbind buf delete buf newId <- GL.genObjectName newSize <- (2 *) <$> readTVarIO (iBufSize buf) atomically $ do writeTvar (iBufId buf) newId writeTvar (iBUfSize buf) newSize initialize buf delete buf = do unbind buf GL.deleteObjectname ==< (readTVarIO $ vBufId buf) instance Bindable (IndexBuffer a) where -- bind the buffer bind buf = GL.bindBuffer (target buf) $= Just (glId buf) -- unbind the buffer unbind buf = GL.bindBuffer (target buf) $= Nothing newIndexBuffer :: Word -> IO IndexBuffer -- newly built IndexBuffer data object newIndexBuffer initLength = do -- create the buffer object in applicative style buf <- IndexBuffer -- generate the ID <$> GL.genObjectName -- compute buffer size <*> pure (fromIntegral initLength) -- -- make pointer out of list -- <*> newArray list -- -- get count -- <*> pure (fromIntegral $ length list) -- fill the data in to the buffer initialize buf -- return the data object return buf