rewriting to OpenGL4.3

- 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

Pioneers.cabal

@@ -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,

src/Main.hs

@@ -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 S $= (Repeated, ClampToEdge)
-    --textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
+    textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
     textureFilter Texture2D $= ((Linear', Nothing), Linear')
     textureCompareMode Texture2D $= Just Lequal
     depthTextureMode Texture2D $= Luminance'

src/Map/Coordinates.hs

@@ -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 Map.Map as PMap hiding (heightLookup)
-import Debug.Trace
 
 
 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

src/Map/Map.hs

@@ -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]