renderer-tutorial/src/VertexArray.hs

117 lines
2.6 KiB
Haskell
Raw Normal View History

2020-05-20 04:10:14 +00:00
{-# LANGUAGE TypeFamilies #-}
module VertexArray where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Foreign
import Control.Concurrent.MVar
-- internal imports
2020-05-21 16:17:38 +00:00
import BindableClass
2020-05-20 04:10:14 +00:00
import BufferClass
import VertexBuffer
data VertexArray = VertexArray
{ vArrId :: GL.VertexArrayObject
}
deriving (Eq, Show)
instance Buffer VertexArray where
type ObjName VertexArray = GL.VertexArrayObject
target _ = undefined
glId = vArrId
initialize va = return ()
2020-05-21 16:17:38 +00:00
instance Bindable VertexArray where
2020-05-20 04:10:14 +00:00
bind va = GL.bindVertexArrayObject $= Just (vArrId va)
unbind va = GL.bindVertexArrayObject $= Nothing
newVertexArray :: IO VertexArray
newVertexArray = VertexArray
<$> GL.genObjectName
addBuffer
2020-08-29 20:13:25 +00:00
:: (Buffer buf)
=> VertexArray
-> buf
2020-05-20 04:10:14 +00:00
-> VertexBufferLayout
-> IO ()
addBuffer va vb layout = do
-- bind the provided vertex buffer
bind va
bind vb
-- enable and fill out the vertex attrib pointer(s)
list <- readMVar (vblElements layout)
let dataElementSize e = case e of
2020-05-20 04:10:14 +00:00
GL.Float -> sizeOf (undefined :: GL.GLfloat)
x -> error ("No size computation implemented fof: " <> show x)
mapM_
(\(VertexBufferLayoutElement index type_ count offset handling) -> do
GL.vertexAttribArray (GL.AttribLocation index) $=
2020-05-22 14:16:06 +00:00
GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation index) $=
( handling
2020-05-20 04:10:14 +00:00
, GL.VertexArrayDescriptor
-- number of components to our attribute
count
2020-05-20 04:10:14 +00:00
-- datatype of elements
type_
-- Stride (How big is one Vertex in bytes)
(vblStride layout)
-- offset from beginnning of vertex in bytes
(plusPtr nullPtr offset)
2020-05-20 04:10:14 +00:00
)
)
list
2020-05-20 04:10:14 +00:00
unbind va
unbind vb
data VertexBufferLayout = VertexBufferLayout
2020-05-20 04:10:14 +00:00
{ vblElements :: MVar [VertexBufferLayoutElement]
, vblStride :: GL.GLsizei
2020-05-20 04:10:14 +00:00
}
data VertexBufferLayoutElement = VertexBufferLayoutElement
{ vbleIndex :: GL.GLuint
, vbleType :: GL.DataType
2020-05-20 04:10:14 +00:00
, vbleCount :: GL.GLint
, vbleOffset :: Int
2020-05-20 04:10:14 +00:00
, vbleHandling :: GL.IntegerHandling
}
newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout
newVertexBufferLayout stride = VertexBufferLayout
2020-05-20 04:10:14 +00:00
<$> newMVar []
<*> pure stride
pushElements
:: VertexBufferLayout
-> GL.GLuint
-> GL.DataType
-> GL.GLint
-> Int
-> IO ()
pushElements vbl index type_ count offset = do
2020-05-20 04:10:14 +00:00
modifyMVar_ (vblElements vbl) $ \list ->
return
(list ++
[VertexBufferLayoutElement
index
type_
count
offset
GL.ToNormalizedFloat
]
)