Forgot Combinator module
This commit is contained in:
parent
0a7a882f8f
commit
a727131f13
46
src/Map/Combinators.hs
Normal file
46
src/Map/Combinators.hs
Normal file
@ -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)
|
Loading…
Reference in New Issue
Block a user