Compare commits
2 commits
Author | SHA1 | Date | |
---|---|---|---|
nek0 | 102ff2ec77 | ||
nek0 | 4f414f1410 |
10
README.md
10
README.md
|
@ -37,3 +37,13 @@ background colour. Press `Left Shift` and the number key to decrease it.
|
||||||
Use keys `1` and `2` to switch between the textured quads, move them forward on
|
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
|
the x and y axis by pressing `X` and `Y` respectively or backward using
|
||||||
`Left Shift` and the appropriate key.
|
`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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
16
res/shaders/fragbatch.shader
Normal file
16
res/shaders/fragbatch.shader
Normal 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);
|
||||||
|
}
|
20
res/shaders/vertbatch.shader
Normal file
20
res/shaders/vertbatch.shader
Normal 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;
|
||||||
|
}
|
BIN
res/textures/brainbulb_on.flat.png
Normal file
BIN
res/textures/brainbulb_on.flat.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 106 KiB |
|
@ -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;
|
||||||
|
|
22
src/Main.hs
22
src/Main.hs
|
@ -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]
|
||||||
|
@ -171,6 +183,14 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
|
||||||
isEmpty <- isEmptyMVar curScene
|
isEmpty <- isEmptyMVar curScene
|
||||||
when isEmpty $ do
|
when isEmpty $ do
|
||||||
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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
224
src/Scenes/Texture2DBatched.hs
Normal file
224
src/Scenes/Texture2DBatched.hs
Normal 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
|
||||||
|
)
|
180
src/Scenes/Texture2DBatchedDynamic.hs
Normal file
180
src/Scenes/Texture2DBatchedDynamic.hs
Normal 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
|
|
@ -21,6 +21,8 @@ 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
|
||||||
|
@ -116,6 +118,37 @@ newShader shaderSrc = do
|
||||||
Shader program shaderSrc <$> newMVar []
|
Shader program shaderSrc <$> newMVar []
|
||||||
|
|
||||||
-- pass uniform values into Shader program
|
-- pass uniform values into Shader program
|
||||||
|
setUniformList :: (Storable a, GL.Uniform a) => Shader -> String -> [a] -> IO ()
|
||||||
|
setUniformList (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 (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 :: (GL.Uniform a) => Shader -> String -> a -> IO ()
|
||||||
setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
|
setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
|
||||||
-- check if uniform location is already cached
|
-- check if uniform location is already cached
|
||||||
|
@ -136,6 +169,8 @@ setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
|
||||||
print ("Uniform does not exist in shader program: " <> uniname)
|
print ("Uniform does not exist in shader program: " <> uniname)
|
||||||
else do
|
else do
|
||||||
-- set the data
|
-- set the data
|
||||||
|
--withArray data_ $ \ptr ->
|
||||||
|
-- GL.uniformv loc (length data_) ptr
|
||||||
GL.uniform loc $= data_
|
GL.uniform loc $= data_
|
||||||
-- add uniform to cache
|
-- add uniform to cache
|
||||||
modifyMVar_ shaderUniforms
|
modifyMVar_ shaderUniforms
|
||||||
|
|
|
@ -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_)
|
||||||
|
|
|
@ -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
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
93
src/VertexBufferDynamic.hs
Normal file
93
src/VertexBufferDynamic.hs
Normal 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
|
Loading…
Reference in a new issue