From a727131f13f36d0fa7958b9db80c01a092e4ebb2 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Thu, 24 Apr 2014 14:24:20 +0200 Subject: [PATCH] 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)