Merge remote-tracking branch 'origin/Mapping' into tessallation

Conflicts:
	Pioneers.cabal

Pioneers.cabal

@@ -12,7 +12,10 @@ executable Pioneers
     ghc-options:     -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm
   }
   other-module
-                   Map.Map,
+                   Map.Types,
+                   Map.Graphics,
+                   Map.Creation,
+                   Map.StaticMaps,
                    Render.Misc,
                    Render.Render,
                    Render.RenderObject,

src/Main.hs

@@ -50,7 +50,7 @@ import           Graphics.GLUtil.BufferObjects        (offset0)
 
 import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
 -- Our modules
-import           Map.Map
+import           Map.Graphics
 import           Render.Misc                          (checkError,
                                                        createFrustum, getCam,
                                                        curb, tryWithTexture,

src/Map/Creation.hs

@@ -0,0 +1,7 @@
+module Map.Creation
+where
+
+import Map.Types
+
+newMap :: Int -> Int -> PlayMap
+newMap = undefined

src/Map/Graphics.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings, BangPatterns #-}
-module Map.Map 
+module Map.Graphics 
 
 (
 mapVertexArrayDescriptor,
@@ -15,6 +15,7 @@ import System.Random
 import Data.Array.IArray
 import Data.Text as T 
 import Prelude as P
+
 --import Graphics.Rendering.OpenGL.GL
 import           Graphics.Rendering.OpenGL.GL.BufferObjects
 import           Graphics.Rendering.OpenGL.GL.ObjectName
@@ -24,29 +25,33 @@ import           Graphics.Rendering.OpenGL.GL.VertexSpec
 import           Graphics.Rendering.OpenGL.Raw.Core31
 
 import Foreign.Marshal.Array (withArray)
-import Foreign.Storable (sizeOf)
+import Foreign.Storable      (sizeOf)
-import Foreign.Ptr (Ptr, nullPtr, plusPtr)
+import Foreign.Ptr           (Ptr, nullPtr, plusPtr)
-import Render.Misc (checkError)
+import Render.Misc           (checkError)
 import Linear
 
-
+import Map.Types
-data TileType =
+import Map.StaticMaps
-        Grass
-        | Sand
-        | Water
-        | Mountain
-        deriving (Show, Eq)
 
 type MapEntry = (
                 Float, -- ^ Height
                 TileType
                 )
 
-type PlayMap = Array (Int, Int) MapEntry
+type GraphicsMap = Array (Int, Int) MapEntry
+
+-- extract graphics information from Playmap
+convertToGraphicsMap :: PlayMap -> GraphicsMap
+convertToGraphicsMap map = array (bounds map) [(i, graphicsyfy (map!i))| i <- indices map]
+    where
+      graphicsyfy :: Node -> MapEntry
+      graphicsyfy (Minimal _               ) = (0, Grass)
+      graphicsyfy (Full    _ y t _ _ _ _ _ ) = (y, t)
 
 lineHeight :: GLfloat
 lineHeight = 0.8660254
 
+-- Number of GLfloats per Stride
 numComponents :: Int
 numComponents = 10
 
@@ -71,9 +76,8 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
 
 getMapBufferObject :: IO (BufferObject, NumArrayIndices)
 getMapBufferObject = do
-        map' <- testmap
+        map'   <- return $ convertToGraphicsMap mapCenterMountain
         ! map' <- return $ generateTriangles map'
-        --putStrLn $ P.unlines $ P.map show (prettyMap map')
         len <- return $ fromIntegral $ P.length map' `div` numComponents
         putStrLn $ P.unwords ["num verts in map:",show len]
         bo <- genObjectName                     -- create a new buffer
@@ -89,14 +93,15 @@ prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfl
 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 _ = []
 
-generateTriangles :: PlayMap -> [GLfloat]
+--generateTriangles :: PlayMap -> [GLfloat]
+generateTriangles :: GraphicsMap -> [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]
+generateFirstTriLine :: GraphicsMap -> Int -> Int -> [GLfloat]
 generateFirstTriLine map' y x =
                 P.concat $
                    if even x then
@@ -110,7 +115,7 @@ generateFirstTriLine map' y x =
                         lookupVertex map' (x + 1) y
                      ]
 
-generateSecondTriLine :: PlayMap -> Bool -> Int -> Int ->  [GLfloat]
+generateSecondTriLine :: GraphicsMap -> Bool -> Int -> Int ->  [GLfloat]
 generateSecondTriLine map' False y x  =
                 P.concat $
                    if even x then
@@ -126,7 +131,7 @@ generateSecondTriLine map' False y x  =
 generateSecondTriLine _ True _ _  = []
 
 
-lookupVertex :: PlayMap -> Int -> Int -> [GLfloat]
+lookupVertex :: GraphicsMap -> Int -> Int -> [GLfloat]
 lookupVertex map' x y = 
                 let 
                         (cr, cg, cb)  = colorLookup map' (x,y)
@@ -140,7 +145,7 @@ lookupVertex map' x y =
                         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
                     where
                       --Face Normals
@@ -173,20 +178,23 @@ normalLookup map' x y = normalize $ normN + normNE + normSE + normS + normSW + n
                         | otherwise = coordLookup (x-2,y  ) $ heightLookup map' (x-2,y  )
                       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
                 where 
                         (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)
                 where 
                         (_,tp) = hs ! t
                         c = case tp of
-                                Water           -> (0.5, 0.5, 1)
+                                Ocean           -> (0.50, 0.50, 1.00)
-                                Sand            -> (0.9, 0.85, 0.7)
+                                Lake            -> (0.40, 0.87 ,1.00)
-                                Grass           -> (0.3, 0.9, 0.1)
+                                Beach           -> (0.90, 0.85, 0.70)
-                                Mountain        -> (0.5, 0.5, 0.5)
+                                Desert          -> (1.00, 0.87, 0.39)
+                                Grass           -> (0.30, 0.90, 0.10)
+                                Hill            -> (0.80, 0.80, 0.80)
+                                Mountain        -> (0.50, 0.50, 0.50)
 
 coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat
 coordLookup (x,z) y =
@@ -234,13 +242,13 @@ testMapTemplate2 = T.transpose [
                 "~~~~~~~~~~~~"
                 ]
 
-testmap :: IO PlayMap
+testmap :: IO GraphicsMap
 testmap = do
                 g <- getStdGen
                 rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
                 return $ listArray ((0,0),(79,19)) rawMap
 
-testmap2 :: IO PlayMap
+testmap2 :: IO GraphicsMap
 testmap2 = do
                 g <- getStdGen
                 rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
@@ -250,8 +258,8 @@ testmap2 = do
 parseTemplate :: [Int] -> Text -> [MapEntry]
 parseTemplate (r:rs) t = 
         (case T.head t of
-                '~' -> (0, Water)
+                '~' -> (0, Ocean)
-                'S' -> (0, Sand)
+                'S' -> (0, Beach)
                 'G' -> (fromIntegral (r `mod` 10)/10.0,Grass)
                 'M' -> (fromIntegral ((r `mod` 10) + 20)/10.0, Mountain)
                 _ -> error "invalid template format for map"

src/Map/StaticMaps.hs

@@ -0,0 +1,37 @@
+module Map.StaticMaps
+where
+
+import Map.Types
+import Data.Array
+
+gauss2Dgeneral :: Floating q => q -> q -> q -> q -> q -> q -> q -> q
+gauss2Dgeneral amp x0 y0 sX sY x y = amp * exp (-(((x-x0)^2/(2 * sX^2))+((y-y0)^2/(2 * sY^2))))
+
+gauss2D :: Floating q => q -> q -> q
+gauss2D x y = gauss2Dgeneral 45 100.0 100.0 50.0 50.0 x y
+
+-- 2D Manhattan distance
+mnh2D :: (Int,Int) -> (Int,Int) -> Int
+mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
+
+-- entirely empty map, only uses the minimal constructor
+mapEmpty :: PlayMap
+mapEmpty = array ((0,0), (200,200)) [((a,b), (Minimal (a,b))) | a <- [0..200], b <- [0..200]]
+
+-- TODO: Stripify
+mapCenterMountain :: PlayMap
+mapCenterMountain = array ((0,0),(200,200)) nodes
+    where
+      nodes    = water ++ beach ++ grass ++ hill ++ mountain
+      water    = [((a,b), (Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) > 95] 
+      beach    = [((a,b), (Full (a,b) (g2d a b) Beach    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 95, (m2d (a,b)) > 75]
+      grass    = [((a,b), (Full (a,b) (g2d a b) Grass    BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 75, (m2d (a,b)) > 25]
+      hill     = [((a,b), (Full (a,b) (g2d a b) Hill     BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 25, (m2d (a,b)) > 10]
+      mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..200], b <- [0..200], (m2d (a,b)) <= 10]
+     
+      g2d :: Int -> Int -> Float
+      g2d x y = gauss2D (fromIntegral x) (fromIntegral y)
+
+      m2d :: (Int,Int) -> Int
+      m2d (x,y) = mnh2D (x,y) (100,100)
+

src/Map/Types.hs

@@ -0,0 +1,72 @@
+module Map.Types
+where
+
+import PioneerTypes
+
+import Data.Array
+
+type PlayMap = Array (XCoord, ZCoord) Node 
+
+type XCoord  = Int
+type ZCoord  = Int
+type YCoord  = Float 
+
+data MapType    = GrassIslandMap
+                | DesertMap
+
+-- | Ownership information, Parameter to occupied is player number
+data PlayerInfo = NoPlayer
+                | Occupied Int
+
+instance Show PlayerInfo where
+    show (NoPlayer)   = "not occupied"
+    show (Occupied i) = "occupied by player " ++ (show i)
+
+-- | Path info, is this node part of a path?
+data PathInfo   = NoPath
+                | Path
+                | Border
+                deriving (Show, Eq)
+
+-- | What resources can be harvested here?
+data ResInfo    = Plain
+                | ResInfo  Resource  Amount
+
+instance Show ResInfo where
+    show (Plain)           = "no resources"
+    show (ResInfo res amt) = "Resource: " ++ (show res) ++ "," ++ (show amt)
+
+-- | What commodities are currently stored here?
+type StorInfo   = [(Commodity,Amount)]
+
+-- | What kind of structures may be erected here?
+data BuildInfo  = BStruc Structure
+                | BNothing 
+                | BFlag
+                | BMine
+                | BSmall
+                | BMedium
+                | BLarge
+
+instance Show BuildInfo where
+    show (BStruc s) = "Structure: " ++ (show s)
+    show (BNothing) = "no Structure possible"
+    show (BFlag)    = "only flags possible"
+    show (BMine)    = "mines possible"
+    show (BSmall)   = "small buildings possible"
+    show (BMedium)  = "medium buildings possible"
+    show (BLarge)   = "large buildings possible"
+
+data TileType   = Ocean
+                | Beach
+                | Grass
+                | Desert
+                | Lake
+                | Hill     -- ^ Accessible
+                | Mountain -- ^ Not accessible
+                deriving (Show, Eq)
+
+-- TODO: Record Syntax
+data Node = Full    (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
+          | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 0
+          deriving (Show)

src/PioneerTypes.hs

@@ -0,0 +1,62 @@
+module PioneerTypes 
+where
+
+data Structure = Flag           -- Flag
+               | Woodcutter     -- Huts
+               | Forester
+               | Stonemason
+               | Fisher
+               | Hunter
+               | Barracks
+               | Guardhouse
+               | LookoutTower
+               | Well
+               | Sawmill        -- Houses
+               | Slaughterhouse
+               | Mill
+               | Bakery
+               | IronSmelter
+               | Metalworks
+               | Armory
+               | Mint
+               | Shipyard
+               | Brewery
+               | Storehouse
+               | Watchtower
+               | Catapult
+               | GoldMine       -- Mines
+               | IronMine
+               | GraniteMine
+               | CoalMine
+               | Farm           -- Castles
+               | PigFarm
+               | DonkeyBreeder
+               | Harbor
+               | Fortress
+               deriving (Show, Eq)
+
+data Amount    = Infinite   -- Neverending supply
+               | Finite Int -- Finite supply 
+
+-- Extremely preliminary, expand when needed
+data Commodity = WoodPlank
+               | Sword
+               | Fish
+               deriving Eq
+
+data Resource  = Coal
+               | Iron
+               | Gold
+               | Granite
+               | Water
+               | Fishes
+               deriving (Show, Eq)
+
+instance Show Amount where
+    show (Infinite) = "inexhaustable supply"
+    show (Finite n) = (show n) ++ " left"
+
+instance Show Commodity where
+    show WoodPlank = "wooden plank"
+    show Sword     = "sword" 
+    show Fish      = "fish"