Merge remote-tracking branch 'origin/Mapping' into tessallation
This commit is contained in:
commit
2ecf4fe5c4
@ -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)
|
||||
@ -31,11 +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 m s = undefined
|
||||
|
||||
@ -30,6 +30,8 @@ import Linear
|
||||
|
||||
import Map.Types
|
||||
import Map.StaticMaps
|
||||
import Map.Creation
|
||||
import Map.Combinators
|
||||
|
||||
type Height = Float
|
||||
|
||||
@ -57,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
|
||||
@ -88,7 +90,8 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
||||
|
||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||
getMapBufferObject = do
|
||||
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap mapNoise
|
||||
mountains <- mnt
|
||||
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]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user