Regenbogendreiecken

frag.glsl

@@ -1,8 +1,10 @@
 #version 450 core
 
-out vec4 FragColor;
+in vec4 fragColor_in;
+
+out vec4 fragColor_out;
 
 void main()
 {
-  FragColor = vec4(1.0f, 0.5f, 0.2f, 1.0f);
+  fragColor_out = fragColor_in;
 }

src/IO.hs

@@ -5,7 +5,6 @@ module IO (Descriptor, openWindow, shutdownWindow, view) where
 
 -- IMPORTS --
 
-import qualified Data.ByteString as BS
 import qualified Graphics.Rendering.OpenGL as GL
 import Graphics.Rendering.OpenGL (($=))
 import qualified Graphics.UI.GLFW as GLFW
@@ -16,6 +15,7 @@ import Foreign.Ptr
 import Foreign.Marshal.Array
 import Foreign.Storable
 
+import LoadShaders
 import Relude
 import Model
 
@@ -30,26 +30,13 @@ view window descriptor@(Descriptor vertices firstIndex numVertices) model = do
   GLFW.swapBuffers window
   GLFW.pollEvents
 
--- SHADER DATA STRUCTURES --
+-- SHADER STUFF --
 
-data Descriptor
-  = Descriptor
-      { vertexArray :: GL.VertexArrayObject
-      , firstindex :: GL.ArrayIndex
-      , numArrayIndicies :: GL.NumArrayIndices
-      }
-
-data ShaderInfo
-  = ShaderInfo
-      GL.ShaderType
-      ShaderSource
-  deriving (Eq, Ord, Show)
-
-data ShaderSource
-  = ByteStringSource BS.ByteString
-  | StringSource String
-  | FileSource FilePath
-  deriving (Eq, Ord, Show)
+data Descriptor =
+  Descriptor
+    GL.VertexArrayObject
+    GL.ArrayIndex
+    GL.NumArrayIndices
 
 -- INIT RENDERER --
 
@@ -58,6 +45,8 @@ bufferOffset integral = plusPtr nullPtr $ fromIntegral integral
 
 initResources :: IO Descriptor
 initResources = do
+
+  -- vertices array
   verticesGLArray <- GL.genObjectName
   GL.bindVertexArrayObject $= Just verticesGLArray
   let 
@@ -70,8 +59,8 @@ initResources = do
       , GL.Vertex2 0.85 (-0.9)
       ] :: [GL.Vertex2 GL.GLfloat]
     numVertices = length verticesArray
-  arrayBuffer <- GL.genObjectName
-  GL.bindBuffer GL.ArrayBuffer $= Just arrayBuffer
+  vertexBuffer <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just vertexBuffer
   withArray verticesArray $ \ptr -> do
     let
       size
@@ -83,43 +72,54 @@ initResources = do
                 Nothing -> (GL.Vertex2 0 0) :: (GL.Vertex2 GL.GLfloat)
                 Just a -> a
     GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw)
-  program <- loadShaders
-    [ ShaderInfo GL.VertexShader (FileSource "vert.glsl")
-    , ShaderInfo GL.FragmentShader (FileSource "frag.glsl")
-    ]
-  GL.currentProgram $= Just program
   let
     firstIndex = 0
     vPosition = GL.AttribLocation 0
   GL.vertexAttribPointer vPosition $=
     (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 (bufferOffset firstIndex))
   GL.vertexAttribArray vPosition $= GL.Enabled
+
+  -- colors array
+
+  let
+    rgba =
+      [ GL.Color4 1.0 0.0 0.0 1.0
+      , GL.Color4 0.0 1.0 0.0 1.0
+      , GL.Color4 0.0 0.0 1.0 1.0
+      , GL.Color4 1.0 0.0 0.0 1.0
+      , GL.Color4 0.0 1.0 0.0 1.0
+      , GL.Color4 0.0 0.0 1.0 1.0
+      ] :: [GL.Color4 GL.GLfloat]
+  colorBuffer <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just colorBuffer
+  withArray rgba $ \ptr -> do
+    let
+      size
+        = fromIntegral
+        $ (*)
+          numVertices
+          $ sizeOf
+            $ case viaNonEmpty head rgba of
+                Nothing ->
+                  (GL.Color4 0.0 0.0 0.0 0.0) :: (GL.Color4 GL.GLfloat)
+                Just a ->
+                  a
+    GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw)
+  let
+    firstIndex = 0
+    vPosition = GL.AttribLocation 1
+  GL.vertexAttribPointer vPosition $=
+    (GL.ToFloat, GL.VertexArrayDescriptor 4 GL.Float 0 (bufferOffset firstIndex))
+  GL.vertexAttribArray vPosition $= GL.Enabled
+
+  program <- loadShaders
+    [ ShaderInfo GL.VertexShader (FileSource "vert.glsl")
+    , ShaderInfo GL.FragmentShader (FileSource "frag.glsl")
+    ]
+  GL.currentProgram $= Just program
+
   return $ Descriptor verticesGLArray firstIndex $ fromIntegral numVertices
 
--- LOAD SHADERS --
-
-getSource :: ShaderSource -> IO BS.ByteString
-getSource (ByteStringSource bs) = return bs
-getSource (StringSource str) = return $ GL.packUtf8 str
-getSource (FileSource path) = BS.readFile path
-
-loadShaders :: [ShaderInfo] -> IO GL.Program
-loadShaders infos =
-  GL.createProgram `bracketOnError` GL.deleteObjectName $ \program -> do
-    loadCompileAttach program infos
-    GL.linkProgram program
-    return program
-
-loadCompileAttach :: GL.Program -> [ShaderInfo] -> IO ()
-loadCompileAttach _ [] = return ()
-loadCompileAttach program (ShaderInfo shType source : infos) =
-  GL.createShader shType `bracketOnError` GL.deleteObjectName $ \shader -> do
-    src <- getSource source
-    GL.shaderSourceBS shader $= src
-    GL.compileShader shader
-    GL.attachShader program shader
-    loadCompileAttach program infos
-
 -- INPUT --
 
 keyPressed :: GLFW.KeyCallback

src/LoadShaders.hs

@@ -0,0 +1,89 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  LoadShaders
+-- Copyright   :  (c) Sven Panne 2013
+-- License     :  BSD3
+--
+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The
+-- Red Book Authors.
+--
+--------------------------------------------------------------------------------
+
+module LoadShaders (
+   ShaderSource(..), ShaderInfo(..), loadShaders
+) where
+
+import Control.Exception
+import Control.Monad
+import qualified Data.ByteString as B
+import Graphics.Rendering.OpenGL
+
+--------------------------------------------------------------------------------
+
+-- | The source of the shader source code.
+
+data ShaderSource =
+     ByteStringSource B.ByteString
+     -- ^ The shader source code is directly given as a 'B.ByteString'.
+   | StringSource String
+     -- ^ The shader source code is directly given as a 'String'.
+   | FileSource FilePath
+     -- ^ The shader source code is located in the file at the given 'FilePath'.
+   deriving ( Eq, Ord, Show )
+
+getSource :: ShaderSource -> IO B.ByteString
+getSource (ByteStringSource bs) = return bs
+getSource (StringSource str) = return $ packUtf8 str
+getSource (FileSource path) = B.readFile path
+
+--------------------------------------------------------------------------------
+
+-- | A description of a shader: The type of the shader plus its source code.
+
+data ShaderInfo = ShaderInfo ShaderType ShaderSource
+   deriving ( Eq, Ord, Show )
+
+--------------------------------------------------------------------------------
+
+-- | Create a new program object from the given shaders, throwing an
+-- 'IOException' if something goes wrong.
+
+loadShaders :: [ShaderInfo] -> IO Program
+loadShaders infos =
+   createProgram `bracketOnError` deleteObjectName $ \program -> do
+      loadCompileAttach program infos
+      linkAndCheck program
+      return program
+
+linkAndCheck :: Program -> IO ()
+linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
+
+loadCompileAttach :: Program -> [ShaderInfo] -> IO ()
+loadCompileAttach _ [] = return ()
+loadCompileAttach program (ShaderInfo shType source : infos) =
+   createShader shType `bracketOnError` deleteObjectName $ \shader -> do
+      src <- getSource source
+      shaderSourceBS shader $= src
+      compileAndCheck shader
+      attachShader program shader
+      loadCompileAttach program infos
+
+compileAndCheck :: Shader -> IO ()
+compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
+
+checked :: (t -> IO ())
+        -> (t -> GettableStateVar Bool)
+        -> (t -> GettableStateVar String)
+        -> String
+        -> t
+        -> IO ()
+checked action getStatus getInfoLog message object = do
+   action object
+   ok <- get (getStatus object)
+   unless ok $ do
+      infoLog <- get (getInfoLog object)
+      fail (message ++ " log: " ++ infoLog)

src/Main.hs

@@ -18,7 +18,6 @@ main :: IO ()
 main =
   do
     (window, descriptor) <- openWindow "window :)"
-    putTextLn "has window"
     _ <- loop window descriptor update view model
     return ()
 

vert.glsl

@@ -1,8 +1,13 @@
 #version 450 core
 
-layout (location = 0) in vec3 aPos;
+layout (location = 0) in vec4 vertexPosition;
+layout (location = 1) in vec4 vertexColor;
+
+out vec4 fragColor_in;
 
 void main()
 {
-  gl_Position = vec4(aPos.x, aPos.y, aPos.z, 1.0);
+  gl_Position = vertexPosition;
+
+  fragColor_in = vertexColor;
 }