Added first map prototype (unstripyfied), added show instances (for dev), this and that

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

src/Map/StaticMaps.hs

@@ -2,8 +2,36 @@ module Map.StaticMaps
 where
 
 import Map.Types
-
 import Data.Array
 
-emptyMap :: PlayMap
+gauss2Dgeneral :: Floating q => q -> q -> q -> q -> q -> q -> q -> q
-emptyMap = array ((0,0), (100,100)) [((a,b), (Minimal (a,b) 0.5)) | a <- [0..100], b <- [0..100]]
+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)
+

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  = Int
-type ZCoord  = Float 
+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
+                | 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
+data Node = Full    (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
-          | Minimal (XCoord, YCoord) ZCoord -- defaults to empty green grass node on height 0.5
+          | Minimal (XCoord, ZCoord) YCoord -- defaults to empty green grass node on height 0.5
-
+          deriving (Show)

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"