diff --git a/Pioneers.cabal b/Pioneers.cabal index 70212e5..faa8198 100644 --- a/Pioneers.cabal +++ b/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, diff --git a/src/Main.hs b/src/Main.hs index b3f83b3..155c934 100644 --- a/src/Main.hs +++ b/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, diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs new file mode 100644 index 0000000..12f04eb --- /dev/null +++ b/src/Map/Creation.hs @@ -0,0 +1,7 @@ +module Map.Creation +where + +import Map.Types + +newMap :: Int -> Int -> PlayMap +newMap = undefined diff --git a/src/Map/Map.hs b/src/Map/Graphics.hs similarity index 84% rename from src/Map/Map.hs rename to src/Map/Graphics.hs index 586a019..f8562a5 100644 --- a/src/Map/Map.hs +++ b/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.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" diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs new file mode 100644 index 0000000..1283981 --- /dev/null +++ b/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) + diff --git a/src/Map/Types.hs b/src/Map/Types.hs new file mode 100644 index 0000000..f55afc1 --- /dev/null +++ b/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) diff --git a/src/PioneerTypes.hs b/src/PioneerTypes.hs new file mode 100644 index 0000000..06027d7 --- /dev/null +++ b/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"