merged .. but colors broken..
This commit is contained in:
@ -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,
|
||||
|
@ -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"
|
||||
|
Reference in New Issue
Block a user