finished episode14

This commit is contained in:
nek0 2020-05-20 05:54:14 +02:00
parent 3046622519
commit 2db17d3fd6
4 changed files with 46 additions and 18 deletions

View file

@ -1,3 +1,4 @@
{-# LANGUAGE TypeFamilies #-}
module BufferClass where module BufferClass where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -9,19 +10,21 @@ import SDL (($=), get)
-- 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 Buffer a where
type ObjName a :: *
-- what buffer target does te buffer bind to -- what buffer target does te buffer bind to
target :: a -> GL.BufferTarget target :: a -> GL.BufferTarget
-- what ID does the buffer have -- what ID does the buffer have
glId :: a -> GL.BufferObject glId :: a -> ObjName a
-- 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 the buffer
bind :: a -> IO () bind :: a -> IO ()
bind buf = GL.bindBuffer (target buf) $= Just (glId buf) -- bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer -- unbind the buffer
unbind :: a -> IO () unbind :: a -> IO ()
unbind buf = GL.bindBuffer (target buf) $= Nothing -- unbind buf = GL.bindBuffer (target buf) $= Nothing

View file

@ -1,3 +1,4 @@
{-# LANGUAGE TypeFamilies #-}
module IndexBuffer where module IndexBuffer where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -21,6 +22,8 @@ data IndexBuffer a = IndexBuffer
-- instanciate typeclass from BufferClass and fill in missing implementations -- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer (IndexBuffer a) where instance Buffer (IndexBuffer a) where
type ObjName (IndexBuffer a) = GL.BufferObject
target _ = GL.ElementArrayBuffer target _ = GL.ElementArrayBuffer
glId = iBufId glId = iBufId
@ -37,6 +40,12 @@ 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
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing
newIndexBuffer :: newIndexBuffer ::
(Storable a) => -- we have to be able to get a pointer to provided data (Storable a) => -- we have to be able to get a pointer to provided data
[a] -> -- list of data elements [a] -> -- list of data elements

View file

@ -32,6 +32,7 @@ import System.Random (randomRIO)
-- internal imports -- internal imports
import BufferClass import BufferClass
import VertexArray
import VertexBuffer import VertexBuffer
import IndexBuffer import IndexBuffer
@ -88,25 +89,31 @@ main = do
indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint] indices = [0, 1, 2, 2, 3, 0] :: [GL.GLuint]
-- construct new VertexBuffer and fill it with data -- construct new VertexBuffer and fill it with data
vao <- newVertexArray
vbo <- newVertexBuffer vertexPositions vbo <- newVertexBuffer vertexPositions
-- rebind the vertex buffer -- rebind the vertex buffer
bind vbo bind vbo
-- enable and specify data layout of the in-memory vertices -- enable and specify data layout of the in-memory vertices
GL.vertexAttribPointer (GL.AttribLocation 0) $= layout <- newVertexBufferLayout
( GL.ToFloat pushElements layout GL.Float 2
, GL.VertexArrayDescriptor
-- There are 2 components (Floats) to our attribute addBuffer vao vbo layout
2
-- They are Floats -- GL.vertexAttribPointer (GL.AttribLocation 0) $=
GL.Float -- ( GL.ToFloat
-- ??? -- , GL.VertexArrayDescriptor
0 -- -- There are 2 components (Floats) to our attribute
-- our attribute is directly at the beginning of each vertex -- 2
(plusPtr nullPtr 0) -- -- They are Floats
) -- GL.Float
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled -- -- ???
-- 0
-- -- our attribute is directly at the beginning of each vertex
-- (plusPtr nullPtr 0)
-- )
-- GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
-- construct new IndexBuffer and fill it with data -- construct new IndexBuffer and fill it with data
ibo <- newIndexBuffer indices ibo <- newIndexBuffer indices
@ -166,7 +173,7 @@ main = do
GL.clear [GL.ColorBuffer] GL.clear [GL.ColorBuffer]
-- rebind everything neccessary for draw call -- rebind everything neccessary for draw call
GL.bindVertexArrayObject $= Just vao bind vao
-- (note the missing bindings to the vertex buffer and the attrib pointer) -- (note the missing bindings to the vertex buffer and the attrib pointer)
bind ibo bind ibo
GL.currentProgram $= Just sp GL.currentProgram $= Just sp

View file

@ -1,3 +1,4 @@
{-# LANGUAGE TypeFamilies #-}
module VertexBuffer where module VertexBuffer where
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
@ -20,6 +21,8 @@ data VertexBuffer a = VertexBuffer
-- instanciate typeclass from BufferClass and fill in missing implementations -- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer (VertexBuffer a) where instance Buffer (VertexBuffer a) where
type ObjName (VertexBuffer a) = GL.BufferObject
target _ = GL.ArrayBuffer target _ = GL.ArrayBuffer
glId = vBufId glId = vBufId
@ -36,6 +39,12 @@ 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
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing
newVertexBuffer :: newVertexBuffer ::
(Storable a) => -- we have to be able to get a pointer to provided data (Storable a) => -- we have to be able to get a pointer to provided data
[a] -> -- list of data elements [a] -> -- list of data elements