2014-01-02 02:35:38 +00:00
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
|
|
module Render.Render where
|
|
|
|
|
2014-01-02 12:02:01 +00:00
|
|
|
import qualified Data.ByteString as B
|
|
|
|
import Foreign.Marshal.Array (withArray)
|
|
|
|
import Foreign.Storable (sizeOf)
|
|
|
|
import Graphics.Rendering.OpenGL.GL.BufferObjects
|
|
|
|
import Graphics.Rendering.OpenGL.GL.Framebuffer (clearColor)
|
|
|
|
import Graphics.Rendering.OpenGL.GL.ObjectName
|
2014-01-04 22:47:07 +00:00
|
|
|
import Graphics.Rendering.OpenGL.GL.PerFragment
|
2014-01-02 12:02:01 +00:00
|
|
|
import Graphics.Rendering.OpenGL.GL.Shaders
|
|
|
|
import Graphics.Rendering.OpenGL.GL.StateVar
|
|
|
|
import Graphics.Rendering.OpenGL.GL.VertexArrays (Capability (..),
|
|
|
|
vertexAttribArray)
|
|
|
|
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
2014-01-04 22:47:07 +00:00
|
|
|
import Graphics.Rendering.OpenGL.Raw.Core31
|
2014-01-02 12:02:01 +00:00
|
|
|
import Render.Misc
|
2014-01-02 02:35:38 +00:00
|
|
|
|
|
|
|
vertexShaderFile :: String
|
|
|
|
vertexShaderFile = "shaders/vertex.shader"
|
|
|
|
fragmentShaderFile :: String
|
|
|
|
fragmentShaderFile = "shaders/fragment.shader"
|
|
|
|
|
|
|
|
initBuffer :: [GLfloat] -> IO BufferObject
|
2014-01-02 12:02:01 +00:00
|
|
|
initBuffer varray =
|
2014-01-02 02:35:38 +00:00
|
|
|
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
|
|
|
|
|
2014-01-06 20:13:58 +00:00
|
|
|
initShader :: IO (
|
|
|
|
AttribLocation -- ^ color
|
|
|
|
, AttribLocation -- ^ normal
|
|
|
|
, AttribLocation -- ^ vertex
|
|
|
|
, UniformLocation -- ^ ProjectionMat
|
|
|
|
, UniformLocation -- ^ ViewMat
|
|
|
|
, UniformLocation -- ^ ModelMat
|
|
|
|
, UniformLocation -- ^ NormalMat
|
|
|
|
)
|
2014-01-02 02:35:38 +00:00
|
|
|
initShader = do
|
|
|
|
! vertexSource <- B.readFile vertexShaderFile
|
|
|
|
! fragmentSource <- B.readFile fragmentShaderFile
|
|
|
|
vertexShader <- compileShaderSource VertexShader vertexSource
|
2014-01-03 16:46:41 +00:00
|
|
|
checkError "compile Vertex"
|
2014-01-02 02:35:38 +00:00
|
|
|
fragmentShader <- compileShaderSource FragmentShader fragmentSource
|
2014-01-03 16:46:41 +00:00
|
|
|
checkError "compile Frag"
|
2014-01-02 02:35:38 +00:00
|
|
|
program <- createProgramUsing [vertexShader, fragmentShader]
|
2014-01-03 16:46:41 +00:00
|
|
|
checkError "compile Program"
|
|
|
|
|
2014-01-02 02:35:38 +00:00
|
|
|
currentProgram $= Just program
|
|
|
|
|
|
|
|
projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
|
2014-01-03 16:46:41 +00:00
|
|
|
checkError "projMat"
|
2014-01-02 02:35:38 +00:00
|
|
|
|
2014-01-05 18:09:01 +00:00
|
|
|
viewMatrixIndex <- get (uniformLocation program "fg_ViewMatrix")
|
|
|
|
checkError "viewMat"
|
2014-01-02 02:35:38 +00:00
|
|
|
|
2014-01-04 13:09:42 +00:00
|
|
|
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
|
|
|
|
checkError "modelMat"
|
2014-01-03 02:01:54 +00:00
|
|
|
|
2014-01-06 20:13:58 +00:00
|
|
|
normalMatrixIndex <- get (uniformLocation program "fg_NormalMatrix")
|
|
|
|
checkError "normalMat"
|
|
|
|
|
2014-01-03 16:46:41 +00:00
|
|
|
vertexIndex <- get (attribLocation program "fg_VertexIn")
|
|
|
|
vertexAttribArray vertexIndex $= Enabled
|
|
|
|
checkError "vertexInd"
|
2014-01-03 02:01:54 +00:00
|
|
|
|
2014-01-04 15:55:59 +00:00
|
|
|
normalIndex <- get (attribLocation program "fg_NormalIn")
|
|
|
|
vertexAttribArray normalIndex $= Enabled
|
|
|
|
checkError "normalInd"
|
|
|
|
|
2014-01-04 13:09:42 +00:00
|
|
|
colorIndex <- get (attribLocation program "fg_Color")
|
|
|
|
vertexAttribArray colorIndex $= Enabled
|
|
|
|
checkError "colorInd"
|
|
|
|
|
2014-01-04 15:55:59 +00:00
|
|
|
att <- get (activeAttribs program)
|
|
|
|
|
2014-01-04 13:09:42 +00:00
|
|
|
putStrLn $ unlines $ "Attributes: ":map show att
|
2014-01-04 15:55:59 +00:00
|
|
|
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
|
2014-01-04 13:09:42 +00:00
|
|
|
|
2014-01-02 02:35:38 +00:00
|
|
|
checkError "initShader"
|
2014-01-06 20:13:58 +00:00
|
|
|
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex)
|
2014-01-02 12:02:01 +00:00
|
|
|
|
|
|
|
initRendering :: IO ()
|
|
|
|
initRendering = do
|
|
|
|
clearColor $= Color4 0 0 0 0
|
2014-01-04 22:47:07 +00:00
|
|
|
depthFunc $= Just Less
|
|
|
|
glCullFace gl_BACK
|
2014-01-02 12:02:01 +00:00
|
|
|
checkError "initRendering"
|