From 2b435b7cb20758f8357e521325f2f229445c60ee Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Thu, 24 Apr 2014 02:45:55 +0200 Subject: [PATCH 1/4] Added first primitive groundwork for map generation combinators. This is gonna be fun! :o) --- src/Map/Creation.hs | 56 ++++++++++++++++++++++++++++++++++++++++++- src/Map/Graphics.hs | 5 +++- src/Map/Map.hs | 43 ++++++++++++++++++++++++++++----- src/Map/StaticMaps.hs | 25 +------------------ 4 files changed, 97 insertions(+), 32 deletions(-) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 0f2c60f..8f302c2 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -2,7 +2,19 @@ module Map.Creation where import Map.Types +import Map.Map + import Data.Array +import System.Random + +-- Orphan instance since this isn't where either Random nor Tuples are defined +instance (Random x, Random y) => Random (x, y) where + randomR ((x1, y1), (x2, y2)) gen1 = let (a, gen2) = randomR (x1, x2) gen1 + (b, gen3) = randomR (y1, y2) gen2 + in ((a, b), gen3) + + random gen1 = let (a, gen2) = random gen1 + (b, gen3) = random gen2 in ((a,b), gen3) -- | Generate a new Map of given Type and Size -- @@ -18,6 +30,32 @@ aplByPlace f g mp = array (bounds mp) (map (\(ab,c) -> if g ab then (ab, f c) el aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp)) +aplAll :: [a -> a] -> a -> a +aplAll [] m = m +aplAll (f:fs) m = aplAll fs $ f m + +-- general 3D-Gaussian +gauss3Dgeneral :: Floating q => + q -- ^ Amplitude + -> q -- ^ Origin on X-Achsis + -> q -- ^ Origin on Z-Achsis + -> q -- ^ Sigma on X + -> q -- ^ Sigma on Z + -> q -- ^ Coordinate in question on X + -> q -- ^ Coordinate in question on Z + -> q -- ^ elevation on coordinate in question +gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer))))) + +-- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15 +gauss3D :: Floating q => + q -- ^ X-Coordinate + -> q -- ^ Z-Coordinate + -> q -- ^ elevation on coordinate in quesion +gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 + +-- 2D Manhattan distance +mnh2D :: (Int,Int) -> (Int,Int) -> Int +mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d) -- | Basic Terrain-Generator. Will not implement "abnormal" Stuff for given Biome -- (like Deserts on Grass-Islands or Grass on Deserts) @@ -38,4 +76,20 @@ type Seed = (XCoord, ZCoord) -- -- TODO: implement and erode terrain on the way down. addLakes :: PlayMap -> [Seed] -> PlayMap -addLakes m s = undefined +addLakes = undefined + +gaussMountain :: Int -> PlayMap -> PlayMap +gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp + where + g = mkStdGen seed + c = head $ randomRs (bounds mp) g + fi = fromIntegral + htt = heightToTerrain + + -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map + liftUp :: (Int, Int) -> Node -> Node + liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e + in (Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s) + where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z) + liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] + where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z) diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index d551790..2a35ea9 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -30,6 +30,7 @@ import Linear import Map.Types import Map.StaticMaps +import Map.Creation type Height = Float @@ -88,7 +89,9 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal getMapBufferObject :: IO (BufferObject, NumArrayIndices) getMapBufferObject = do - myMap' <- return $ convertToGraphicsMap $ convertToStripeMap mapNoise + let mountains = [(gaussMountain 123456), (gaussMountain 31415926), + (gaussMountain 101514119), (gaussMountain 0)] + myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty ! myMap <- return $ generateTriangles myMap' len <- return $ fromIntegral $ P.length myMap `div` numComponents putStrLn $ P.unwords ["num verts in map:",show len] diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 0abaf38..b88a3b8 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -2,12 +2,43 @@ module Map.Map where import Map.Types --- potentially to be expanded to Nodes -giveNeighbours :: (Int, Int) -> [(Int,Int)] -giveNeighbours (x,y) = filter (not . negative) all +import Data.Array (bounds) +import Data.List (sort, group) + +-- WARNING: Does NOT Check for neighbours exceeding maximum map coordinates yet. +unsafeGiveNeighbours :: (Int, Int) -- ^ original coordinates + -> [(Int,Int)] -- ^ list of neighbours +unsafeGiveNeighbours (x,z) = filter (not . negative) allNs where - all = if even y then [(x+1,y), (x-1,y), (x,y+1), (x,y-1), (x+1,y+1), (x+1,y-1)] - else [(x+1,y), (x-1,y), (x,y+1), (x,y-1), (x-1,y+1), (x-1,y-1)] + allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)] + else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)] negative :: (Int, Int) -> Bool - negative (x,y) = x < 0 || y < 0 + negative (a,b) = a < 0 || b < 0 + +giveNeighbours :: PlayMap -- ^ Map on which to find neighbours + -> (Int, Int) -- ^ original coordinates + -> [(Int, Int)] -- ^ list of neighbours +giveNeighbours mp (x,z) = filter (not . outOfBounds mp) allNs + where + allNs = if even z then [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x+1,z+1), (x+1,z-1)] + else [(x+1,z), (x-1,z), (x,z+1), (x,z-1), (x-1,z+1), (x-1,z-1)] + + outOfBounds :: PlayMap -> (Int, Int) -> Bool + outOfBounds mp' (a,b) = let (lo,hi) = bounds mp' in + a < fst lo || b < snd lo || a > fst hi || b > snd hi + +giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood + -> Int -- ^ iterative + -> (Int, Int) -- ^ original coordinates + -> [(Int, Int)] -- ^ neighbourhood +giveNeighbourhood _ 0 (a,b) = [(a,b)] +giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in + remdups . concat $ ns:(map (giveNeighbourhood mp (n-1)) ns) + +-- removing duplicates in O(n log n), losing order and adding Ord requirement +remdups :: Ord a => [a] -> [a] +remdups = map head . group . sort + +prop_rd_idempot :: Ord a => [a] -> Bool +prop_rd_idempot xs = remdups xs == (remdups . remdups) xs diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs index abe047e..9507a82 100644 --- a/src/Map/StaticMaps.hs +++ b/src/Map/StaticMaps.hs @@ -3,30 +3,7 @@ where import Map.Types import Data.Array -import Map.Creation (heightToTerrain) - --- general 3D-Gaussian -gauss3Dgeneral :: Floating q => - q -- ^ Amplitude - -> q -- ^ Origin on X-Achsis - -> q -- ^ Origin on Z-Achsis - -> q -- ^ Sigma on X - -> q -- ^ Sigma on Z - -> q -- ^ Coordinate in question on X - -> q -- ^ Coordinate in question on Z - -> q -- ^ elevation on coordinate in question -gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer))))) - --- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15 -gauss3D :: Floating q => - q -- ^ X-Coordinate - -> q -- ^ Z-Coordinate - -> q -- ^ elevation on coordinate in quesion -gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 - --- 2D Manhattan distance -mnh2D :: (Int,Int) -> (Int,Int) -> Int -mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d) +import Map.Creation -- entirely empty map, only uses the minimal constructor mapEmpty :: PlayMap From 0a7a882f8fd6b02d2cb521a79a73e0f100e13801 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Thu, 24 Apr 2014 12:44:58 +0200 Subject: [PATCH 2/4] Now generates a different unique map each time. --- src/Map/Creation.hs | 24 ------------------------ src/Map/Graphics.hs | 6 +++--- src/Map/Types.hs | 2 +- 3 files changed, 4 insertions(+), 28 deletions(-) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 8f302c2..04d018d 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -69,27 +69,3 @@ heightToTerrain GrassIslandMap y | y < 10 = Hill | otherwise = Mountain heightToTerrain _ _ = undefined - -type Seed = (XCoord, ZCoord) - --- | Add lakes on generated Map from (possible) Seeds noted before. --- --- TODO: implement and erode terrain on the way down. -addLakes :: PlayMap -> [Seed] -> PlayMap -addLakes = undefined - -gaussMountain :: Int -> PlayMap -> PlayMap -gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp - where - g = mkStdGen seed - c = head $ randomRs (bounds mp) g - fi = fromIntegral - htt = heightToTerrain - - -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map - liftUp :: (Int, Int) -> Node -> Node - liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e - in (Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s) - where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z) - liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] - where e = gauss3Dgeneral 10.0 (fi gx) (fi gz) 5.0 5.0 (fi x) (fi z) diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 2a35ea9..bf1dcfe 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -31,6 +31,7 @@ import Linear import Map.Types import Map.StaticMaps import Map.Creation +import Map.Combinators type Height = Float @@ -58,7 +59,7 @@ convertToGraphicsMap :: PlayMap -> GraphicsMap convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp] where graphicsyfy :: Node -> MapEntry - graphicsyfy (Minimal _ ) = (0, Grass) + graphicsyfy (Minimal _ ) = (1.0, Grass) graphicsyfy (Full _ y t _ _ _ _ _ ) = (y, t) lineHeight :: GLfloat @@ -89,8 +90,7 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal getMapBufferObject :: IO (BufferObject, NumArrayIndices) getMapBufferObject = do - let mountains = [(gaussMountain 123456), (gaussMountain 31415926), - (gaussMountain 101514119), (gaussMountain 0)] + mountains <- mnt myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty ! myMap <- return $ generateTriangles myMap' len <- return $ fromIntegral $ P.length myMap `div` numComponents diff --git a/src/Map/Types.hs b/src/Map/Types.hs index d3fe76c..66ddb4a 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -68,5 +68,5 @@ data TileType = Ocean -- 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 + | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 1 deriving (Show) From a727131f13f36d0fa7958b9db80c01a092e4ebb2 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Thu, 24 Apr 2014 14:24:20 +0200 Subject: [PATCH 3/4] Forgot Combinator module --- src/Map/Combinators.hs | 46 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 src/Map/Combinators.hs diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs new file mode 100644 index 0000000..3e143c2 --- /dev/null +++ b/src/Map/Combinators.hs @@ -0,0 +1,46 @@ +module Map.Combinators where + +import Map.Types +import Map.Creation + +import Data.Array +import System.Random + +-- preliminary +infix 5 ->- +(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) +f ->- g = (g . f) + +-- also preliminary +infix 5 -<- +(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) +f -<- g = (f . g) + +lake :: Int -> PlayMap -> PlayMap +lake = undefined + +river :: Int -> PlayMap -> PlayMap +river = undefined + +mnt :: IO [PlayMap -> PlayMap] +mnt = do g <- newStdGen + let seeds = take 10 $ randoms g + return $ map gaussMountain seeds + +gaussMountain :: Int -> PlayMap -> PlayMap +gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp + where + g = mkStdGen seed + c = head $ randomRs (bounds mp) g + amp = head $ randomRs (5.0, 20.0) g + sig = head $ randomRs (5.0, 25.0) g + fi = fromIntegral + htt = heightToTerrain + + -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map + liftUp :: (Int, Int) -> Node -> Node + liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e + in (Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s) + where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) + liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] + where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) From 60fd2172337ff6a8c7c54a120e33bd36b1c00878 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Fri, 25 Apr 2014 15:58:25 +0200 Subject: [PATCH 4/4] hlint all around --- src/Map/Combinators.hs | 10 +++++----- src/Map/Creation.hs | 3 +-- src/Map/Graphics.hs | 5 +++-- src/Map/Map.hs | 2 +- src/Map/StaticMaps.hs | 33 ++++++++++++++++----------------- src/Map/Types.hs | 6 +++--- 6 files changed, 29 insertions(+), 30 deletions(-) diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs index 3e143c2..9dabb89 100644 --- a/src/Map/Combinators.hs +++ b/src/Map/Combinators.hs @@ -8,13 +8,13 @@ import System.Random -- preliminary infix 5 ->- -(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -f ->- g = (g . f) +(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap +f ->- g = g . f -- also preliminary infix 5 -<- -(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -f -<- g = (f . g) +(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap +f -<- g = f . g lake :: Int -> PlayMap -> PlayMap lake = undefined @@ -40,7 +40,7 @@ gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map liftUp :: (Int, Int) -> Node -> Node liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e - in (Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s) + in Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 04d018d..d677cdd 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -31,8 +31,7 @@ aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp)) aplAll :: [a -> a] -> a -> a -aplAll [] m = m -aplAll (f:fs) m = aplAll fs $ f m +aplAll fs m = foldl (\ m f -> f m) m fs -- general 3D-Gaussian gauss3Dgeneral :: Floating q => diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index bf1dcfe..5cc198a 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -27,6 +27,7 @@ import Foreign.Storable (sizeOf) import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Render.Misc (checkError) import Linear +import Control.Arrow ((***)) import Map.Types import Map.StaticMaps @@ -43,7 +44,7 @@ type GraphicsMap = Array (Int, Int) MapEntry -- converts from classical x/z to striped version of a map convertToStripeMap :: PlayMap -> PlayMap -convertToStripeMap mp = array (stripify l, stripify u) (map (\(i,e) -> (stripify i,strp e)) (assocs mp)) +convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp)) where (l,u) = bounds mp @@ -77,7 +78,7 @@ bufferObjectPtr = plusPtr (nullPtr :: Ptr GLfloat) . fromIntegral mapVertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor GLfloat mapVertexArrayDescriptor count' offset = - VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset)) + VertexArrayDescriptor count' Float mapStride (bufferObjectPtr (fromIntegral offset * sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset)) fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat) fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first diff --git a/src/Map/Map.hs b/src/Map/Map.hs index b88a3b8..e358cee 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -34,7 +34,7 @@ giveNeighbourhood :: PlayMap -- ^ map on which to find neighbourhood -> [(Int, Int)] -- ^ neighbourhood giveNeighbourhood _ 0 (a,b) = [(a,b)] giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in - remdups . concat $ ns:(map (giveNeighbourhood mp (n-1)) ns) + remdups . concat $ ns : map (giveNeighbourhood mp (n-1)) ns -- removing duplicates in O(n log n), losing order and adding Ord requirement remdups :: Ord a => [a] -> [a] diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs index 9507a82..74ea371 100644 --- a/src/Map/StaticMaps.hs +++ b/src/Map/StaticMaps.hs @@ -7,17 +7,17 @@ import Map.Creation -- entirely empty map, only uses the minimal constructor mapEmpty :: PlayMap -mapEmpty = array ((0,0), (199,199)) [((a,b), (Minimal (a,b))) | a <- [0..199], b <- [0..199]] +mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]] mapCenterMountain :: PlayMap mapCenterMountain = array ((0,0),(199,199)) nodes where nodes = water ++ beach ++ grass ++ hill ++ mountain - water = [((a,b), (Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) > 95] - beach = [((a,b), (Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 95, (m2d (a,b)) > 75] - grass = [((a,b), (Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 75, (m2d (a,b)) > 25] - hill = [((a,b), (Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 25, (m2d (a,b)) > 10] - mountain = [((a,b), (Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain [])) | a <- [0..199], b <- [0..199], (m2d (a,b)) <= 10] + water = [((a,b), Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) > 95] + beach = [((a,b), Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 95, m2d (a,b) > 75] + grass = [((a,b), Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 75, m2d (a,b) > 25] + hill = [((a,b), Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 25, m2d (a,b) > 10] + mountain = [((a,b), Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 10] g2d :: Int -> Int -> Float g2d x y = gauss3D (fromIntegral x) (fromIntegral y) @@ -28,7 +28,7 @@ mapCenterMountain = array ((0,0),(199,199)) nodes -- small helper for some hills. Should be replaced by multi-layer perlin-noise -- TODO: Replace as given in comment. _noisyMap :: (Floating q) => q -> q -> q -_noisyMap = \x y -> gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y +_noisyMap x y = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y + gauss3Dgeneral 5 10.0 10.0 10.0 10.0 x y + gauss3Dgeneral 5 150.0 120.0 10.0 10.0 x y + gauss3Dgeneral 5 50.0 75.0 10.0 10.0 x y @@ -38,14 +38,13 @@ _noisyMap = \x y -> gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y mapNoise :: PlayMap mapNoise = array ((0,0),(199,199)) nodes where - nodes = [((a,b), (Full - (a,b) - (height a b) - (heightToTerrain GrassIslandMap $ height a b) - BNothing - NoPlayer - NoPath - Plain - [])) | a <- [0..199], b <- [0..199]] + nodes = [((a,b), Full (a,b) + (height a b) + (heightToTerrain GrassIslandMap $ height a b) + BNothing + NoPlayer + NoPath + Plain + []) | a <- [0..199], b <- [0..199]] where - height a b = (_noisyMap (fromIntegral a) (fromIntegral b)) + height a b = _noisyMap (fromIntegral a) (fromIntegral b) diff --git a/src/Map/Types.hs b/src/Map/Types.hs index 66ddb4a..c62837f 100644 --- a/src/Map/Types.hs +++ b/src/Map/Types.hs @@ -20,7 +20,7 @@ data PlayerInfo = NoPlayer instance Show PlayerInfo where show (NoPlayer) = "not occupied" - show (Occupied i) = "occupied by player " ++ (show i) + show (Occupied i) = "occupied by player " ++ show i -- | Path info, is this node part of a path and if so, where does it lead? data PathInfo = NoPath @@ -34,7 +34,7 @@ data ResInfo = Plain instance Show ResInfo where show (Plain) = "no resources" - show (ResInfo res amt) = "Resource: " ++ (show res) ++ "," ++ (show amt) + show (ResInfo res amt) = "Resource: " ++ show res ++ "," ++ show amt -- | What commodities are currently stored here? type StorInfo = [(Commodity,Amount)] @@ -49,7 +49,7 @@ data BuildInfo = BStruc Structure | BLarge instance Show BuildInfo where - show (BStruc s) = "Structure: " ++ (show s) + show (BStruc s) = "Structure: " ++ show s show (BNothing) = "no Structure possible" show (BFlag) = "only flags possible" show (BMine) = "mines possible"