More higher order functions
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 2 Mar 2009 07:49:23 +0000 (08:49 +0100)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 2 Mar 2009 07:49:23 +0000 (08:49 +0100)
src/Lseed/Data/Functions.hs
src/main.hs

index 1ed38c0..c40904e 100644 (file)
@@ -37,3 +37,16 @@ subPieceAccumulate p = go p
                                           extractOutmost p2'
                                   in  Fork x' angle p1' p2'
 
+-- | Apply a function to each Planted in a Garden
+mapGarden :: (Planted a -> Planted b) -> Garden a -> Garden b
+mapGarden = map
+
+-- | Apply a function to each Planted in a Garden, with an extra argument from a list
+--   
+--   You need to make sure that the list is long enough!
+zipWithGarden :: (Planted a -> x -> Planted b) -> Garden a -> [x] -> Garden b
+zipWithGarden = zipWith
+
+-- | Apply a function to the Plant in a Planted
+mapPlanted :: (Plant a -> Plant b) -> Planted a -> Planted b
+mapPlanted f planted = planted { phenotype = f (phenotype planted) }
index c20e75e..4b5392b 100644 (file)
@@ -1,5 +1,6 @@
 import Lseed.Renderer.Cairo
 import Lseed.Data
+import Lseed.Data.Functions
 import Lseed.LSystem
 import Data.List
 import Control.Concurrent
@@ -53,8 +54,8 @@ remainingGrowth planted = go (phenotype planted)
 
 
 growGarden :: (RandomGen g) => g -> Garden () -> GrowingGarden
-growGarden rgen = snd . mapAccumL go rgen 
-  where go rgen planted = let (rgen1,rgen2) = split rgen in (rgen2, growPlanted rgen1 planted)
+growGarden rgen garden = zipWithGarden (flip growPlanted) garden rgens
+  where rgens = unfoldr (Just . split) rgen
 
 -- | Applies an L-System to a Plant, putting the new length in the additional
 --   information field
@@ -71,7 +72,7 @@ applyGrowth :: Double -> GrowingGarden -> Garden ()
 applyGrowth r = applyGrowth' (\a b -> a * (1-r) + b * r)
 
 applyGrowth' :: (Double -> Double -> Double) -> GrowingGarden -> Garden ()
-applyGrowth' f = map (\planted -> planted { phenotype = go (phenotype planted) })
+applyGrowth' f = mapGarden (mapPlanted go)
   where go (Bud Nothing) = Bud ()
         go (Stipe Nothing l p) = Stipe () l (go p)
         go (Fork Nothing a p1 p2) = Fork () a (go p1) (go p2)