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

rewriting to OpenGL4.3

Browse Source 
- rewrote Map to generate Triangles for glBindBuffer
- Coordinates is not longer used AFTER the change but generates
  Data until change is complete
- Size of Map in VRAM is sizeof(float)*(vert)*9 with vert = 2nm - n - m + 1
  * 3 float coordinats
  * 3 float color
  * 3 float normal
  yielding about 13.5mb VRAM for 500x500-Map
This commit is contained in:
Nicole Dresselhaus 2014-01-02 03:05:35 +01:00
parent 35f1a09d13
commit 673a0f786a
4 changed files with 102 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Pioneers.cabal
View File

@ -19,7 +19,8 @@ executable Pioneers
text >=0.11.3 && <0.12,
stm >=2.4.2 && <2.5,
transformers >=0.3.0 && <0.4,
List >=0.5.1 && <0.6
List >=0.5.1 && <0.6,
OpenGLRaw >=1.4.0 && <1.5
ghc-options: -Wall
other-modules:
Map.Coordinates,

14
src/Main.hs
View File

@ -124,6 +124,10 @@ drawObjects map ent shadowRender = do
pos <- getSunPos Vector3
translate $ fmap (+ (-15.0)) pos
drawSphere
preservingMatrix $ do
pos <- getSunPos Vector3
translate $ fmap (+ (-10.0)) pos
drawSphere
--draw sun-indicator
{- preservingMatrix $ do
pos <- getSunPos Vector3
@ -259,7 +263,7 @@ generateShadowMap tiles obj = do
clear [ ColorBuffer, DepthBuffer ]
--cullFace $= Just Front -- only backsides cast shadows -> less polys
cullFace $= Just Front -- only backsides cast shadows -> less polys
matrixMode $= Projection
preservingMatrix $ do
@ -275,7 +279,7 @@ generateShadowMap tiles obj = do
copyTexImage2D Texture2D 0 DepthComponent' (Position 0 0) shadowMapSize 0
--cullFace $= Just Back
cullFace $= Just Back
when True $ do
let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)
@ -441,15 +445,15 @@ main = do
clearColor $= Color4 0.0 0.0 0.0 0.0
drawBuffer $= BackBuffers
colorMaterial $= Just (Front, Diffuse)
colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse)
frontFace $= CCW
cullFace $= Just Back
texture Texture2D $= Enabled
--textureWrapMode Texture2D S $= (Repeated, ClampToEdge)
--textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
textureWrapMode Texture2D S $= (Repeated, ClampToEdge)
textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
textureFilter Texture2D $= ((Linear', Nothing), Linear')
textureCompareMode Texture2D $= Just Lequal
depthTextureMode Texture2D $= Luminance'

9
src/Map/Coordinates.hs
View File

@ -10,19 +10,14 @@ Tile
where
import Graphics.Rendering.OpenGL as GL
import Data.Map as M hiding ((!))
import qualified Data.Map as M ((!))
import Data.Maybe
import Prelude as P
import Data.Array.IArray as A
import Map.Map as PMap
import Debug.Trace
import Map.Map as PMap hiding (heightLookup)
type Coordinates = (Int, Int)
type Pos = (Float, Float)
-- | a Tile is 1 unit in size. Due to hexagonality the real rendered Area is less.
type Tile = Coordinates
instance Num Tile where
@ -52,7 +47,7 @@ data Neighbours =
| SouthWest
deriving (Show, Eq)
-- | Ordered Vertice-List for rendering (clockwise)
-- | Ordered Vertice-List for rendering (Counterclockwise)
data TileVertex =
VertexNW
| VertexNE

89
src/Map/Map.hs
View File

@ -7,6 +7,8 @@ import System.Random
import Data.Array.IArray
import Data.Text as T
import Prelude as P
import Graphics.Rendering.OpenGL.Raw.Core31.Types (GLfloat)
data TileType =
Grass
@ -22,6 +24,93 @@ type MapEntry = (
type PlayMap = Array (Int, Int) MapEntry
lineHeight :: GLfloat
lineHeight = 0.8660254
-- | getMap returns the map as List of Vertices (rendered as triangles).
-- This promises to hold True for length v == length c == length n in
-- getMap -> (v,c,n) with length v `mod` 3 == 0.
--
-- v are Vertices, c are Colors and n are Normals.
getMap :: IO ([GLfloat], [GLfloat], [GLfloat])
getMap = do
map' <- testmap
return $ unzip3 $ generateTriangles map'
generateTriangles :: PlayMap -> [(GLfloat, GLfloat, GLfloat)]
generateTriangles map' =
let ((xl,yl),(xh,yh)) = bounds map' in
P.concat [P.concat $ P.map (generateFirstTriLine map' y) [xl .. xh - 2]
++ P.map (generateSecondTriLine map' (y == yh) y) [xl .. xh - 2]
| y <- [yl..yh]]
generateFirstTriLine :: PlayMap -> Int -> Int -> [(GLfloat, GLfloat, GLfloat)]
generateFirstTriLine map' y x =
P.concat $
if even x then
[ lookupVertex map' x y,
lookupVertex map' (x + 1) y,
lookupVertex map' (x + 2) y
]
else
[ lookupVertex map' x y,
lookupVertex map' (x + 2) y,
lookupVertex map' (x + 1) y
]
generateSecondTriLine :: PlayMap -> Bool -> Int -> Int -> [(GLfloat, GLfloat, GLfloat)]
generateSecondTriLine map' False y x =
P.concat $
if even x then
[ lookupVertex map' x (y + 1),
lookupVertex map' (x + 2) (y + 1),
lookupVertex map' (x + 1) y
]
else
[ lookupVertex map' x y,
lookupVertex map' (x + 1) (y + 1),
lookupVertex map' (x + 2) y
]
generateSecondTriLine _ True _ _ = []
lookupVertex :: PlayMap -> Int -> Int -> [(GLfloat, GLfloat, GLfloat)]
lookupVertex map' x y =
let
(cr, cg, cb) = colorLookup map' (x,y)
(vx, vy, vz) = coordLookup (x,y) $ heightLookup map' (x,y)
(nx, ny, nz) = (0.0, 1.0, 0.0) :: (GLfloat, GLfloat, GLfloat)
in
[
(vx, cr, nx),
(vy, cg, ny),
(vz, cb, nz)
]
heightLookup :: PlayMap -> (Int,Int) -> GLfloat
heightLookup hs t = if inRange (bounds hs) t then fromRational $ toRational h else 0.0
where
(h,_) = hs ! t
colorLookup :: PlayMap -> (Int,Int) -> (GLfloat, GLfloat, GLfloat)
colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0)
where
(_,tp) = hs ! t
c = case tp of
Water -> (0.5, 0.5, 1)
Sand -> (0.9, 0.85, 0.7)
Grass -> (0.3, 0.9, 0.1)
Mountain -> (0.5, 0.5, 0.5)
coordLookup :: (Int,Int) -> GLfloat -> (GLfloat, GLfloat, GLfloat)
coordLookup (x,y) h =
if even x then
(fromIntegral $ x `div` 2, fromIntegral (2 * y) * lineHeight, h)
else
(fromIntegral (x `div` 2) / 2.0, fromIntegral (2 * y + 1) * lineHeight, h)
-- if writing in ASCII-Format transpose so i,j -> y,x
-- row-minor -> row-major
testMapTemplate :: [Text]