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

Forgot some files

Browse Source
This commit is contained in:
Jonas Betzendahl 2014-02-10 22:00:18 +01:00
parent 3a8d9d2fa2
commit be6bdf4522
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Main.hs
View File

@ -36,7 +36,7 @@ import Graphics.Rendering.OpenGL.Raw.Core31
import Data.Time (getCurrentTime, UTCTime, diffUTCTime) import Data.Time (getCurrentTime, UTCTime, diffUTCTime)
-- Our modules -- Our modules
import Map.Map import Map.Graphics
import Render.Misc (checkError, import Render.Misc (checkError,
createFrustum, getCam, createFrustum, getCam,
lookAt, up, curb) lookAt, up, curb)
@ -420,4 +420,4 @@ processEvent e = do
Quit -> modify $ \s -> s {stateWinClose = True} Quit -> modify $ \s -> s {stateWinClose = True}
-- there is more (joystic, touchInterface, ...), but currently ignored -- there is more (joystic, touchInterface, ...), but currently ignored
_ -> return () _ -> return ()
liftIO $ putStrLn $ unwords ["Processing Event:",(show e)] liftIO $ putStrLn $ unwords ["Processing Event:",(show e)]

20
src/Map/Graphics.hs
View File

@ -36,7 +36,7 @@ type MapEntry = (
TileType TileType
) )
type PlayMap = Array (Int, Int) MapEntry type GraphicsMap = Array (Int, Int) MapEntry
lineHeight :: GLfloat lineHeight :: GLfloat
lineHeight = 0.8660254 lineHeight = 0.8660254
@ -128,14 +128,14 @@ generateCube = [ -- lower plane
-3.0,3.0,3.0 -3.0,3.0,3.0
] ]
generateTriangles :: PlayMap -> [GLfloat] generateTriangles :: GraphicsMap -> [GLfloat]
generateTriangles map' = generateTriangles map' =
let ((xl,yl),(xh,yh)) = bounds map' in let ((xl,yl),(xh,yh)) = bounds map' in
P.concat [P.concat $ P.map (generateFirstTriLine map' y) [xl .. xh - 2] P.concat [P.concat $ P.map (generateFirstTriLine map' y) [xl .. xh - 2]
++ P.map (generateSecondTriLine map' (y == yh) y) [xl .. xh - 2] ++ P.map (generateSecondTriLine map' (y == yh) y) [xl .. xh - 2]
| y <- [yl..yh]] | y <- [yl..yh]]
generateFirstTriLine :: PlayMap -> Int -> Int -> [GLfloat] generateFirstTriLine :: GraphicsMap -> Int -> Int -> [GLfloat]
generateFirstTriLine map' y x = generateFirstTriLine map' y x =
P.concat $ P.concat $
if even x then if even x then
@ -149,7 +149,7 @@ generateFirstTriLine map' y x =
lookupVertex map' (x + 1) y lookupVertex map' (x + 1) y
] ]
generateSecondTriLine :: PlayMap -> Bool -> Int -> Int -> [GLfloat] generateSecondTriLine :: GraphicsMap -> Bool -> Int -> Int -> [GLfloat]
generateSecondTriLine map' False y x = generateSecondTriLine map' False y x =
P.concat $ P.concat $
if even x then if even x then
@ -165,7 +165,7 @@ generateSecondTriLine map' False y x =
generateSecondTriLine _ True _ _ = [] generateSecondTriLine _ True _ _ = []
lookupVertex :: PlayMap -> Int -> Int -> [GLfloat] lookupVertex :: GraphicsMap -> Int -> Int -> [GLfloat]
lookupVertex map' x y = lookupVertex map' x y =
let let
(cr, cg, cb) = colorLookup map' (x,y) (cr, cg, cb) = colorLookup map' (x,y)
@ -179,7 +179,7 @@ lookupVertex map' x y =
vx, vy, vz -- 3 Vertex vx, vy, vz -- 3 Vertex
] ]
normalLookup :: PlayMap -> Int -> Int -> V3 GLfloat normalLookup :: GraphicsMap -> Int -> Int -> V3 GLfloat
normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + normNW normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + normNW
where where
--Face Normals --Face Normals
@ -212,12 +212,12 @@ normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + n
| otherwise = coordLookup (x-2,y ) $ heightLookup map' (x-2,y ) | otherwise = coordLookup (x-2,y ) $ heightLookup map' (x-2,y )
eo = if even x then 1 else -1 eo = if even x then 1 else -1
heightLookup :: PlayMap -> (Int,Int) -> GLfloat heightLookup :: GraphicsMap -> (Int,Int) -> GLfloat
heightLookup hs t = if inRange (bounds hs) t then fromRational $ toRational h else 0.0 heightLookup hs t = if inRange (bounds hs) t then fromRational $ toRational h else 0.0
where where
(h,_) = hs ! t (h,_) = hs ! t
colorLookup :: PlayMap -> (Int,Int) -> (GLfloat, GLfloat, GLfloat) colorLookup :: GraphicsMap -> (Int,Int) -> (GLfloat, GLfloat, GLfloat)
colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0) colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0)
where where
(_,tp) = hs ! t (_,tp) = hs ! t
@ -273,13 +273,13 @@ testMapTemplate2 = T.transpose [
"~~~~~~~~~~~~" "~~~~~~~~~~~~"
] ]
testmap :: IO PlayMap testmap :: IO GraphicsMap
testmap = do testmap = do
g <- getStdGen g <- getStdGen
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate) rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
return $ listArray ((0,0),(79,19)) rawMap return $ listArray ((0,0),(79,19)) rawMap
testmap2 :: IO PlayMap testmap2 :: IO GraphicsMap
testmap2 = do testmap2 = do
g <- getStdGen g <- getStdGen
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2) rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)