pituicat/src/Types/Graphics/IndexBuffer.hs

126 lines
3.2 KiB
Haskell

{-# 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