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
|
||||
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.
|
||||
|
|
|
@ -32,9 +32,11 @@ executable renderer-tutorial
|
|||
, JuicyPixels-extra
|
||||
, StateVar
|
||||
, lens
|
||||
, clock
|
||||
other-modules: BindableClass
|
||||
, BufferClass
|
||||
, VertexBuffer
|
||||
, VertexBufferDynamic
|
||||
, VertexArray
|
||||
, IndexBuffer
|
||||
, Shader
|
||||
|
@ -44,5 +46,7 @@ executable renderer-tutorial
|
|||
, Scenes.SceneClass
|
||||
, Scenes.ClearColor
|
||||
, Scenes.Texture2D
|
||||
, Scenes.Texture2DBatched
|
||||
, Scenes.Texture2DBatchedDynamic
|
||||
hs-source-dirs: src
|
||||
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;
|
||||
|
||||
f = { mkDerivation, base, bytestring, JuicyPixels
|
||||
f = { mkDerivation, base, bytestring, clock, JuicyPixels
|
||||
, JuicyPixels-extra, lens, linear, monad-loops, OpenGL, OpenGLRaw
|
||||
, random, sdl2, StateVar, stdenv, vector
|
||||
}:
|
||||
|
@ -15,7 +15,7 @@ let
|
|||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [
|
||||
base bytestring JuicyPixels JuicyPixels-extra lens linear
|
||||
base bytestring clock JuicyPixels JuicyPixels-extra lens linear
|
||||
monad-loops OpenGL OpenGLRaw random sdl2 StateVar vector
|
||||
];
|
||||
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.Clock
|
||||
|
||||
import Linear
|
||||
|
||||
-- internal imports
|
||||
|
@ -44,6 +46,8 @@ import EventHandler
|
|||
import Scenes.SceneClass
|
||||
import Scenes.ClearColor
|
||||
import Scenes.Texture2D
|
||||
import Scenes.Texture2DBatched
|
||||
import Scenes.Texture2DBatchedDynamic
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -93,6 +97,9 @@ main = do
|
|||
-- initial poll for events
|
||||
evs <- newMVar =<< SDL.pollEvents
|
||||
|
||||
-- time container for dt
|
||||
time <- newMVar =<< getTime Monotonic
|
||||
|
||||
-- Loop running until window closes
|
||||
whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window))
|
||||
<$> map SDL.eventPayload <$> readMVar evs) $ do
|
||||
|
@ -112,10 +119,15 @@ main = do
|
|||
hasSelect <- not <$> isEmptyMVar curScene
|
||||
if hasSelect
|
||||
then do
|
||||
now <- getTime Monotonic
|
||||
before <- readMVar time
|
||||
let dt = fromIntegral
|
||||
(toNanoSecs $ diffTimeSpec before now) / (10 ^ (9 :: Int))
|
||||
(Scene sceneObject) <- readMVar curScene
|
||||
onEvents sceneObject currentEvents
|
||||
update sceneObject 0
|
||||
update sceneObject dt
|
||||
render sceneObject
|
||||
void $ swapMVar time now
|
||||
else do
|
||||
GL.clearColor $= GL.Color4 0 0 0 1
|
||||
GL.clear [GL.ColorBuffer]
|
||||
|
@ -171,6 +183,14 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
|
|||
isEmpty <- isEmptyMVar curScene
|
||||
when isEmpty $ do
|
||||
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 ()
|
||||
switch _ = return ()
|
||||
|
|
|
@ -14,6 +14,8 @@ import Linear
|
|||
|
||||
import qualified Control.Lens as Lens
|
||||
|
||||
import Foreign.Storable (sizeOf)
|
||||
|
||||
-- internal imports
|
||||
|
||||
import BindableClass
|
||||
|
@ -79,10 +81,21 @@ instance SceneClass Texture2D where
|
|||
|
||||
-- enable and specify data layout of the in-memory vertices
|
||||
layout <- newVertexBufferLayout
|
||||
(fromIntegral $ 5 * sizeOf (undefined :: GL.GLfloat))
|
||||
-- push vertex positions
|
||||
pushElements layout GL.Float 3
|
||||
pushElements
|
||||
layout
|
||||
0
|
||||
GL.Float
|
||||
3
|
||||
(0 * (sizeOf (undefined :: GL.GLfloat)))
|
||||
-- pusht texture coordinates
|
||||
pushElements layout GL.Float 2
|
||||
pushElements
|
||||
layout
|
||||
1
|
||||
GL.Float
|
||||
2
|
||||
(3 * (sizeOf (undefined :: GL.GLfloat)))
|
||||
|
||||
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 Foreign.Marshal.Utils (with)
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Storable
|
||||
import Foreign.Ptr
|
||||
|
||||
-- internal imports
|
||||
|
@ -116,6 +118,37 @@ newShader shaderSrc = do
|
|||
Shader program shaderSrc <$> newMVar []
|
||||
|
||||
-- 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 (Shader shaderProgram _ shaderUniforms) uniname data_ = do
|
||||
-- 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)
|
||||
else do
|
||||
-- set the data
|
||||
--withArray data_ $ \ptr ->
|
||||
-- GL.uniformv loc (length data_) ptr
|
||||
GL.uniform loc $= data_
|
||||
-- add uniform to cache
|
||||
modifyMVar_ shaderUniforms
|
||||
|
|
|
@ -23,10 +23,10 @@ import BindableClass
|
|||
data Texture = Texture
|
||||
{ texId :: GL.TextureObject
|
||||
, texSlot :: GL.TextureUnit
|
||||
, texPath :: FilePath
|
||||
, texDimensions :: V2 GL.GLsizei
|
||||
, texBPP :: Int
|
||||
, texData :: Ptr ()
|
||||
-- , texPath :: FilePath
|
||||
-- , texDimensions :: V2 GL.GLsizei
|
||||
-- , texBPP :: Int
|
||||
-- , texData :: Ptr ()
|
||||
}
|
||||
|
||||
instance Bindable Texture where
|
||||
|
@ -51,10 +51,10 @@ newTexture fp slot = do
|
|||
tex <- Texture
|
||||
<$> GL.genObjectName
|
||||
<*> (pure $ GL.TextureUnit slot)
|
||||
<*> (pure fp)
|
||||
<*> (pure $ fmap fromIntegral $ V2 (imageWidth img) (imageHeight img))
|
||||
<*> (pure $ componentCount (VS.head $ imageData img))
|
||||
<*> (pure $ castPtr ptr)
|
||||
-- <*> (pure fp)
|
||||
let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img)
|
||||
-- <*> (pure $ componentCount (VS.head $ imageData img))
|
||||
data_ = castPtr ptr
|
||||
|
||||
-- bind texture
|
||||
bind tex
|
||||
|
@ -65,7 +65,7 @@ newTexture fp slot = do
|
|||
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
|
||||
|
||||
-- put data into GPU memory
|
||||
loadTexture tex
|
||||
loadTexture tex dimensions data_
|
||||
|
||||
-- unbind texture
|
||||
unbind tex
|
||||
|
@ -76,9 +76,9 @@ newTexture fp slot = do
|
|||
-- pass texture object out
|
||||
return tex
|
||||
|
||||
loadTexture :: Texture -> IO ()
|
||||
loadTexture tex =
|
||||
let (V2 w h) = texDimensions tex
|
||||
loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
|
||||
loadTexture tex dimensions data_ =
|
||||
let (V2 w h) = dimensions
|
||||
in GL.texImage2D
|
||||
GL.Texture2D
|
||||
GL.NoProxy
|
||||
|
@ -86,4 +86,4 @@ loadTexture tex =
|
|||
GL.RGBA'
|
||||
(GL.TextureSize2D w h)
|
||||
0
|
||||
(GL.PixelData GL.RGBA GL.UnsignedByte (texData tex))
|
||||
(GL.PixelData GL.RGBA GL.UnsignedByte data_)
|
||||
|
|
|
@ -42,8 +42,9 @@ newVertexArray = VertexArray
|
|||
<$> GL.genObjectName
|
||||
|
||||
addBuffer
|
||||
:: VertexArray
|
||||
-> VertexBuffer a
|
||||
:: (Buffer buf)
|
||||
=> VertexArray
|
||||
-> buf
|
||||
-> VertexBufferLayout
|
||||
-> IO ()
|
||||
addBuffer va vb layout = do
|
||||
|
@ -52,51 +53,64 @@ addBuffer va vb layout = do
|
|||
bind vb
|
||||
-- enable and fill out the vertex attrib pointer(s)
|
||||
list <- readMVar (vblElements layout)
|
||||
let indexed = zip [0 ..] list
|
||||
dataElementSize e = case e of
|
||||
let dataElementSize e = case e of
|
||||
GL.Float -> sizeOf (undefined :: GL.GLfloat)
|
||||
x -> error ("No size computation implemented fof: " <> show x)
|
||||
mapM_
|
||||
(\(index, elem) -> do
|
||||
let offset = fromIntegral $
|
||||
foldl
|
||||
(\acc (index, elem) -> acc + vbleCount elem)
|
||||
0
|
||||
(filter ((< index) . fst) indexed) :: Int
|
||||
GL.vertexAttribArray (GL.AttribLocation $ fromIntegral index) $=
|
||||
(\(VertexBufferLayoutElement index type_ count offset handling) -> do
|
||||
GL.vertexAttribArray (GL.AttribLocation index) $=
|
||||
GL.Enabled
|
||||
GL.vertexAttribPointer (GL.AttribLocation $ fromIntegral index) $=
|
||||
( vbleHandling elem
|
||||
GL.vertexAttribPointer (GL.AttribLocation index) $=
|
||||
( handling
|
||||
, GL.VertexArrayDescriptor
|
||||
-- number of components to our attribute
|
||||
(vbleCount elem)
|
||||
count
|
||||
-- datatype of elements
|
||||
(vbleType elem)
|
||||
-- ???
|
||||
(sum (map vbleCount list) * fromIntegral (dataElementSize (vbleType elem)))
|
||||
-- offset from beginnning of vertex
|
||||
(plusPtr nullPtr (offset * dataElementSize (vbleType elem)))
|
||||
type_
|
||||
-- Stride (How big is one Vertex in bytes)
|
||||
(vblStride layout)
|
||||
-- offset from beginnning of vertex in bytes
|
||||
(plusPtr nullPtr offset)
|
||||
)
|
||||
)
|
||||
indexed
|
||||
list
|
||||
unbind va
|
||||
unbind vb
|
||||
|
||||
newtype VertexBufferLayout = VertexBufferLayout
|
||||
data VertexBufferLayout = VertexBufferLayout
|
||||
{ vblElements :: MVar [VertexBufferLayoutElement]
|
||||
, vblStride :: GL.GLsizei
|
||||
}
|
||||
|
||||
data VertexBufferLayoutElement = VertexBufferLayoutElement
|
||||
{ vbleType :: GL.DataType
|
||||
{ vbleIndex :: GL.GLuint
|
||||
, vbleType :: GL.DataType
|
||||
, vbleCount :: GL.GLint
|
||||
, vbleOffset :: Int
|
||||
, vbleHandling :: GL.IntegerHandling
|
||||
}
|
||||
|
||||
newVertexBufferLayout :: IO VertexBufferLayout
|
||||
newVertexBufferLayout = VertexBufferLayout
|
||||
newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout
|
||||
newVertexBufferLayout stride = VertexBufferLayout
|
||||
<$> newMVar []
|
||||
<*> pure stride
|
||||
|
||||
pushElements :: VertexBufferLayout -> GL.DataType -> GL.GLint -> IO ()
|
||||
pushElements vbl type_ count = do
|
||||
pushElements
|
||||
:: VertexBufferLayout
|
||||
-> GL.GLuint
|
||||
-> GL.DataType
|
||||
-> GL.GLint
|
||||
-> Int
|
||||
-> IO ()
|
||||
pushElements vbl index type_ count offset = do
|
||||
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