pituicat/src/Types/Graphics/VertexBuffer.hs

94 lines
2.2 KiB
Haskell
Raw Normal View History

2020-10-17 14:18:42 +00:00
{-# LANGUAGE TypeFamilies #-}
module Types.Graphics.VertexBuffer where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Linear
import Foreign
import Foreign.C.Types
-- internal imports
import Classes.Graphics.Bindable
import Classes.Graphics.Buffer
-- layout of the VertexBuffer data object
data VertexBuffer = VertexBuffer
{ vBufId :: GL.BufferObject -- buffer id
, vBufSize :: 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
}
-- | 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 from BufferClass and fill in missing implementations
instance Buffer VertexBuffer where
type ObjName VertexBuffer = GL.BufferObject
target _ = GL.ArrayBuffer
glId = vBufId
initialize buf = do
-- bind the buffer using the default iplementation of the typeclass
bind buf
-- fill in the data
GL.bufferData (target buf) $=
( vBufSize buf
, nullPtr
, GL.DynamicDraw
)
-- release the buffer using the default implementation of the typeclass
unbind buf
instance Bindable VertexBuffer where
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing
newVertexBuffer
:: IO VertexBuffer -- newly built VertexBuffer data object
newVertexBuffer = 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
<$> GL.genObjectName
-- compute buffer size
<*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex))
-- make pointer out of list
-- <*> newArray list
-- fill the data in to the buffer
initialize buf
-- return the data object
return buf