Now generates a different unique map each time.
This commit is contained in:
parent
2b435b7cb2
commit
0a7a882f8f
@ -69,27 +69,3 @@ heightToTerrain GrassIslandMap y
|
|||||||
| y < 10 = Hill
|
| y < 10 = Hill
|
||||||
| otherwise = Mountain
|
| otherwise = Mountain
|
||||||
heightToTerrain _ _ = undefined
|
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)
|
|
||||||
|
@ -31,6 +31,7 @@ import Linear
|
|||||||
import Map.Types
|
import Map.Types
|
||||||
import Map.StaticMaps
|
import Map.StaticMaps
|
||||||
import Map.Creation
|
import Map.Creation
|
||||||
|
import Map.Combinators
|
||||||
|
|
||||||
type Height = Float
|
type Height = Float
|
||||||
|
|
||||||
@ -58,7 +59,7 @@ convertToGraphicsMap :: PlayMap -> GraphicsMap
|
|||||||
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
|
||||||
where
|
where
|
||||||
graphicsyfy :: Node -> MapEntry
|
graphicsyfy :: Node -> MapEntry
|
||||||
graphicsyfy (Minimal _ ) = (0, Grass)
|
graphicsyfy (Minimal _ ) = (1.0, Grass)
|
||||||
graphicsyfy (Full _ y t _ _ _ _ _ ) = (y, t)
|
graphicsyfy (Full _ y t _ _ _ _ _ ) = (y, t)
|
||||||
|
|
||||||
lineHeight :: GLfloat
|
lineHeight :: GLfloat
|
||||||
@ -89,8 +90,7 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
|
|||||||
|
|
||||||
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
|
||||||
getMapBufferObject = do
|
getMapBufferObject = do
|
||||||
let mountains = [(gaussMountain 123456), (gaussMountain 31415926),
|
mountains <- mnt
|
||||||
(gaussMountain 101514119), (gaussMountain 0)]
|
|
||||||
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty
|
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty
|
||||||
! myMap <- return $ generateTriangles myMap'
|
! myMap <- return $ generateTriangles myMap'
|
||||||
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
len <- return $ fromIntegral $ P.length myMap `div` numComponents
|
||||||
|
@ -68,5 +68,5 @@ data TileType = Ocean
|
|||||||
|
|
||||||
-- TODO: Record Syntax
|
-- TODO: Record Syntax
|
||||||
data Node = Full (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
|
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)
|
deriving (Show)
|
||||||
|
Loading…
Reference in New Issue
Block a user