From 155be720b397f95b0b498bc1d1f533fdf72e9b80 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 23 May 2020 14:08:20 +0200 Subject: [PATCH] finished episode 19. episode 18 was theory only --- renderer-tutorial.cabal | 1 + res/shaders/vert.shader | 4 +++- shell.nix | 4 ++-- src/Main.hs | 16 ++++++++++++---- src/Shader.hs | 41 ++++++++++++++++++++++++++++++++++++++++- 5 files changed, 58 insertions(+), 8 deletions(-) diff --git a/renderer-tutorial.cabal b/renderer-tutorial.cabal index e245746..439126a 100644 --- a/renderer-tutorial.cabal +++ b/renderer-tutorial.cabal @@ -30,6 +30,7 @@ executable renderer-tutorial , random , JuicyPixels , JuicyPixels-extra + , StateVar other-modules: BindableClass , BufferClass , VertexBuffer diff --git a/res/shaders/vert.shader b/res/shaders/vert.shader index c053d6d..0163d34 100644 --- a/res/shaders/vert.shader +++ b/res/shaders/vert.shader @@ -5,8 +5,10 @@ layout(location = 1) in vec2 texCoord; out vec2 v_texCoord; +uniform mat4 u_mvp; + void main() { - gl_Position = vec4(position, 1); + gl_Position = u_mvp * vec4(position, 1); v_texCoord = texCoord; } diff --git a/shell.nix b/shell.nix index 040059e..55f1fd5 100644 --- a/shell.nix +++ b/shell.nix @@ -6,7 +6,7 @@ let f = { mkDerivation, base, bytestring, JuicyPixels , JuicyPixels-extra, linear, monad-loops, OpenGL, OpenGLRaw, random - , sdl2, stdenv, vector + , sdl2, StateVar, stdenv, vector }: mkDerivation { pname = "renderer-tutorial"; @@ -16,7 +16,7 @@ let isExecutable = true; executableHaskellDepends = [ base bytestring JuicyPixels JuicyPixels-extra linear monad-loops - OpenGL OpenGLRaw random sdl2 vector + OpenGL OpenGLRaw random sdl2 StateVar vector ]; license = stdenv.lib.licenses.gpl3; }; diff --git a/src/Main.hs b/src/Main.hs index 9694b0d..0a64b67 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,6 +29,8 @@ import qualified Data.List as L import System.Random (randomRIO) +import Linear + -- internal imports import BindableClass @@ -85,10 +87,10 @@ main = do -- with added in texture coordinates let vertexPositions = -- 3D positions | texture coordinates - [ (-0.5), (-0.5), 0, 0, 0 -- 0 - , 0.5 , (-0.5), 0, 1, 0 -- 1 - , 0.5 , 0.5 , 0, 1, 1 -- 2 - , (-0.5), 0.5 , 0, 0, 1 -- 3 + [ (-0.5), (-0.75), 0, 0, 0 -- 0 + , 0.5 , (-0.75), 0, 1, 0 -- 1 + , 0.5 , 0.75 , 0, 1, 1 -- 2 + , (-0.5), 0.75 , 0, 0, 1 -- 3 ] :: [GL.GLfloat] -- create draw order indices @@ -110,6 +112,10 @@ main = do addBuffer vao vbo layout + -- -- MATRICES + + let proj = ortho (-2) 2 (-1.5) 1.5 (-1) 1 :: M44 GL.GLfloat + -- -- TEXTURE -- generate and bind texture @@ -127,11 +133,13 @@ main = do ] [ "u_color" , "u_texture" + , "u_mvp" ] -- -- tell the shader where to find the texture bind sp setUniform sp "u_texture" (texSlot tex) + setUniform sp "u_mvp" proj -- -- UNIFORMS diff --git a/src/Shader.hs b/src/Shader.hs index 9db7a21..0b6acaf 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -1,13 +1,26 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} + module Shader where import SDL (($=), get) import qualified Graphics.Rendering.OpenGL as GL +import qualified Graphics.GL as GLRaw import Data.List as L +import Data.StateVar + import qualified Data.ByteString as B +import Data.Maybe (fromJust) + +import Linear + +import Foreign.Marshal.Utils (with) +import Foreign.Ptr + -- internal imports import BindableClass @@ -35,7 +48,33 @@ data ShaderUniform = ShaderUniform , shaderUniformLocation :: GL.UniformLocation } --- cerate new data object of type Shader +-- orphan instance to make linear's M44 uniforms +instance GL.Uniform (M44 GL.GLfloat) where + uniform loc@(GL.UniformLocation ul) = makeStateVar getter setter + where + getter = error "cannot implement: get uniform M44 GLfloat" + -- GL.withNewMatrix GL.RowMajor $ getUniformWith GLRaw.glGetUniformfv loc + setter (V4 + (V4 a b c d) + (V4 e f g h) + (V4 i j k l) + (V4 m n o p)) = do + mat <- GL.newMatrix GL.RowMajor [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] :: IO (GL.GLmatrix GL.GLfloat) + GL.withMatrix mat $ GLRaw.glUniformMatrix4fv ul 1 . isRowMajor + uniformv (GL.UniformLocation ul) count buf = error "can not implement uniformv for M44 GLfloat" + -- GLRaw.glUniformMatrix4fv ul count 0 (castPtr buf `asTypeOf` elemType buf) + -- where + -- elemType = undefined :: GL.MatrixComponent c => Ptr (GL.GLmatrix c) -> Ptr c + +-- getUniformWith :: (GL.GLuint -> GL.GLint -> Ptr a -> IO ()) -> GL.UniformLocation -> Ptr a -> IO () +-- getUniformWith getter (GL.UniformLocation ul) buf = do +-- program <- fmap (GL.programID . fromJust) $ get GL.currentProgram +-- getter program ul buf + +isRowMajor :: GL.MatrixOrder -> GL.GLboolean +isRowMajor p = if (GL.RowMajor == p) then 1 else 0 + +-- create new data object of type Shader newShader :: [ShaderSource] -> [String] -> IO Shader newShader shaderSrc uniforms = do -- create program Object