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

haddock now works as well..

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-04-15 17:28:38 +02:00
parent d0ce4dcf6a
commit f7dea8e964
2 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Map/Graphics.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings, BangPatterns #-} {-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Map.Graphics module Map.Graphics
( (
mapVertexArrayDescriptor, mapVertexArrayDescriptor,
@ -13,7 +13,7 @@ where
import System.Random import System.Random
import Data.Array.IArray import Data.Array.IArray
import Data.Text as T import Data.Text as T
import Prelude as P import Prelude as P
--import Graphics.Rendering.OpenGL.GL --import Graphics.Rendering.OpenGL.GL
@ -33,8 +33,10 @@ import Linear
import Map.Types import Map.Types
import Map.StaticMaps import Map.StaticMaps
type Height = Float
type MapEntry = ( type MapEntry = (
Float, -- ^ Height Height,
TileType TileType
) )
@ -94,10 +96,10 @@ 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 _ = [] prettyMap _ = []
--generateTriangles :: PlayMap -> [GLfloat] --generateTriangles :: PlayMap -> [GLfloat]
generateTriangles :: GraphicsMap -> [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]]
@ -132,8 +134,8 @@ generateSecondTriLine _ True _ _ = []
lookupVertex :: GraphicsMap -> 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)
(V3 vx vy vz) = coordLookup (x,y) $ heightLookup map' (x,y) (V3 vx vy vz) = coordLookup (x,y) $ heightLookup map' (x,y)
(V3 nx ny nz) = normalLookup map' x y (V3 nx ny nz) = normalLookup map' x y
@ -157,7 +159,7 @@ normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + n
normNW = cross (vNW-vC) (vW -vC) normNW = cross (vNW-vC) (vW -vC)
--Vertex Normals --Vertex Normals
vC = coordLookup (x,y) $ heightLookup map' (x,y) vC = coordLookup (x,y) $ heightLookup map' (x,y)
--TODO: kill guards with eo --TODO: kill guards with eo
vNW vNW
| even x = coordLookup (x-1,y-1) $ heightLookup map' (x-1,y-1) | even x = coordLookup (x-1,y-1) $ heightLookup map' (x-1,y-1)
| otherwise = coordLookup (x-1,y ) $ heightLookup map' (x-1,y ) | otherwise = coordLookup (x-1,y ) $ heightLookup map' (x-1,y )
@ -180,12 +182,12 @@ normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + n
heightLookup :: GraphicsMap -> (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 :: GraphicsMap -> (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
c = case tp of c = case tp of
Ocean -> (0.50, 0.50, 1.00) Ocean -> (0.50, 0.50, 1.00)
@ -256,7 +258,7 @@ testmap2 = do
parseTemplate :: [Int] -> Text -> [MapEntry] parseTemplate :: [Int] -> Text -> [MapEntry]
parseTemplate (r:rs) t = parseTemplate (r:rs) t =
(case T.head t of (case T.head t of
'~' -> (0, Ocean) '~' -> (0, Ocean)
'S' -> (0, Beach) 'S' -> (0, Beach)

28
src/Render/Render.hs
View File

@ -48,18 +48,20 @@ initBuffer varray =
return bufferObject return bufferObject
initMapShader :: IO ( initMapShader :: IO (
Program -- ^ the GLSL-Program Program -- the GLSL-Program
, AttribLocation -- ^ color , AttribLocation -- color
, AttribLocation -- ^ normal , AttribLocation -- normal
, AttribLocation -- ^ vertex , AttribLocation -- vertex
, UniformLocation -- ^ ProjectionMat , UniformLocation -- ProjectionMat
, UniformLocation -- ^ ViewMat , UniformLocation -- ViewMat
, UniformLocation -- ^ ModelMat , UniformLocation -- ModelMat
, UniformLocation -- ^ NormalMat , UniformLocation -- NormalMat
, UniformLocation -- ^ TessLevelInner , UniformLocation -- TessLevelInner
, UniformLocation -- ^ TessLevelOuter , UniformLocation -- TessLevelOuter
, TextureObject -- ^ Texture where to draw into , TextureObject -- Texture where to draw into
) ) -- ^ (the GLSL-Program, color, normal, vertex, ProjectionMat, ViewMat,
-- ModelMat, NormalMat, TessLevelInner, TessLevelOuter,
-- Texture where to draw into)
initMapShader = do initMapShader = do
! vertexSource <- B.readFile mapVertexShaderFile ! vertexSource <- B.readFile mapVertexShaderFile
! tessControlSource <- B.readFile mapTessControlShaderFile ! tessControlSource <- B.readFile mapTessControlShaderFile
@ -138,7 +140,7 @@ initHud = do
texIndex <- get (uniformLocation program "tex[1]") texIndex <- get (uniformLocation program "tex[1]")
checkError "ui-tex" checkError "ui-tex"
-- | simple triangle over the whole screen. -- simple triangle over the whole screen.
let vertexBufferData = reverse [-1, -1, 1, -1, -1, 1, 1, 1] :: [GLfloat] let vertexBufferData = reverse [-1, -1, 1, -1, -1, 1, 1, 1] :: [GLfloat]
vertexIndex <- get (attribLocation program "position") vertexIndex <- get (attribLocation program "position")