From 2ff7534edeab37ee9a951ffd830c9b159185f42c Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Thu, 2 Jan 2014 03:35:38 +0100 Subject: [PATCH] wrote some render-functions and shaders - rudimentary vertex and fragment-shader in shaders/.. - created new Render-Module (unfinished and untested) --- Pioneers.cabal | 7 ++++-- shaders/fragment.shader | 12 ++++++++++ shaders/vertex.shader | 18 ++++++++++++++ src/Map/Map.hs | 1 + src/Render/Misc.hs | 53 +++++++++++++++++++++++++++++++++++++++++ src/Render/Render.hs | 52 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 141 insertions(+), 2 deletions(-) create mode 100644 shaders/fragment.shader create mode 100644 shaders/vertex.shader create mode 100644 src/Render/Misc.hs create mode 100644 src/Render/Render.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index 479efb0..3e9a66a 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -20,9 +20,12 @@ executable Pioneers stm >=2.4.2 && <2.5, transformers >=0.3.0 && <0.4, List >=0.5.1 && <0.6, - OpenGLRaw >=1.4.0 && <1.5 + OpenGLRaw >=1.4.0 && <1.5, + bytestring >=0.10.0 && <0.11 ghc-options: -Wall other-modules: Map.Coordinates, - Map.Map + Map.Map, + Render.Render, + Render.Misc diff --git a/shaders/fragment.shader b/shaders/fragment.shader new file mode 100644 index 0000000..5601846 --- /dev/null +++ b/shaders/fragment.shader @@ -0,0 +1,12 @@ +#version 140 + +#color from earlier stages +smooth in vec4 fg_SmoothColor; + +#color of pixel +out vec4 fg_FragColor; + +void main(void) +{ + fg_FragColor = fg_SmoothColor; #copy-shader +) \ No newline at end of file diff --git a/shaders/vertex.shader b/shaders/vertex.shader new file mode 100644 index 0000000..918a8f0 --- /dev/null +++ b/shaders/vertex.shader @@ -0,0 +1,18 @@ +#version 140 + +#constant projection matrix +uniform mat4 fg_ProjectionMatrix; + +#vertex-data +in vec4 fg_Color; +in vec4 fg_Vertex; +in vec4 fg_Normal; + +#output-data for later stages +smooth out vec4 fg_SmoothColor; + +void main() +{ + fg_SmoothColor = fg_Color; + gl_Position = fg_ProjectionMatrix * fg_Vertex; +} \ No newline at end of file diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 2066e45..04dd897 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -81,6 +81,7 @@ lookupVertex map' x y = (cr, cg, cb) = colorLookup map' (x,y) (vx, vy, vz) = coordLookup (x,y) $ heightLookup map' (x,y) (nx, ny, nz) = (0.0, 1.0, 0.0) :: (GLfloat, GLfloat, GLfloat) + --TODO: calculate normals correctly! in [ (vx, cr, nx), diff --git a/src/Render/Misc.hs b/src/Render/Misc.hs new file mode 100644 index 0000000..5e2607b --- /dev/null +++ b/src/Render/Misc.hs @@ -0,0 +1,53 @@ +module Render.Misc where + +import Graphics.Rendering.OpenGL.GL.StringQueries +import Graphics.Rendering.OpenGL.GL.StateVar +import Graphics.Rendering.OpenGL.GLU.Errors +import System.IO (hPutStrLn, stderr) +import Control.Monad +import Graphics.Rendering.OpenGL.GL.Shaders +import qualified Data.ByteString as B (ByteString) + + +checkError :: String -> IO () +checkError functionName = get errors >>= mapM_ reportError + where reportError e = + hPutStrLn stderr (showError e ++ " detected in " ++ functionName) + showError (Error category message) = + "GL error " ++ show category ++ " (" ++ message ++ ")" + +dumpInfo :: IO () +dumpInfo = do + let dump message var = putStrLn . ((message ++ ": ") ++) =<< get var + dump "Vendor" vendor + dump "Renderer" renderer + dump "Version" glVersion + dump "GLSL" shadingLanguageVersion + checkError "dumpInfo" + +checked :: (t -> IO ()) -> (t -> GettableStateVar Bool) -> (t -> GettableStateVar String) -> String -> t -> IO () +checked action getStatus getInfoLog message object = do + action object + status <- get (getStatus object) + unless status $ + hPutStrLn stderr . ((message ++ " log: ") ++) =<< get (getInfoLog object) + +compileAndCheck :: Shader -> IO () +compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile" + +compileShaderSource :: ShaderType -> B.ByteString -> IO Shader +compileShaderSource st source = do + shader <- createShader st + shaderSourceBS shader $= source + compileAndCheck shader + return shader + +linkAndCheck :: Program -> IO () +linkAndCheck = checked linkProgram linkStatus programInfoLog "link" + +createProgramUsing :: [Shader] -> IO Program +createProgramUsing shaders = do + program <- createProgram + attachedShaders program $= shaders + linkAndCheck program + return program \ No newline at end of file diff --git a/src/Render/Render.hs b/src/Render/Render.hs new file mode 100644 index 0000000..1bbeec9 --- /dev/null +++ b/src/Render/Render.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE BangPatterns #-} +module Render.Render where + +import Graphics.Rendering.OpenGL.GL.BufferObjects +import Graphics.Rendering.OpenGL.GL.ObjectName +import Graphics.Rendering.OpenGL.GL.StateVar +import Render.Misc +import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat) +import Foreign.Storable (sizeOf) +import Foreign.Marshal.Array (withArray) +import Graphics.Rendering.OpenGL.GL.VertexSpec +import Graphics.Rendering.OpenGL.GL.Shaders +import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability(..), vertexAttribArray) +import qualified Data.ByteString as B + +vertexShaderFile :: String +vertexShaderFile = "shaders/vertex.shader" +fragmentShaderFile :: String +fragmentShaderFile = "shaders/fragment.shader" + +initBuffer :: [GLfloat] -> IO BufferObject +initBuffer varray = + let + sizeOfVarray = length varray * sizeOfComponent + sizeOfComponent = sizeOf (head varray) + in do + bufferObject <- genObjectName + bindBuffer ArrayBuffer $= Just bufferObject + withArray varray $ \buffer -> + bufferData ArrayBuffer $= (fromIntegral sizeOfVarray, buffer, StaticDraw) + checkError "initBuffer" + return bufferObject + +initShader :: IO (UniformLocation, AttribLocation, AttribLocation) +initShader = do + ! vertexSource <- B.readFile vertexShaderFile + ! fragmentSource <- B.readFile fragmentShaderFile + vertexShader <- compileShaderSource VertexShader vertexSource + fragmentShader <- compileShaderSource FragmentShader fragmentSource + program <- createProgramUsing [vertexShader, fragmentShader] + currentProgram $= Just program + + projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix") + + colorIndex <- get (attribLocation program "fg_Color") + vertexAttribArray colorIndex $= Enabled + + vertexIndex <- get (attribLocation program "fg_Vertex") + vertexAttribArray vertexIndex $= Enabled + + checkError "initShader" + return (projectionMatrixIndex, colorIndex, vertexIndex) \ No newline at end of file