Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Triiiiangleeeeesss!!!! *narf*

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-01-03 22:31:01 +01:00
parent 590d720b2a
commit 2fc28adfd1
3 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Main.hs
View File

@ -104,8 +104,8 @@ main = do
GL.position (GL.Light 0) GL.$= GL.Vertex4 5 5 10 0 GL.position (GL.Light 0) GL.$= GL.Vertex4 5 5 10 0
GL.light (GL.Light 0) GL.$= GL.Enabled GL.light (GL.Light 0) GL.$= GL.Enabled
GL.lighting GL.$= GL.Enabled GL.lighting GL.$= GL.Enabled
GL.cullFace GL.$= Just GL.Back GL.cullFace GL.$= Just GL.FrontAndBack -- Back
GL.depthFunc GL.$= Just GL.Less GL.depthFunc GL.$= Just GL.Always -- Less
GL.clearColor GL.$= GL.Color4 0.05 0.05 0.05 1 GL.clearColor GL.$= GL.Color4 0.05 0.05 0.05 1
GL.normalize GL.$= GL.Enabled GL.normalize GL.$= GL.Enabled
@ -407,9 +407,8 @@ draw = do
map' = stateMap state map' = stateMap state
frust = stateFrustum state frust = stateFrustum state
liftIO $ do liftIO $ do
GL.clearColor GL.$= GL.Color4 0.5 0.2 1 1
GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.clear [GL.ColorBuffer, GL.DepthBuffer]
lookAtUniformMatrix4fv (0.0,0.0,0.0) (15, 15, 30) up frust proj 1 lookAtUniformMatrix4fv (0.0,0.0,0.0) (0, 15, 0) up frust proj 1
GL.bindBuffer GL.ArrayBuffer GL.$= Just map' GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex GL.vertexAttribPointer ci GL.$= fgColorIndex
GL.vertexAttribPointer ni GL.$= fgNormalIndex GL.vertexAttribPointer ni GL.$= fgNormalIndex

4
src/Map/Map.hs
View File

@ -69,6 +69,7 @@ getMapBufferObject = do
map' <- return $ generateTriangles map' map' <- return $ generateTriangles map'
putStrLn $ P.unlines $ P.map show (prettyMap map') putStrLn $ P.unlines $ P.map show (prettyMap map')
len <- return $ fromIntegral $ P.length map' `div` numComponents len <- return $ fromIntegral $ P.length map' `div` numComponents
putStrLn $ P.unwords ["num verts",show len]
bo <- genObjectName -- create a new buffer bo <- genObjectName -- create a new buffer
bindBuffer ArrayBuffer $= Just bo -- bind buffer bindBuffer ArrayBuffer $= Just bo -- bind buffer
withArray map' $ \buffer -> withArray map' $ \buffer ->
@ -182,7 +183,6 @@ testMapTemplate = T.transpose [
testMapTemplate2 :: [Text] testMapTemplate2 :: [Text]
testMapTemplate2 = T.transpose [ testMapTemplate2 = T.transpose [
"~~~~~~",
"~~~~~~" "~~~~~~"
] ]
@ -190,7 +190,7 @@ testmap :: IO PlayMap
testmap = do testmap = do
g <- getStdGen g <- getStdGen
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2) rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
return $ listArray ((0,0),(5,1)) rawMap return $ listArray ((0,0),(5,0)) rawMap
parseTemplate :: [Int] -> Text -> [MapEntry] parseTemplate :: [Int] -> Text -> [MapEntry]

12
src/Render/Misc.hs
View File

@ -75,7 +75,13 @@ lookAtUniformMatrix4fv :: (Double, Double, Double) --origin
-> GLint -> GLsizei -> IO () --rest of GL-call -> GLint -> GLsizei -> IO () --rest of GL-call
lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat -> lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat ->
do do
pokeArray projMat $ (lookAt o c u) >< frust pokeArray projMat $
[1, 0, 0, 0,
0, 0, 1, 0.1,
0, 1, 0, 0,
0, 0, 0, 1
]
--(lookAt o c u) >< frust
glUniformMatrix4fv num size 1 projMat glUniformMatrix4fv num size 1 projMat
infixl 5 >< infixl 5 ><
@ -121,7 +127,7 @@ _ >< _ = error "non-conformat matrix-multiplication"
-- generates 4x4-Projection-Matrix -- generates 4x4-Projection-Matrix
lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat] lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
lookAt origin eye up = lookAt at eye up =
map (fromRational . toRational) [ map (fromRational . toRational) [
xx, yx, zx, 0, xx, yx, zx, 0,
xy, yy, zy, 0, xy, yy, zy, 0,
@ -129,7 +135,7 @@ lookAt origin eye up =
-(x *. eye), -(y *. eye), -(z *. eye), 1 -(x *. eye), -(y *. eye), -(z *. eye), 1
] ]
where where
z@(zx,zy,zz) = normal (origin .- eye) z@(zx,zy,zz) = normal (at .- eye)
x@(xx,xy,xz) = normal (up *.* z) x@(xx,xy,xz) = normal (up *.* z)
y@(yx,yy,yz) = z *.* x y@(yx,yy,yz) = z *.* x