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

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

Browse Source 
Conflicts:
	Pioneers.cabal
This commit is contained in:
Nicole Dresselhaus 2014-04-05 23:12:33 +02:00
commit 38d807b9b1
7 changed files with 220 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Pioneers.cabal
View File

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

2
src/Main.hs
View File

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

7
src/Map/Creation.hs Normal file
View File

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

60
src/Map/Map.hs → src/Map/Graphics.hs
View File

@ -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
@ -29,24 +30,28 @@ import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Render.Misc (checkError)
import Linear
data TileType =
Grass
| Sand
| Water
| Mountain
deriving (Show, Eq)
import Map.Types
import Map.StaticMaps
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)
Sand -> (0.9, 0.85, 0.7)
Grass -> (0.3, 0.9, 0.1)
Mountain -> (0.5, 0.5, 0.5)
Ocean -> (0.50, 0.50, 1.00)
Lake -> (0.40, 0.87 ,1.00)
Beach -> (0.90, 0.85, 0.70)
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)
'S' -> (0, Sand)
'~' -> (0, Ocean)
'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"

37
src/Map/StaticMaps.hs Normal file
View File

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

72
src/Map/Types.hs Normal file
View File

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

62
src/PioneerTypes.hs Normal file
View File

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