pituicat/src/Types/Graphics/VertexBuffer.hs

138 lines
3.7 KiB
Haskell

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