renderer-tutorial/src/IndexBuffer.hs

71 lines
1.8 KiB
Haskell

{-# LANGUAGE TypeFamilies #-}
module IndexBuffer where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Foreign
-- internal imports
import BindableClass
import BufferClass
-- layout of the IndexBuffer data object
data IndexBuffer a = IndexBuffer
{ iBufId :: GL.BufferObject -- buffer id
, iBufSize :: GL.GLsizeiptr -- size of data
, iBufData :: Ptr a -- pointer to data
, iBufCount :: GL.GLint -- number of data elements
}
-- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer (IndexBuffer a) where
type ObjName (IndexBuffer a) = GL.BufferObject
target _ = GL.ElementArrayBuffer
glId = 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
, iBufData buf
, GL.StaticDraw
)
-- release the buffer using the default implementation of the typeclass
unbind 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 ::
(Storable a) => -- we have to be able to get a pointer to provided data
[a] -> -- list of data elements
IO (IndexBuffer a) -- newly built IndexBuffer data object
newIndexBuffer list = do
-- create the buffer object in applicative style
buf <- IndexBuffer
-- generate the ID
<$> GL.genObjectName
-- compute buffer size
<*> pure (fromIntegral (length list * sizeOf (head list)))
-- 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