{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} module Graphics.Types.IndexBuffer where import Affection import qualified Graphics.Rendering.OpenGL as GL import SDL (($=)) import Data.String (fromString) import qualified Data.Vector.Storable as VS import Control.Monad (when) import Control.Monad.Loops (whileM_) import Control.Concurrent.STM import Foreign import Foreign.C.Types -- internal imports import Graphics.Classes.Bindable import Graphics.Classes.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 :: TVar 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 size <- readTVarIO $ iBufSize 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 whileM_ (do currentSize <- readTVarIO (iBufSize buf) pure $ (fromIntegral offset + VS.length dat) * sizeOf (undefined :: StoreType IndexBuffer) > fromIntegral currentSize) $ do currentBufSize <- readTVarIO (iBufSize buf) allocaArray (fromIntegral currentBufSize `div` sizeOf (undefined :: StoreType IndexBuffer)) $ \ (ptr :: Ptr (StoreType IndexBuffer)) -> do bind buf 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 let elemCount = fromIntegral offset + VS.length dat logIO Verbose ("elemCount: " <> (fromString $ show elemCount)) currentCount <- atomically $ readTVar (iBufCount buf) when (fromIntegral elemCount > currentCount) $ atomically $ writeTVar (iBufCount buf) (fromIntegral elemCount) VS.unsafeWith dat $ \ ptr -> GL.bufferSubData (target buf) GL.WriteToBuffer (CPtrdiff $ fromIntegral offset * fromIntegral (sizeOf (undefined :: StoreType IndexBuffer))) (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 $ iBufId buf) instance Bindable IndexBuffer 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 newIndexBuffer :: Word -> IO IndexBuffer -- newly built IndexBuffer data object newIndexBuffer initLength = do -- create the buffer object in applicative style buf <- IndexBuffer -- generate the ID <$> (newTVarIO =<< GL.genObjectName) -- compute buffer size <*> newTVarIO (CPtrdiff (fromIntegral $ (fromIntegral initLength * sizeOf (undefined :: StoreType IndexBuffer)))) -- -- make pointer out of list -- <*> newArray list -- -- get count <*> newTVarIO 0 -- fill the data in to the buffer initialize buf -- return the data object return buf