shaders now compile and link correctly
- map still invisible - frustum defined - shaders fixed - attrib-link to shaders fixed - lookat now generates a frustum-projected look-at matrix - smaller test-map for debug
This commit is contained in:
parent
e5193fc7c5
commit
7d201cf216
@ -1,4 +1,4 @@
|
||||
#version 140
|
||||
#version 330
|
||||
|
||||
//color from earlier stages
|
||||
smooth in vec4 fg_SmoothColor;
|
||||
|
||||
@ -1,18 +1,20 @@
|
||||
#version 140
|
||||
#version 330
|
||||
|
||||
//constant projection matrix
|
||||
uniform mat4 fg_ProjectionMatrix;
|
||||
|
||||
//vertex-data
|
||||
in vec4 fg_Color;
|
||||
in vec4 fg_Vertex;
|
||||
in vec4 fg_Normal;
|
||||
in vec3 fg_VertexIn;
|
||||
in vec3 fg_Normal;
|
||||
|
||||
//output-data for later stages
|
||||
smooth out vec4 fg_SmoothColor;
|
||||
|
||||
void main()
|
||||
{
|
||||
fg_SmoothColor = fg_Color;
|
||||
//transform vec3 into vec4, setting w to 1
|
||||
vec4 fg_Vertex = vec4(fg_VertexIn, 1.0);
|
||||
fg_SmoothColor = fg_Color + 0.001* fg_Normal.xyzx;
|
||||
gl_Position = fg_ProjectionMatrix * fg_Vertex;
|
||||
}
|
||||
33
src/Main.hs
33
src/Main.hs
@ -15,7 +15,7 @@ import qualified Graphics.UI.GLFW as GLFW
|
||||
|
||||
import Map.Map
|
||||
import Render.Render (initShader)
|
||||
import Render.Misc (up, lookAtUniformMatrix4fv)
|
||||
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -23,8 +23,6 @@ import Render.Misc (up, lookAtUniformMatrix4fv)
|
||||
data Env = Env
|
||||
{ envEventsChan :: TQueue Event
|
||||
, envWindow :: !GLFW.Window
|
||||
, envMap :: !GL.BufferObject
|
||||
, mapVert :: !GL.NumArrayIndices
|
||||
, envZDistClosest :: !Double
|
||||
, envZDistFarthest :: !Double
|
||||
}
|
||||
@ -43,12 +41,16 @@ data State = State
|
||||
, stateDragStartY :: !Double
|
||||
, stateDragStartXAngle :: !Double
|
||||
, stateDragStartYAngle :: !Double
|
||||
, stateFrustum :: [GL.GLfloat]
|
||||
-- pointer to bindings for locations inside the compiled shader
|
||||
-- mutable because shaders may be changed in the future.
|
||||
, shdrColorIndex :: !GL.AttribLocation
|
||||
, shdrNormalIndex :: !GL.AttribLocation
|
||||
, shdrVertexIndex :: !GL.AttribLocation
|
||||
, shdrProjMatIndex :: !GL.UniformLocation
|
||||
-- the map
|
||||
, stateMap :: !GL.BufferObject
|
||||
, mapVert :: !GL.NumArrayIndices
|
||||
}
|
||||
|
||||
type Pioneer = RWST Env () State IO
|
||||
@ -81,7 +83,7 @@ main = do
|
||||
|
||||
eventsChan <- newTQueueIO :: IO (TQueue Event)
|
||||
|
||||
withWindow width height "GLFW-b-demo" $ \win -> do
|
||||
withWindow width height "Pioneers" $ \win -> do
|
||||
GLFW.setErrorCallback $ Just $ errorCallback eventsChan
|
||||
GLFW.setWindowPosCallback win $ Just $ windowPosCallback eventsChan
|
||||
GLFW.setWindowSizeCallback win $ Just $ windowSizeCallback eventsChan
|
||||
@ -118,11 +120,14 @@ main = do
|
||||
let zDistClosest = 10
|
||||
zDistFarthest = zDistClosest + 20
|
||||
zDist = zDistClosest + ((zDistFarthest - zDistClosest) / 2)
|
||||
fov = 90 --field of view
|
||||
near = 1 --near plane
|
||||
far = 100 --far plane
|
||||
ratio = fromIntegral fbWidth / fromIntegral fbHeight
|
||||
frust = createFrustum fov near far ratio
|
||||
env = Env
|
||||
{ envEventsChan = eventsChan
|
||||
, envWindow = win
|
||||
, envMap = mapBuffer
|
||||
, mapVert = vert
|
||||
, envZDistClosest = zDistClosest
|
||||
, envZDistFarthest = zDistFarthest
|
||||
}
|
||||
@ -143,6 +148,9 @@ main = do
|
||||
, shdrNormalIndex = ni
|
||||
, shdrVertexIndex = vi
|
||||
, shdrProjMatIndex = pi
|
||||
, stateMap = mapBuffer
|
||||
, mapVert = vert
|
||||
, stateFrustum = frust
|
||||
}
|
||||
runDemo env state
|
||||
|
||||
@ -316,9 +324,9 @@ processEvent ev =
|
||||
}
|
||||
|
||||
(EventCursorPos _ x y) -> do
|
||||
let x' = round x :: Int
|
||||
{-let x' = round x :: Int
|
||||
y' = round y :: Int
|
||||
printEvent "cursor pos" [show x', show y']
|
||||
printEvent "cursor pos" [show x', show y']-}
|
||||
state <- get
|
||||
when (stateMouseDown state && not (stateDragging state)) $
|
||||
put $ state
|
||||
@ -395,10 +403,13 @@ draw = do
|
||||
ci = shdrColorIndex state
|
||||
ni = shdrNormalIndex state
|
||||
vi = shdrVertexIndex state
|
||||
numVert = mapVert env
|
||||
map' = envMap env
|
||||
numVert = mapVert state
|
||||
map' = stateMap state
|
||||
frust = stateFrustum state
|
||||
liftIO $ do
|
||||
lookAtUniformMatrix4fv (0.0,0.0,0.0) (xa, ya, za) up proj 1
|
||||
GL.clearColor GL.$= GL.Color4 0.5 0.2 1 1
|
||||
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
|
||||
lookAtUniformMatrix4fv (0.0,0.0,0.0) (15, 15, 30) up frust proj 1
|
||||
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
|
||||
GL.vertexAttribPointer ci GL.$= fgColorIndex
|
||||
GL.vertexAttribPointer ni GL.$= fgNormalIndex
|
||||
|
||||
@ -44,6 +44,9 @@ numComponents = 4 --color
|
||||
+3 --normal
|
||||
+3 --vertex
|
||||
|
||||
mapStride :: Stride
|
||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat)) * fromIntegral numComponents
|
||||
|
||||
bufferObjectPtr :: Integral a => a -> Ptr b
|
||||
bufferObjectPtr = plusPtr (nullPtr :: Ptr GLchar) . fromIntegral
|
||||
|
||||
@ -60,13 +63,11 @@ fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
|
||||
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor a)
|
||||
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
mapStride :: Stride
|
||||
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat)) * fromIntegral numComponents
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
map' <- testmap
|
||||
map' <- return $ generateTriangles map'
|
||||
putStrLn $ P.unlines $ P.map show (prettyMap map')
|
||||
len <- return $ fromIntegral $ P.length map' `div` numComponents
|
||||
bo <- genObjectName -- create a new buffer
|
||||
bindBuffer ArrayBuffer $= Just bo -- bind buffer
|
||||
@ -75,6 +76,9 @@ getMapBufferObject = do
|
||||
checkError "initBuffer"
|
||||
return (bo,len)
|
||||
|
||||
prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat)]
|
||||
prettyMap (a:b:c:d:x:y:z:u:v:w:ms) = (a,b,c,d,x,y,z,u,v,w):(prettyMap ms)
|
||||
prettyMap _ = []
|
||||
|
||||
generateTriangles :: PlayMap -> [GLfloat]
|
||||
generateTriangles map' =
|
||||
@ -176,11 +180,17 @@ testMapTemplate = T.transpose [
|
||||
"~~~~~~~~~~~~~~~~~~~~"
|
||||
]
|
||||
|
||||
testMapTemplate2 :: [Text]
|
||||
testMapTemplate2 = T.transpose [
|
||||
"~~~~~~",
|
||||
"~~~~~~"
|
||||
]
|
||||
|
||||
testmap :: IO PlayMap
|
||||
testmap = do
|
||||
g <- getStdGen
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
||||
return $ listArray ((0,0),(19,19)) rawMap
|
||||
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
|
||||
return $ listArray ((0,0),(5,1)) rawMap
|
||||
|
||||
|
||||
parseTemplate :: [Int] -> Text -> [MapEntry]
|
||||
|
||||
@ -57,16 +57,69 @@ 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
|
||||
]
|
||||
|
||||
lookAtUniformMatrix4fv :: (Double, Double, Double) --origin
|
||||
-> (Double, Double, Double) --camera-pos
|
||||
-> (Double, Double, Double) --up
|
||||
-> [GLfloat] --frustum
|
||||
-> GLint -> GLsizei -> IO () --rest of GL-call
|
||||
lookAtUniformMatrix4fv o c u num size = allocaArray 16 $ \projMat ->
|
||||
lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat ->
|
||||
do
|
||||
pokeArray projMat $ lookAt o c u
|
||||
pokeArray projMat $ (lookAt o c u) >< frust
|
||||
glUniformMatrix4fv num size 1 projMat
|
||||
|
||||
-- generats 4x4-Projection-Matrix
|
||||
infixl 5 ><
|
||||
|
||||
(><) :: [GLfloat] -> [GLfloat] -> [GLfloat]
|
||||
|
||||
[ aa, ab, ac, ad,
|
||||
ba, bb, bc, bd,
|
||||
ca, cb, cc, cd,
|
||||
da, db, dc, dd
|
||||
] ><
|
||||
[
|
||||
xx, xy, xz, xw,
|
||||
yx, yy, yz, yw,
|
||||
zx, zy, zz, zw,
|
||||
wx, wy, wz, ww
|
||||
] = [
|
||||
--first row
|
||||
aa*xx + ab*yx + ac*zx + ad * wx,
|
||||
aa*xy + ab*yy + ac*zy + ad * wy,
|
||||
aa*xz + ab*yz + ac*zz + ad * wz,
|
||||
aa*xw + ab*yw + ac*zw + ad * ww,
|
||||
|
||||
--second row
|
||||
ba*xx + bb*yx + bc*zx + bd * wx,
|
||||
ba*xy + bb*yy + bc*zy + bd * wy,
|
||||
ba*xz + bb*yz + bc*zz + bd * wz,
|
||||
ba*xw + bb*yw + bc*zw + bd * ww,
|
||||
|
||||
--third row
|
||||
ca*xx + cb*yx + cc*zx + cd * wx,
|
||||
ca*xy + cb*yy + cc*zy + cd * wy,
|
||||
ca*xz + cb*yz + cc*zz + cd * wz,
|
||||
ca*xw + cb*yw + cc*zw + cd * ww,
|
||||
|
||||
--fourth row
|
||||
da*xx + db*yx + dc*zx + dd * wx,
|
||||
da*xy + db*yy + dc*zy + dd * wy,
|
||||
da*xz + db*yz + dc*zz + dd * wz,
|
||||
da*xw + db*yw + dc*zw + dd * ww
|
||||
]
|
||||
_ >< _ = error "non-conformat matrix-multiplication"
|
||||
|
||||
-- generates 4x4-Projection-Matrix
|
||||
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
|
||||
lookAt origin eye up =
|
||||
map (fromRational . toRational) [
|
||||
|
||||
@ -38,21 +38,28 @@ initShader = do
|
||||
! vertexSource <- B.readFile vertexShaderFile
|
||||
! fragmentSource <- B.readFile fragmentShaderFile
|
||||
vertexShader <- compileShaderSource VertexShader vertexSource
|
||||
checkError "compile Vertex"
|
||||
fragmentShader <- compileShaderSource FragmentShader fragmentSource
|
||||
checkError "compile Frag"
|
||||
program <- createProgramUsing [vertexShader, fragmentShader]
|
||||
checkError "compile Program"
|
||||
|
||||
currentProgram $= Just program
|
||||
|
||||
projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
|
||||
checkError "projMat"
|
||||
|
||||
colorIndex <- get (attribLocation program "fg_Color")
|
||||
vertexAttribArray colorIndex $= Enabled
|
||||
|
||||
vertexIndex <- get (attribLocation program "fg_Vertex")
|
||||
vertexAttribArray vertexIndex $= Enabled
|
||||
checkError "colorInd"
|
||||
|
||||
normalIndex <- get (attribLocation program "fg_Normal")
|
||||
vertexAttribArray normalIndex $= Enabled
|
||||
checkError "normalInd"
|
||||
|
||||
vertexIndex <- get (attribLocation program "fg_VertexIn")
|
||||
vertexAttribArray vertexIndex $= Enabled
|
||||
checkError "vertexInd"
|
||||
|
||||
checkError "initShader"
|
||||
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user