pituicat/src/Types/Graphics/VertexArray.hs

75 lines
1.7 KiB
Haskell
Raw Normal View History

2020-10-17 14:18:42 +00:00
{-# LANGUAGE TypeFamilies #-}
module Types.Graphics.VertexArray where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
2020-12-05 09:10:37 +00:00
import qualified Data.Vector as V
2020-10-17 14:18:42 +00:00
2020-12-05 09:10:37 +00:00
import Foreign (sizeOf)
import Foreign.Ptr
import Control.Concurrent.STM
import Control.Monad (void)
2020-10-17 14:18:42 +00:00
-- internal imports
import Classes.Graphics.Bindable
import Classes.Graphics.Buffer
2020-12-05 09:10:37 +00:00
import Classes.Graphics.VertexLayout
2020-10-17 14:18:42 +00:00
import Types.Graphics.VertexBuffer
2020-12-05 09:10:37 +00:00
newtype VertexArray = VertexArray
2020-10-17 14:18:42 +00:00
{ vArrId :: GL.VertexArrayObject
}
deriving (Eq, Show)
instance Bindable VertexArray where
bind va = GL.bindVertexArrayObject $= Just (vArrId va)
unbind va = GL.bindVertexArrayObject $= Nothing
newVertexArray :: IO VertexArray
newVertexArray = VertexArray
<$> GL.genObjectName
2020-12-05 09:10:37 +00:00
instance VertexLayout Vertex where
2020-10-17 14:18:42 +00:00
2020-12-05 09:10:37 +00:00
type VertArray Vertex = VertexArray
2020-10-17 14:18:42 +00:00
2020-12-05 09:10:37 +00:00
layoutElements vert =
foldr
(\a@(index, count) acc ->
( index
, GL.VertexArrayDescriptor
2020-10-17 14:18:42 +00:00
count
2020-12-05 09:10:37 +00:00
GL.Float
(fromIntegral $ sizeOf (undefined :: Vertex))
(nullPtr `plusPtr` (sizeOf (undefined :: GL.GLfloat) * fromIntegral
(sum (map ((\(GL.VertexArrayDescriptor c _ _ _) -> c) . snd) acc))))
) : acc
)
[]
(zip [0 ..] [3, 4, 2, 1])
addBuffer vert va vb = do
-- bind vertex array and vertex buffer ot associate them
bind va
bind vb
-- enable and fill vertex attrib pointer(s)
let list = layoutElements vert
mapM_
(\(index, descriptor) -> do
GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation index) $=
( GL.ToNormalizedFloat
, descriptor
)
2020-10-17 14:18:42 +00:00
)
2020-12-05 09:10:37 +00:00
list
unbind va
unbind vb