Compare commits

...

6 commits

Author SHA1 Message Date
nek0 102ff2ec77 finished episode 31 2020-08-29 22:13:25 +02:00
nek0 4f414f1410 finished episode 30. Episodes in between were either theory or trivial. 2020-08-29 17:15:07 +02:00
nek0 74387cf18b finished episode 27 2020-08-29 10:01:04 +02:00
nek0 8f5ea5531c no need to empty already empty MVars 2020-08-29 07:22:26 +02:00
nek0 9cd2ca9298 updated readme 2020-08-29 07:19:34 +02:00
nek0 8be1acee77 updated readme 2020-08-29 07:18:14 +02:00
14 changed files with 714 additions and 72 deletions

View file

@ -24,9 +24,26 @@ to peruse it.
### Keyboard ### Keyboard
To switch to a scene, press one of the buttons below To switch to a scene, press one of the buttons below, To return to the Menu,
press `Escape`.
## `F1` - Colour changer ## `F1` - Colour changer
Use the keys `1` through `4` to increase the values of R, G, B or A of the Use the keys `1` through `4` to increase the values of R, G, B or A of the
background colour. Press `Left Shift` and the number key to decrease it. background colour. Press `Left Shift` and the number key to decrease it.
## `F2` - Textured quads
Use keys `1` and `2` to switch between the textured quads, move them forward on
the x and y axis by pressing `X` and `Y` respectively or backward using
`Left Shift` and the appropriate key.
## `F3` - Textured quads batched statically
Move the quads forward on
the x and y axis by pressing `X` and `Y` respectively or backward using
`Left Shift` and the appropriate key.
## `F4` - Textured quads batched dynamically
No interaction.

View file

@ -32,9 +32,11 @@ executable renderer-tutorial
, JuicyPixels-extra , JuicyPixels-extra
, StateVar , StateVar
, lens , lens
, clock
other-modules: BindableClass other-modules: BindableClass
, BufferClass , BufferClass
, VertexBuffer , VertexBuffer
, VertexBufferDynamic
, VertexArray , VertexArray
, IndexBuffer , IndexBuffer
, Shader , Shader
@ -44,5 +46,7 @@ executable renderer-tutorial
, Scenes.SceneClass , Scenes.SceneClass
, Scenes.ClearColor , Scenes.ClearColor
, Scenes.Texture2D , Scenes.Texture2D
, Scenes.Texture2DBatched
, Scenes.Texture2DBatchedDynamic
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View file

@ -0,0 +1,16 @@
#version 330 core
layout(location = 0) out vec4 color;
in vec4 v_color;
in vec2 v_texCoord;
in float v_texIndex;
uniform sampler2D u_textures[2];
void main()
{
//vec4 texColor = texture(u_texture, v_texCoord);
int index = int(v_texIndex);
color = texture(u_textures[index], v_texCoord);
}

View file

@ -0,0 +1,20 @@
#version 330 core
layout(location = 0) in vec3 a_position;
layout(location = 1) in vec4 a_color;
layout(location = 2) in vec2 a_texCoord;
layout(location = 3) in float a_texIndex;
out vec4 v_color;
out vec2 v_texCoord;
out float v_texIndex;
uniform mat4 u_mvp;
void main()
{
gl_Position = u_mvp * vec4(a_position, 1);
v_texCoord = a_texCoord;
v_color = a_color;
v_texIndex = a_texIndex;
}

Binary file not shown.

After

Width:  |  Height:  |  Size: 106 KiB

View file

@ -4,7 +4,7 @@ let
inherit (nixpkgs) pkgs; inherit (nixpkgs) pkgs;
f = { mkDerivation, base, bytestring, JuicyPixels f = { mkDerivation, base, bytestring, clock, JuicyPixels
, JuicyPixels-extra, lens, linear, monad-loops, OpenGL, OpenGLRaw , JuicyPixels-extra, lens, linear, monad-loops, OpenGL, OpenGLRaw
, random, sdl2, StateVar, stdenv, vector , random, sdl2, StateVar, stdenv, vector
}: }:
@ -15,7 +15,7 @@ let
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ executableHaskellDepends = [
base bytestring JuicyPixels JuicyPixels-extra lens linear base bytestring clock JuicyPixels JuicyPixels-extra lens linear
monad-loops OpenGL OpenGLRaw random sdl2 StateVar vector monad-loops OpenGL OpenGLRaw random sdl2 StateVar vector
]; ];
license = stdenv.lib.licenses.gpl3; license = stdenv.lib.licenses.gpl3;

View file

@ -31,6 +31,8 @@ import qualified Data.List as L
import System.Random (randomRIO) import System.Random (randomRIO)
import System.Clock
import Linear import Linear
-- internal imports -- internal imports
@ -44,6 +46,8 @@ import EventHandler
import Scenes.SceneClass import Scenes.SceneClass
import Scenes.ClearColor import Scenes.ClearColor
import Scenes.Texture2D import Scenes.Texture2D
import Scenes.Texture2DBatched
import Scenes.Texture2DBatchedDynamic
main :: IO () main :: IO ()
main = do main = do
@ -93,6 +97,9 @@ main = do
-- initial poll for events -- initial poll for events
evs <- newMVar =<< SDL.pollEvents evs <- newMVar =<< SDL.pollEvents
-- time container for dt
time <- newMVar =<< getTime Monotonic
-- Loop running until window closes -- Loop running until window closes
whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window)) whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window))
<$> map SDL.eventPayload <$> readMVar evs) $ do <$> map SDL.eventPayload <$> readMVar evs) $ do
@ -112,10 +119,15 @@ main = do
hasSelect <- not <$> isEmptyMVar curScene hasSelect <- not <$> isEmptyMVar curScene
if hasSelect if hasSelect
then do then do
now <- getTime Monotonic
before <- readMVar time
let dt = fromIntegral
(toNanoSecs $ diffTimeSpec before now) / (10 ^ (9 :: Int))
(Scene sceneObject) <- readMVar curScene (Scene sceneObject) <- readMVar curScene
onEvents sceneObject currentEvents onEvents sceneObject currentEvents
update sceneObject 0 update sceneObject dt
render sceneObject render sceneObject
void $ swapMVar time now
else do else do
GL.clearColor $= GL.Color4 0 0 0 1 GL.clearColor $= GL.Color4 0 0 0 1
GL.clear [GL.ColorBuffer] GL.clear [GL.ColorBuffer]
@ -166,13 +178,19 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
SDL.KeycodeF1 -> do SDL.KeycodeF1 -> do
isEmpty <- isEmptyMVar curScene isEmpty <- isEmptyMVar curScene
when isEmpty $ do when isEmpty $ do
void $ tryTakeMVar curScene
putMVar curScene =<< fmap Scene (initScene @ClearColor) putMVar curScene =<< fmap Scene (initScene @ClearColor)
SDL.KeycodeF2 -> do SDL.KeycodeF2 -> do
isEmpty <- isEmptyMVar curScene isEmpty <- isEmptyMVar curScene
when isEmpty $ do when isEmpty $ do
void $ tryTakeMVar curScene
putMVar curScene =<< fmap Scene (initScene @Texture2D) putMVar curScene =<< fmap Scene (initScene @Texture2D)
SDL.KeycodeF3 -> do
isEmpty <- isEmptyMVar curScene
when isEmpty $ do
putMVar curScene =<< fmap Scene (initScene @Texture2DBatched)
SDL.KeycodeF4 -> do
isEmpty <- isEmptyMVar curScene
when isEmpty $ do
putMVar curScene =<< fmap Scene (initScene @Texture2DBatchedDynamic)
_ -> _ ->
return () return ()
switch _ = return () switch _ = return ()

View file

@ -14,6 +14,8 @@ import Linear
import qualified Control.Lens as Lens import qualified Control.Lens as Lens
import Foreign.Storable (sizeOf)
-- internal imports -- internal imports
import BindableClass import BindableClass
@ -79,10 +81,21 @@ instance SceneClass Texture2D where
-- enable and specify data layout of the in-memory vertices -- enable and specify data layout of the in-memory vertices
layout <- newVertexBufferLayout layout <- newVertexBufferLayout
(fromIntegral $ 5 * sizeOf (undefined :: GL.GLfloat))
-- push vertex positions -- push vertex positions
pushElements layout GL.Float 3 pushElements
layout
0
GL.Float
3
(0 * (sizeOf (undefined :: GL.GLfloat)))
-- pusht texture coordinates -- pusht texture coordinates
pushElements layout GL.Float 2 pushElements
layout
1
GL.Float
2
(3 * (sizeOf (undefined :: GL.GLfloat)))
addBuffer va vbo layout addBuffer va vbo layout
@ -97,10 +110,6 @@ instance SceneClass Texture2D where
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader" [ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
] ]
[ "u_color"
, "u_texture"
, "u_mvp"
]
bind sp bind sp
setUniform sp "u_texture" (texSlot tex) setUniform sp "u_texture" (texSlot tex)

View file

@ -0,0 +1,224 @@
module Scenes.Texture2DBatched where
import SDL (($=), get)
import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL.Functions as GLRaw
import Control.Monad
import Control.Concurrent.MVar
import Linear
import qualified Control.Lens as Lens
import Foreign.Storable (sizeOf)
-- internal imports
import BindableClass
import BufferClass
import VertexArray
import VertexBuffer
import IndexBuffer
import Shader
import Renderer
import Texture
import Scenes.SceneClass
data Texture2DBatched = Texture2DBatched
{ texModels :: MVar (M44 GL.GLfloat)
, texView :: MVar (M44 GL.GLfloat)
, texProj :: MVar (M44 GL.GLfloat)
, texVertArrObj :: GL.VertexArrayObject
, texVertArray :: VertexArray
, texIdxBUfObj :: IndexBuffer GL.GLuint
, texShaderProg :: Shader
}
instance SceneClass Texture2DBatched where
initScene = do
-- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0)
vao <- GL.genObjectName
va <- newVertexArray
GL.bindVertexArrayObject $= Just vao
-- define vertices (positions of the rectangle corners) as List of Floats
-- with added in texture coordinates
let vertexPositions =
-- 3D positions | VertexColor | tex coords | tex indx
[ -67, -100, 0, 0.9, 0.8, 0, 1, 0, 0, 0
, 67, -100, 0, 0.9, 0.8, 0, 1, 1, 0, 0
, 67, 100, 0, 0.9, 0.8, 0, 1, 1, 1, 0
, -67, 100, 0, 0.9, 0.8, 0, 1, 0, 1, 0
, 133, -100, 0, 0, 0.5, 0.9, 1, 0, 0, 1
, 267, -100, 0, 0, 0.5, 0.9, 1, 1, 0, 1
, 267, 100, 0, 0, 0.5, 0.9, 1, 1, 1, 1
, 133, 100, 0, 0, 0.5, 0.9, 1, 0, 1, 1
] :: [GL.GLfloat]
-- create draw order indices
indices = [0, 1, 2, 2, 3, 0, 4, 5, 6, 6, 7, 4] :: [GL.GLuint]
ibo <- newIndexBuffer indices
GL.blend $= GL.Enabled
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-- construct new VertexBuffer and fill it with data
vbo <- newVertexBuffer vertexPositions
-- rebind the vertex buffer
bind vbo
-- enable and specify data layout of the in-memory vertices
layout <- newVertexBufferLayout
(fromIntegral $ 10 * sizeOf (undefined :: GL.GLfloat))
-- push vertex positions
pushElements
layout
0
GL.Float
3
(0 * (sizeOf (undefined :: GL.GLfloat)))
-- push vertex colors
pushElements
layout
1
GL.Float
4
(3 * (sizeOf (undefined :: GL.GLfloat)))
-- pusht texture coordinates
pushElements
layout
2
GL.Float
2
(7 * (sizeOf (undefined :: GL.GLfloat)))
-- pusht texture index
pushElements
layout
3
GL.Float
1
(9 * (sizeOf (undefined :: GL.GLfloat)))
addBuffer va vbo layout
-- -- TEXTURE
-- generate and bind texture
tex1 <- newTexture "res/textures/lynx.jpg" 0
tex2 <- newTexture "res/textures/brainbulb_on.flat.png" 1
bind tex1
bind tex2
-- -- tell the shader where to find the texture
sp <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vertbatch.shader"
, ShaderSource GL.FragmentShader "./res/shaders/fragbatch.shader"
]
bind sp
-- setUniform sp "u_texture" (texSlot tex)
-- unbind everything again
setUniformList sp "u_textures" [0 :: GL.GLint, 1]
unbind va
unbind vbo
unbind ibo
unbind sp
-- store the mtrices for later adjustments
proj <- newMVar mproj
view <- newMVar mview
model <- newMVar mmodel
return $ Texture2DBatched model view proj vao va ibo sp
update _ _ = return ()
onEvents (Texture2DBatched model view proj vao va ibo sp) evs = do
-- modify the mvars based on keystrokes
moveObj proj view model evs
render (Texture2DBatched model view proj vao va ibo sp) = do
-- retrieve matrices from MVars
mproj <- readMVar proj
mview <- readMVar view
GL.clearColor $= GL.Color4 0 0 0 1
clear
mmodel <- readMVar model
bind sp
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
-- the actual drawing happens here
draw va ibo sp
moveObj
:: MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> MVar (M44 GL.GLfloat)
-> [SDL.Event]
-> IO ()
moveObj proj view model evs =
modifyMVar_ proj (\mproj -> do
modifyMVar_ view (\mview -> do
modifyMVar_ model (\mmodel -> do
let plusModel = foldl (\acc ev -> case SDL.eventPayload ev of
(SDL.KeyboardEvent
( SDL.KeyboardEventData
_
SDL.Pressed
_
(SDL.Keysym _ code mod)
))
->
let trans =
mkTransformationMat
(identity :: M33 GL.GLfloat)
( ( if SDL.keyModifierLeftShift mod
then (-1)
else 1
)
*
( case code of
SDL.KeycodeX ->
V3 1 0 0
SDL.KeycodeY ->
V3 0 1 0
_ ->
V3 0 0 0
)
)
!-!
(identity :: M44 GL.GLfloat)
in acc !+! trans
_ -> acc
)
zero
evs
let retval = mmodel !+! plusModel
when (not $ plusModel == zero) $
print ("Current Position of object: " <>
show (Lens.view translation $ retval))
return retval
)
return mview
)
return mproj
)

View file

@ -0,0 +1,180 @@
module Scenes.Texture2DBatchedDynamic where
import SDL (($=), get)
import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GL.Functions as GLRaw
import Control.Monad
import Control.Concurrent.MVar
import Linear
import qualified Control.Lens as Lens
import Foreign
import Foreign.C.Types
import Foreign.Marshal.Array (withArray)
-- internal imports
import BindableClass
import BufferClass
import VertexArray
import VertexBufferDynamic
import IndexBuffer
import Shader
import Renderer
import Texture
import Scenes.SceneClass
data Texture2DBatchedDynamic = Texture2DBatchedDynamic
{ texModels :: MVar (M44 GL.GLfloat)
, texView :: MVar (M44 GL.GLfloat)
, texProj :: MVar (M44 GL.GLfloat)
, texVertArrObj :: GL.VertexArrayObject
, texVertArray :: VertexArray
, texVertBuf :: VertexBufferDynamic
, texIdxBufObj :: IndexBuffer GL.GLuint
, texShaderProg :: Shader
}
instance SceneClass Texture2DBatchedDynamic where
initScene = do
-- -- MATRICES
let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
vao <- GL.genObjectName
va <- newVertexArray
GL.bindVertexArrayObject $= Just vao
-- create draw order indices
let indices = [0, 1, 2, 2, 3, 0, 4, 5, 6, 6, 7, 4] :: [GL.GLuint]
ibo <- newIndexBuffer indices
GL.blend $= GL.Enabled
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-- construct new VertexBuffer and fill it with data
vbo <- newVertexBufferDynamic
-- rebind the vertex buffer
bind vbo
-- enable and specify data layout of the in-memory vertices
layout <- newVertexBufferLayout
(fromIntegral $ 10 * sizeOf (undefined :: GL.GLfloat))
-- push vertex positions
pushElements
layout
0
GL.Float
3
(0 * (sizeOf (undefined :: GL.GLfloat)))
-- push vertex colors
pushElements
layout
1
GL.Float
4
(3 * (sizeOf (undefined :: GL.GLfloat)))
-- pusht texture coordinates
pushElements
layout
2
GL.Float
2
(7 * (sizeOf (undefined :: GL.GLfloat)))
-- pusht texture index
pushElements
layout
3
GL.Float
1
(9 * (sizeOf (undefined :: GL.GLfloat)))
addBuffer va vbo layout
-- -- TEXTURE
-- generate and bind texture
tex1 <- newTexture "res/textures/lynx.jpg" 0
tex2 <- newTexture "res/textures/brainbulb_on.flat.png" 1
bind tex1
bind tex2
-- -- tell the shader where to find the texture
sp <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vertbatch.shader"
, ShaderSource GL.FragmentShader "./res/shaders/fragbatch.shader"
]
bind sp
-- setUniform sp "u_texture" (texSlot tex)
-- unbind everything again
setUniformList sp "u_textures" [0 :: GL.GLint, 1]
setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
unbind va
unbind vbo
unbind ibo
unbind sp
-- store the mtrices for later adjustments
proj <- newMVar mproj
view <- newMVar mview
model <- newMVar mmodel
return $ Texture2DBatchedDynamic model view proj vao va vbo ibo sp
update (Texture2DBatchedDynamic _ _ _ vao _ vbo _ _) dt = do
let vertices = verticesToFloatList $ createQuad (V2 (dt * 500) 500) 0
++ createQuad (V2 500 (dt * 500)) 1
GL.bindVertexArrayObject $= Just vao
bind vbo
withArray vertices $ \ptr ->
GL.bufferSubData
(target vbo) -- ^ The target buffer
GL.WriteToBuffer -- ^ transfer direction
(CPtrdiff 0) -- ^ Offset of the written data in the buffer
(CPtrdiff (fromIntegral $ length vertices * sizeOf (undefined :: GL.GLfloat)))
-- ^ The size of the written data
ptr -- ^ Pointer to data
onEvents _ _ =
return ()
render (Texture2DBatchedDynamic model view proj vao va _ ibo sp) = do
-- retrieve matrices from MVars
GL.clearColor $= GL.Color4 0 0 0 1
clear
-- the actual drawing happens here
draw va ibo sp
createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
createQuad pos@(V2 x y) index =
[ newVertex (V3 (x - 67) (y - 100) 0) (V4 0 0 0 1) (V2 0 0) (fromIntegral index)
, newVertex (V3 (x + 67) (y - 100) 0) (V4 0 0 0 1) (V2 1 0) (fromIntegral index)
, newVertex (V3 (x + 67) (y + 100) 0) (V4 0 0 0 1) (V2 1 1) (fromIntegral index)
, newVertex (V3 (x - 67) (y + 100) 0) (V4 0 0 0 1) (V2 0 1) (fromIntegral index)
]
verticesToFloatList :: [Vertex] -> [GL.GLfloat]
verticesToFloatList [] = []
verticesToFloatList ((Vertex (V3 x y z) (V4 r g b a) (V2 u v) idx _):verts) =
[x, y, z, r, g, b, a, u, v, idx] ++ verticesToFloatList verts

View file

@ -16,9 +16,13 @@ import qualified Data.ByteString as B
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Control.Concurrent.MVar
import Linear import Linear
import Foreign.Marshal.Utils (with) import Foreign.Marshal.Utils (with)
import Foreign.Marshal.Array (withArray)
import Foreign.Storable
import Foreign.Ptr import Foreign.Ptr
-- internal imports -- internal imports
@ -28,7 +32,7 @@ import BindableClass
data Shader = Shader data Shader = Shader
{ shaderId :: GL.Program { shaderId :: GL.Program
, shaderSources :: [ShaderSource] , shaderSources :: [ShaderSource]
, shaderUniforms :: [ShaderUniform] , shaderUniforms :: MVar [ShaderUniform]
} }
-- make Shader Bindable -- make Shader Bindable
@ -75,8 +79,8 @@ isRowMajor :: GL.MatrixOrder -> GL.GLboolean
isRowMajor p = if (GL.RowMajor == p) then 1 else 0 isRowMajor p = if (GL.RowMajor == p) then 1 else 0
-- create new data object of type Shader -- create new data object of type Shader
newShader :: [ShaderSource] -> [String] -> IO Shader newShader :: [ShaderSource] -> IO Shader
newShader shaderSrc uniforms = do newShader shaderSrc = do
-- create program Object -- create program Object
program <- GL.createProgram program <- GL.createProgram
@ -110,27 +114,70 @@ newShader shaderSrc uniforms = do
-- throw away the shaders, since they are linked into the shader program -- throw away the shaders, since they are linked into the shader program
mapM_ (\s -> GL.deleteObjectName s) (map snd compilates) mapM_ (\s -> GL.deleteObjectName s) (map snd compilates)
-- retrieve locations of all uniforms and store them
uniLocs <- mapM
(\name -> do
loc <- get $ GL.uniformLocation program name
return (ShaderUniform name loc)
)
uniforms
-- return data object -- return data object
return (Shader program shaderSrc uniLocs) Shader program shaderSrc <$> newMVar []
-- pass uniform values into Shader program -- pass uniform values into Shader program
setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO () setUniformList :: (Storable a, GL.Uniform a) => Shader -> String -> [a] -> IO ()
setUniform shader uniname data_ = do setUniformList (Shader shaderProgram _ shaderUniforms) uniname data_ = do
-- retrieve uniform location -- check if uniform location is already cached
let [ShaderUniform _ loc] = filter locs <- readMVar shaderUniforms
(\(ShaderUniform name _) -> name == uniname)
(shaderUniforms shader)
-- set the data -- retrieve uniform location
GL.uniform loc $= data_ let unilocs = filter
(\(ShaderUniform name _) -> name == uniname)
locs
case unilocs of
[] -> do
print ("Unknown uniform: " <> uniname)
print "Retrieving uniform location from shader program"
loc@(GL.UniformLocation locNum) <- get $ GL.uniformLocation shaderProgram uniname
if locNum < 0
then
print ("Uniform does not exist in shader program: " <> uniname)
else do
-- set the data
withArray data_ $ \ptr ->
GL.uniformv loc (fromIntegral $ length data_) ptr
--GL.uniform loc $= data_
-- add uniform to cache
modifyMVar_ shaderUniforms
(\list -> return $ ShaderUniform uniname loc : list)
[ShaderUniform _ loc] ->
-- set the data
withArray data_ $ \ptr ->
GL.uniformv loc (fromIntegral $ length data_) ptr
setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO ()
setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
-- check if uniform location is already cached
locs <- readMVar shaderUniforms
-- retrieve uniform location
let unilocs = filter
(\(ShaderUniform name _) -> name == uniname)
locs
case unilocs of
[] -> do
print ("Unknown uniform: " <> uniname)
print "Retrieving uniform location from shader program"
loc@(GL.UniformLocation locNum) <- get $ GL.uniformLocation shaderProgram uniname
if locNum < 0
then
print ("Uniform does not exist in shader program: " <> uniname)
else do
-- set the data
--withArray data_ $ \ptr ->
-- GL.uniformv loc (length data_) ptr
GL.uniform loc $= data_
-- add uniform to cache
modifyMVar_ shaderUniforms
(\list -> return $ ShaderUniform uniname loc : list)
[ShaderUniform _ loc] ->
-- set the data
GL.uniform loc $= data_
-- | compile a shader from source -- | compile a shader from source
compileShaderSource compileShaderSource

View file

@ -23,10 +23,10 @@ import BindableClass
data Texture = Texture data Texture = Texture
{ texId :: GL.TextureObject { texId :: GL.TextureObject
, texSlot :: GL.TextureUnit , texSlot :: GL.TextureUnit
, texPath :: FilePath -- , texPath :: FilePath
, texDimensions :: V2 GL.GLsizei -- , texDimensions :: V2 GL.GLsizei
, texBPP :: Int -- , texBPP :: Int
, texData :: Ptr () -- , texData :: Ptr ()
} }
instance Bindable Texture where instance Bindable Texture where
@ -51,10 +51,10 @@ newTexture fp slot = do
tex <- Texture tex <- Texture
<$> GL.genObjectName <$> GL.genObjectName
<*> (pure $ GL.TextureUnit slot) <*> (pure $ GL.TextureUnit slot)
<*> (pure fp) -- <*> (pure fp)
<*> (pure $ fmap fromIntegral $ V2 (imageWidth img) (imageHeight img)) let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img)
<*> (pure $ componentCount (VS.head $ imageData img)) -- <*> (pure $ componentCount (VS.head $ imageData img))
<*> (pure $ castPtr ptr) data_ = castPtr ptr
-- bind texture -- bind texture
bind tex bind tex
@ -65,7 +65,7 @@ newTexture fp slot = do
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
-- put data into GPU memory -- put data into GPU memory
loadTexture tex loadTexture tex dimensions data_
-- unbind texture -- unbind texture
unbind tex unbind tex
@ -76,9 +76,9 @@ newTexture fp slot = do
-- pass texture object out -- pass texture object out
return tex return tex
loadTexture :: Texture -> IO () loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
loadTexture tex = loadTexture tex dimensions data_ =
let (V2 w h) = texDimensions tex let (V2 w h) = dimensions
in GL.texImage2D in GL.texImage2D
GL.Texture2D GL.Texture2D
GL.NoProxy GL.NoProxy
@ -86,4 +86,4 @@ loadTexture tex =
GL.RGBA' GL.RGBA'
(GL.TextureSize2D w h) (GL.TextureSize2D w h)
0 0
(GL.PixelData GL.RGBA GL.UnsignedByte (texData tex)) (GL.PixelData GL.RGBA GL.UnsignedByte data_)

View file

@ -42,8 +42,9 @@ newVertexArray = VertexArray
<$> GL.genObjectName <$> GL.genObjectName
addBuffer addBuffer
:: VertexArray :: (Buffer buf)
-> VertexBuffer a => VertexArray
-> buf
-> VertexBufferLayout -> VertexBufferLayout
-> IO () -> IO ()
addBuffer va vb layout = do addBuffer va vb layout = do
@ -52,51 +53,64 @@ addBuffer va vb layout = do
bind vb bind vb
-- enable and fill out the vertex attrib pointer(s) -- enable and fill out the vertex attrib pointer(s)
list <- readMVar (vblElements layout) list <- readMVar (vblElements layout)
let indexed = zip [0 ..] list let dataElementSize e = case e of
dataElementSize e = case e of
GL.Float -> sizeOf (undefined :: GL.GLfloat) GL.Float -> sizeOf (undefined :: GL.GLfloat)
x -> error ("No size computation implemented fof: " <> show x) x -> error ("No size computation implemented fof: " <> show x)
mapM_ mapM_
(\(index, elem) -> do (\(VertexBufferLayoutElement index type_ count offset handling) -> do
let offset = fromIntegral $ GL.vertexAttribArray (GL.AttribLocation index) $=
foldl
(\acc (index, elem) -> acc + vbleCount elem)
0
(filter ((< index) . fst) indexed) :: Int
GL.vertexAttribArray (GL.AttribLocation $ fromIntegral index) $=
GL.Enabled GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation $ fromIntegral index) $= GL.vertexAttribPointer (GL.AttribLocation index) $=
( vbleHandling elem ( handling
, GL.VertexArrayDescriptor , GL.VertexArrayDescriptor
-- number of components to our attribute -- number of components to our attribute
(vbleCount elem) count
-- datatype of elements -- datatype of elements
(vbleType elem) type_
-- ??? -- Stride (How big is one Vertex in bytes)
(sum (map vbleCount list) * fromIntegral (dataElementSize (vbleType elem))) (vblStride layout)
-- offset from beginnning of vertex -- offset from beginnning of vertex in bytes
(plusPtr nullPtr (offset * dataElementSize (vbleType elem))) (plusPtr nullPtr offset)
) )
) )
indexed list
unbind va unbind va
unbind vb unbind vb
newtype VertexBufferLayout = VertexBufferLayout data VertexBufferLayout = VertexBufferLayout
{ vblElements :: MVar [VertexBufferLayoutElement] { vblElements :: MVar [VertexBufferLayoutElement]
, vblStride :: GL.GLsizei
} }
data VertexBufferLayoutElement = VertexBufferLayoutElement data VertexBufferLayoutElement = VertexBufferLayoutElement
{ vbleType :: GL.DataType { vbleIndex :: GL.GLuint
, vbleType :: GL.DataType
, vbleCount :: GL.GLint , vbleCount :: GL.GLint
, vbleOffset :: Int
, vbleHandling :: GL.IntegerHandling , vbleHandling :: GL.IntegerHandling
} }
newVertexBufferLayout :: IO VertexBufferLayout newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout
newVertexBufferLayout = VertexBufferLayout newVertexBufferLayout stride = VertexBufferLayout
<$> newMVar [] <$> newMVar []
<*> pure stride
pushElements :: VertexBufferLayout -> GL.DataType -> GL.GLint -> IO () pushElements
pushElements vbl type_ count = do :: VertexBufferLayout
-> GL.GLuint
-> GL.DataType
-> GL.GLint
-> Int
-> IO ()
pushElements vbl index type_ count offset = do
modifyMVar_ (vblElements vbl) $ \list -> modifyMVar_ (vblElements vbl) $ \list ->
return (list ++ [VertexBufferLayoutElement type_ count GL.ToNormalizedFloat]) return
(list ++
[VertexBufferLayoutElement
index
type_
count
offset
GL.ToNormalizedFloat
]
)

View file

@ -0,0 +1,93 @@
{-# LANGUAGE TypeFamilies #-}
module VertexBufferDynamic where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Linear
import Foreign
import Foreign.C.Types
-- internal imports
import BindableClass
import BufferClass
-- layout of the VertexBuffer data object
data VertexBufferDynamic = VertexBufferDynamic
{ vBufId :: GL.BufferObject -- buffer id
, vBufSize :: GL.GLsizeiptr -- size of data
-- , vBufData :: Ptr a -- pointer to data
}
data Vertex = Vertex
{ vertPosition :: V3 GL.GLfloat
, vertColor :: V4 GL.GLfloat
, vertTexCoord :: V2 GL.GLfloat
, vertTexID :: GL.GLfloat
, vertSize :: GL.GLsizei
}
-- | Smart constructor for a new Vertex
newVertex
:: V3 GL.GLfloat
-> V4 GL.GLfloat
-> V2 GL.GLfloat
-> GL.GLfloat
-> Vertex
newVertex pos color texcoord index =
Vertex
pos
color
texcoord
index
(fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat)))
-- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer VertexBufferDynamic where
type ObjName VertexBufferDynamic = GL.BufferObject
target _ = GL.ArrayBuffer
glId = vBufId
initialize buf = do
-- bind the buffer using the default iplementation of the typeclass
bind buf
-- fill in the data
GL.bufferData (target buf) $=
( vBufSize buf
, nullPtr
, GL.DynamicDraw
)
-- release the buffer using the default implementation of the typeclass
unbind buf
instance Bindable VertexBufferDynamic where
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing
newVertexBufferDynamic
:: IO VertexBufferDynamic -- newly built VertexBuffer data object
newVertexBufferDynamic = do
let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0
-- create the buffer object in applicative style
buf <- VertexBufferDynamic
-- generate the ID
<$> GL.genObjectName
-- compute buffer size
<*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex))
-- make pointer out of list
-- <*> newArray list
-- fill the data in to the buffer
initialize buf
-- return the data object
return buf