finished episode 30. Episodes in between were either theory or trivial.

This commit is contained in:
nek0 2020-08-29 17:15:07 +02:00
parent 74387cf18b
commit 4f414f1410
10 changed files with 367 additions and 40 deletions

View File

@ -44,5 +44,6 @@ executable renderer-tutorial
, Scenes.SceneClass
, Scenes.ClearColor
, Scenes.Texture2D
, Scenes.Texture2DBatched
hs-source-dirs: src
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

@ -44,6 +44,7 @@ import EventHandler
import Scenes.SceneClass
import Scenes.ClearColor
import Scenes.Texture2D
import Scenes.Texture2DBatched
main :: IO ()
main = do
@ -171,6 +172,10 @@ 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)
_ ->
return ()
switch _ = return ()

View File

@ -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

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

@ -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

View File

@ -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_)

View File

@ -52,51 +52,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
]
)