diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 7200522..3c5b23f 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -41,6 +41,7 @@ type GraphicsMap = Array (Int, Int) MapEntry lineHeight :: GLfloat lineHeight = 0.8660254 +-- Number of GLfloats per Stride numComponents :: Int numComponents = 10 @@ -67,7 +68,6 @@ getMapBufferObject :: IO (BufferObject, NumArrayIndices) getMapBufferObject = do map' <- testmap ! 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 @@ -79,55 +79,6 @@ getMapBufferObject = do checkError "initBuffer" return (bo,len) -prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat)] -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 _ = [] - -generateCube :: [GLfloat] -generateCube = [ -- lower plane - -3.0,-3.0,-3.0, - 3.0,-3.0,3.0, - 3.0,-3.0,-3.0, - -3.0,-3.0,-3.0, - -3.0,-3.0,3.0, - 3.0,-3.0,3.0, - -- upper plane - -3.0,3.0,-3.0, - 3.0,3.0,3.0, - 3.0,3.0,-3.0, - -3.0,3.0,-3.0, - -3.0,3.0,3.0, - 3.0,3.0,3.0, - -- left plane - -3.0,-3.0,-3.0, - -3.0,3.0,3.0, - -3.0,-3.0,3.0, - -3.0,-3.0,-3.0, - -3.0,3.0,3.0, - -3.0,3.0,-3.0, - -- right plane - 3.0,-3.0,-3.0, - 3.0,3.0,3.0, - 3.0,-3.0,3.0, - 3.0,-3.0,-3.0, - 3.0,3.0,3.0, - 3.0,3.0,-3.0, - -- front plane - -3.0,-3.0,-3.0, - 3.0,3.0,-3.0, - 3.0,-3.0,-3.0, - -3.0,-3.0,-3.0, - 3.0,3.0,-3.0, - -3.0,3.0,-3.0, - -- back plane - -3.0,-3.0,3.0, - 3.0,3.0,3.0, - 3.0,-3.0,3.0, - -3.0,-3.0,3.0, - 3.0,3.0,3.0, - -3.0,3.0,3.0 - ] - generateTriangles :: GraphicsMap -> [GLfloat] generateTriangles map' = let ((xl,yl),(xh,yh)) = bounds map' in diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs index fb0a540..59316cf 100644 --- a/src/Map/StaticMaps.hs +++ b/src/Map/StaticMaps.hs @@ -2,8 +2,36 @@ module Map.StaticMaps where import Map.Types - import Data.Array -emptyMap :: PlayMap -emptyMap = array ((0,0), (100,100)) [((a,b), (Minimal (a,b) 0.5)) | a <- [0..100], b <- [0..100]] +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) 0.5)) | 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 index 22ca269..0f4ff5d 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -5,34 +5,58 @@ import PioneerTypes import Data.Array -type PlayMap = Array (XCoord, YCoord) Node +type PlayMap = Array (XCoord, ZCoord) Node type XCoord = Int -type YCoord = Int -type ZCoord = Float +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 = ResInfo Resource Amount +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? -data StorInfo = StorInfo Commodity Amount +type StorInfo = [(Commodity,Amount)] -- | What kind of structures may be erected here? -data BuildInfo = BStruc Structure +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 @@ -40,9 +64,9 @@ data TileType = Ocean | Lake | Hill -- ^ Accessible | Mountain -- ^ Not accessible - deriving (Eq) + deriving (Show, Eq) -- TODO: Record Syntax -data Node = Full (XCoord, YCoord) ZCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo - | Minimal (XCoord, YCoord) ZCoord -- defaults to empty green grass node on height 0.5 - +data Node = Full (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo + | Minimal (XCoord, ZCoord) YCoord -- defaults to empty green grass node on height 0.5 + deriving (Show) diff --git a/src/PioneerTypes.hs b/src/PioneerTypes.hs index dc84fa5..06027d7 100644 --- a/src/PioneerTypes.hs +++ b/src/PioneerTypes.hs @@ -33,7 +33,7 @@ data Structure = Flag -- Flag | DonkeyBreeder | Harbor | Fortress - deriving Eq + deriving (Show, Eq) data Amount = Infinite -- Neverending supply | Finite Int -- Finite supply @@ -50,4 +50,13 @@ data Resource = Coal | Granite | Water | Fishes - deriving Eq + 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"