Restructured Node constructors. Ripples are getting worse! (╯°□°)╯︵ ┻━┻
This commit is contained in:
parent
67428146ca
commit
eb3ee975e8
@ -16,7 +16,6 @@ executable Pioneers
|
|||||||
Map.Types,
|
Map.Types,
|
||||||
Map.Graphics,
|
Map.Graphics,
|
||||||
Map.Creation,
|
Map.Creation,
|
||||||
Map.StaticMaps,
|
|
||||||
Importer.IQM.Types,
|
Importer.IQM.Types,
|
||||||
Importer.IQM.Parser,
|
Importer.IQM.Parser,
|
||||||
Render.Misc,
|
Render.Misc,
|
||||||
|
@ -2,7 +2,6 @@ module Map.Creation
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Map.Types
|
import Map.Types
|
||||||
import Map.StaticMaps
|
|
||||||
-- import Map.Map unused (for now)
|
-- import Map.Map unused (for now)
|
||||||
|
|
||||||
import Data.Array
|
import Data.Array
|
||||||
@ -18,6 +17,10 @@ infix 5 -<-
|
|||||||
(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
|
(-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
|
||||||
f -<- g = f . g
|
f -<- g = f . g
|
||||||
|
|
||||||
|
-- entirely empty map, only uses the minimal constructor
|
||||||
|
mapEmpty :: PlayMap
|
||||||
|
mapEmpty = array ((0,0), (199,199)) [((a,b), Node (a,b) (fromIntegral a, (if even b then (fromIntegral b) else(fromIntegral b) - 0.5), 1) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199]]
|
||||||
|
|
||||||
exportedMap :: IO PlayMap
|
exportedMap :: IO PlayMap
|
||||||
exportedMap = do mounts <- mnt
|
exportedMap = do mounts <- mnt
|
||||||
return $ aplAll mounts mapEmpty
|
return $ aplAll mounts mapEmpty
|
||||||
@ -52,7 +55,7 @@ gauss3Dgeneral :: Floating q =>
|
|||||||
-> q -- ^ Coordinate in question on X
|
-> q -- ^ Coordinate in question on X
|
||||||
-> q -- ^ Coordinate in question on Z
|
-> q -- ^ Coordinate in question on Z
|
||||||
-> q -- ^ elevation on coordinate in question
|
-> 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)))))
|
gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Int)/(2 * sX^(2 :: Int)))+((z-z0)^(2 :: Int)/(2 * sZ^(2 :: Int)))))
|
||||||
|
|
||||||
-- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
|
-- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
|
||||||
gauss3D :: Floating q =>
|
gauss3D :: Floating q =>
|
||||||
@ -93,20 +96,17 @@ mnt = do g <- newStdGen
|
|||||||
gaussMountain :: Int -> PlayMap -> PlayMap
|
gaussMountain :: Int -> PlayMap -> PlayMap
|
||||||
gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
|
gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
|
||||||
where
|
where
|
||||||
g = mkStdGen seed
|
gs = map mkStdGen (map (*seed) [1..])
|
||||||
c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g)))
|
c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) (gs !! 0)), (head (randomRs (b,y) (gs !! 1))))
|
||||||
amp = head $ randomRs (5.0, 20.0) g
|
amp = head $ randomRs ((5.0, 20.0) :: (Float, Float)) (gs !! 2)
|
||||||
sig = head $ randomRs (5.0, 25.0) g
|
sig = head $ randomRs ((5.0, 25.0) :: (Float, Float)) (gs !! 3)
|
||||||
fi = fromIntegral
|
|
||||||
htt = heightToTerrain
|
htt = heightToTerrain
|
||||||
|
|
||||||
-- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
|
-- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
|
||||||
liftUp :: (Int, Int) -> Node -> Node
|
liftUp :: (Int, Int) -> Node -> Node
|
||||||
liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e
|
liftUp (gx,gz) (Node (x,z) (rx,rz,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 Node (x,z) (rx, rz, 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)
|
where e = gauss3Dgeneral amp (fromIntegral gx) (fromIntegral gz) sig sig rx rz
|
||||||
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)
|
|
||||||
|
|
||||||
-- | Makes sure the edges of the Map are mountain-free
|
-- | Makes sure the edges of the Map are mountain-free
|
||||||
makeIsland :: PlayMap -> PlayMap
|
makeIsland :: PlayMap -> PlayMap
|
||||||
|
@ -50,16 +50,14 @@ stripify :: (Int,Int) -> (Int,Int)
|
|||||||
stripify (x,z) = (if even z then 2*x else 2*x+1, z `div` 2)
|
stripify (x,z) = (if even z then 2*x else 2*x+1, z `div` 2)
|
||||||
|
|
||||||
strp :: Node -> Node
|
strp :: Node -> Node
|
||||||
strp (Full xz y tt bi pli p ri si) = Full (stripify xz) y tt bi pli p ri si
|
strp (Node i (x,z,y) tt bi pli p ri si) = Node (stripify i) (x,z,y) tt bi pli p ri si
|
||||||
strp (Minimal xz ) = Minimal (stripify xz)
|
|
||||||
|
|
||||||
-- extract graphics information from Playmap
|
-- extract graphics information from Playmap
|
||||||
convertToGraphicsMap :: PlayMap -> GraphicsMap
|
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 _ ) = (1.0, Grass)
|
graphicsyfy (Node _ (_,_,y) t _ _ _ _ _ ) = (y, t)
|
||||||
graphicsyfy (Full _ y t _ _ _ _ _ ) = (y, t)
|
|
||||||
|
|
||||||
lineHeight :: GLfloat
|
lineHeight :: GLfloat
|
||||||
lineHeight = 0.8660254
|
lineHeight = 0.8660254
|
||||||
|
@ -61,10 +61,7 @@ giveMapHeight mp (x,z) = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc]
|
|||||||
|
|
||||||
-- Height LookUp
|
-- Height LookUp
|
||||||
hlu :: (Int, Int) -> Float
|
hlu :: (Int, Int) -> Float
|
||||||
hlu (k,j) = let node = mp ! (k,j)
|
hlu (k,j) = let (Node _ (_,_,y) _ _ _ _ _ _) = mp ! (k,j) in y
|
||||||
in case node of
|
|
||||||
(Full _ y _ _ _ _ _ _) -> y
|
|
||||||
(Minimal _ ) -> 1.0
|
|
||||||
|
|
||||||
ff = (floor x, floor z) :: (Int, Int)
|
ff = (floor x, floor z) :: (Int, Int)
|
||||||
fc = (floor x, ceiling z) :: (Int, Int)
|
fc = (floor x, ceiling z) :: (Int, Int)
|
||||||
|
@ -1,49 +0,0 @@
|
|||||||
module Map.StaticMaps
|
|
||||||
where
|
|
||||||
|
|
||||||
import Map.Types
|
|
||||||
import Data.Array
|
|
||||||
|
|
||||||
-- 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]]
|
|
||||||
|
|
||||||
--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]
|
|
||||||
|
|
||||||
-- g2d :: Int -> Int -> Float
|
|
||||||
-- g2d x y = gauss3D (fromIntegral x) (fromIntegral y)
|
|
||||||
|
|
||||||
-- m2d :: (Int,Int) -> Int
|
|
||||||
-- m2d (x,y) = mnh2D (x,y) (100,100)
|
|
||||||
|
|
||||||
-- 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
|
|
||||||
-- + 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
|
|
||||||
|
|
||||||
-- generates a noisy map
|
|
||||||
-- TODO: add real noise to a simple pattern
|
|
||||||
--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]]
|
|
||||||
-- where
|
|
||||||
-- height a b = _noisyMap (fromIntegral a) (fromIntegral b)
|
|
@ -5,10 +5,12 @@ import Types
|
|||||||
|
|
||||||
import Data.Array
|
import Data.Array
|
||||||
|
|
||||||
type PlayMap = Array (XCoord, ZCoord) Node
|
type PlayMap = Array (Xindex, Zindex) Node
|
||||||
|
|
||||||
type XCoord = Int
|
type Xindex = Int
|
||||||
type ZCoord = Int
|
type Zindex = Int
|
||||||
|
type XCoord = Float
|
||||||
|
type ZCoord = Float
|
||||||
type YCoord = Float
|
type YCoord = Float
|
||||||
|
|
||||||
data MapType = GrassIslandMap
|
data MapType = GrassIslandMap
|
||||||
@ -66,7 +68,6 @@ data TileType = Ocean
|
|||||||
| Mountain -- ^ Not accessible
|
| Mountain -- ^ Not accessible
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- TODO: Record Syntax
|
-- TODO: Record Syntax?
|
||||||
data Node = Full (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
|
data Node = Node (Xindex, Zindex) (XCoord, ZCoord, YCoord) TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
|
||||||
| Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 1
|
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
Loading…
Reference in New Issue
Block a user