wrote some render-functions and shaders

- rudimentary vertex and fragment-shader in shaders/..
- created new Render-Module (unfinished and untested)

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
 

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
+)

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;
+}

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),

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

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)