abstract bindable stuff as typeclass

This commit is contained in:
nek0 2020-05-21 18:17:38 +02:00
parent a0f9ffcc6e
commit c2014e41c5
7 changed files with 30 additions and 10 deletions

View file

@ -26,8 +26,10 @@ executable renderer-tutorial
, bytestring , bytestring
, monad-loops , monad-loops
, random , random
other-modules: BufferClass other-modules: BindableClass
, BufferClass
, VertexBuffer , VertexBuffer
, VertexArray
, IndexBuffer , IndexBuffer
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

10
src/BindableClass.hs Normal file
View file

@ -0,0 +1,10 @@
module BindableClass where
-- | typeclass for bindabl eobjects like buffers, vertex arrays or shaders
class Bindable a where
-- bind the object in context
bind :: a -> IO ()
-- release object from context
unbind :: a -> IO ()

View file

@ -5,10 +5,14 @@ import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get) import SDL (($=), get)
-- internal imports
import BindableClass
-- this aims to be a typeclass for all used buffer objects throughout the -- this aims to be a typeclass for all used buffer objects throughout the
-- tutorial. -- tutorial.
-- think of it as some kind of interface in the object oriented context -- think of it as some kind of interface in the object oriented context
class Buffer a where class (Bindable a) => Buffer a where
type ObjName a :: * type ObjName a :: *
@ -20,11 +24,3 @@ class Buffer a where
-- bind the buffer object and fill it with data -- bind the buffer object and fill it with data
initialize :: a -> IO () initialize :: a -> IO ()
-- bind the buffer
bind :: a -> IO ()
-- bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind :: a -> IO ()
-- unbind buf = GL.bindBuffer (target buf) $= Nothing

View file

@ -9,6 +9,7 @@ import Foreign
-- internal imports -- internal imports
import BindableClass
import BufferClass import BufferClass
-- layout of the IndexBuffer data object -- layout of the IndexBuffer data object
@ -40,6 +41,8 @@ instance Buffer (IndexBuffer a) where
-- release the buffer using the default implementation of the typeclass -- release the buffer using the default implementation of the typeclass
unbind buf unbind buf
instance Bindable (IndexBuffer a) where
-- bind the buffer -- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf) bind buf = GL.bindBuffer (target buf) $= Just (glId buf)

View file

@ -31,6 +31,7 @@ import System.Random (randomRIO)
-- internal imports -- internal imports
import BindableClass
import BufferClass import BufferClass
import VertexArray import VertexArray
import VertexBuffer import VertexBuffer

View file

@ -11,6 +11,7 @@ import Control.Concurrent.MVar
-- internal imports -- internal imports
import BindableClass
import BufferClass import BufferClass
import VertexBuffer import VertexBuffer
@ -29,6 +30,9 @@ instance Buffer VertexArray where
initialize va = return () initialize va = return ()
instance Bindable VertexArray where
bind va = GL.bindVertexArrayObject $= Just (vArrId va) bind va = GL.bindVertexArrayObject $= Just (vArrId va)
unbind va = GL.bindVertexArrayObject $= Nothing unbind va = GL.bindVertexArrayObject $= Nothing

View file

@ -9,6 +9,7 @@ import Foreign
-- internal imports -- internal imports
import BindableClass
import BufferClass import BufferClass
-- layout of the VertexBuffer data object -- layout of the VertexBuffer data object
@ -39,6 +40,9 @@ instance Buffer (VertexBuffer a) where
-- release the buffer using the default implementation of the typeclass -- release the buffer using the default implementation of the typeclass
unbind buf unbind buf
instance Bindable (VertexBuffer a) where
-- bind the buffer -- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf) bind buf = GL.bindBuffer (target buf) $= Just (glId buf)