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

66
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
@ -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.Ptr (Ptr, nullPtr, plusPtr)
import Render.Misc (checkError)
import Foreign.Storable (sizeOf)
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"