merged .. but colors broken..

This commit is contained in:
Stefan Dresselhaus
2014-01-05 19:09:01 +01:00
7 changed files with 869 additions and 86 deletions

View File

@ -4,16 +4,17 @@ import Control.Monad
import qualified Data.ByteString as B (ByteString)
import Foreign.Marshal.Array (allocaArray,
pokeArray)
import Foreign.C (CFloat)
import Graphics.Rendering.OpenGL.GL.Shaders
import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.StringQueries
import Graphics.Rendering.OpenGL.GLU.Errors
import Graphics.Rendering.OpenGL.Raw.Core31
import System.IO (hPutStrLn, stderr)
import Linear
up :: (Double, Double, Double)
up = (0.0, 1.0, 1.0)
up :: V3 CFloat
up = V3 0 1 0
checkError :: String -> IO ()
checkError functionName = get errors >>= mapM_ reportError
@ -58,16 +59,21 @@ createProgramUsing shaders = do
linkAndCheck program
return program
createFrustum :: Float -> Float -> Float -> Float -> [GLfloat]
createFrustum fov n f rat =
let s = recip (tan $ fov*0.5 * pi / 180) in
map (fromRational . toRational) [
rat*s,0,0,0,
0,rat*s,0,0,
0,0,-(f/(f-n)), -1,
0,0,-((f*n)/(f-n)), 1
]
createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat
createFrustum fov n' f' rat =
let
f = realToFrac f'
n = realToFrac n'
s = realToFrac $ recip (tan $ fov*0.5 * pi / 180)
(ratw,rath) = if rat > 1 then
(1,1/realToFrac rat)
else
(realToFrac rat,1)
in
V4 (V4 (s/ratw) 0 0 0)
(V4 0 (s/rath) 0 0)
(V4 0 0 (-((f+n)/(f-n))) (-((2*f*n)/(f-n))))
(V4 0 0 (-1) 0)
lookAtUniformMatrix4fv :: (Double, Double, Double) --origin
-> (Double, Double, Double) --camera-pos
@ -126,9 +132,23 @@ infixl 5 ><
]
_ >< _ = error "non-conformat matrix-multiplication"
-- from vmath.h
lookAt :: V3 CFloat -> V3 CFloat -> V3 CFloat -> M44 CFloat
lookAt eye@(V3 ex ey ez) center up =
V4
(V4 xx xy xz (-dot x eye))
(V4 yx yy yz (-dot y eye))
(V4 zx zy zz (-dot z eye))
(V4 0 0 0 1)
where
z@(V3 zx zy zz) = normalize (eye ^-^ center)
x@(V3 xx xy xz) = normalize (cross up z)
y@(V3 yx yy yz) = normalize (cross z x)
-- generates 4x4-Projection-Matrix
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
lookAt at eye up =
lookAt_ :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
lookAt_ at eye up =
map (fromRational . toRational) [
xx, yx, zx, 0,
xy, yy, zy, 0,

View File

@ -7,12 +7,13 @@ import Foreign.Storable (sizeOf)
import Graphics.Rendering.OpenGL.GL.BufferObjects
import Graphics.Rendering.OpenGL.GL.Framebuffer (clearColor)
import Graphics.Rendering.OpenGL.GL.ObjectName
import Graphics.Rendering.OpenGL.GL.PerFragment
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
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
import Graphics.Rendering.OpenGL.Raw.Core31
import Render.Misc
vertexShaderFile :: String
@ -33,7 +34,7 @@ initBuffer varray =
checkError "initBuffer"
return bufferObject
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation)
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation, UniformLocation, UniformLocation)
initShader = do
! vertexSource <- B.readFile vertexShaderFile
! fragmentSource <- B.readFile fragmentShaderFile
@ -49,22 +50,35 @@ initShader = do
projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
checkError "projMat"
colorIndex <- get (attribLocation program "fg_Color")
vertexAttribArray colorIndex $= Enabled
checkError "colorInd"
viewMatrixIndex <- get (uniformLocation program "fg_ViewMatrix")
checkError "viewMat"
normalIndex <- get (attribLocation program "fg_Normal")
vertexAttribArray normalIndex $= Enabled
checkError "normalInd"
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
checkError "modelMat"
vertexIndex <- get (attribLocation program "fg_VertexIn")
vertexAttribArray vertexIndex $= Enabled
checkError "vertexInd"
normalIndex <- get (attribLocation program "fg_NormalIn")
vertexAttribArray normalIndex $= Enabled
checkError "normalInd"
colorIndex <- get (attribLocation program "fg_Color")
vertexAttribArray colorIndex $= Enabled
checkError "colorInd"
att <- get (activeAttribs program)
putStrLn $ unlines $ "Attributes: ":map show att
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex)
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex)
initRendering :: IO ()
initRendering = do
clearColor $= Color4 0 0 0 0
depthFunc $= Just Less
glCullFace gl_BACK
checkError "initRendering"