Groths depends on light
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 2 Mar 2009 09:03:01 +0000 (10:03 +0100)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 2 Mar 2009 09:03:01 +0000 (10:03 +0100)
Per tick (fraction of a day), calculate the currently gathered light and
grow slower if required.

src/Lseed/Constants.hs
src/Lseed/Data.hs
src/Lseed/Geometry.hs
src/main.hs

index 588b002..2be4e6e 100644 (file)
@@ -5,3 +5,24 @@ groundLevel = 0.03
 budSize     = 0.01
 stipeLength = 0.05
 stipeWidth  = 0.01
+
+-- | Light and growths interpolation frequency
+ticksPerDay = 9
+
+-- | Plant length growth per Day and Light
+--
+-- 1 means: Can grow one stipeLength during one day, when catching the sunlight with one branch of (projected) length screenwidth
+growthPerDayAndLight = 15.0
+
+-- | Default growth (for plants without light)
+growthPerDay = 0.5
+
+-- | Length of one day, in seconds
+dayLength = 10 
+
+-- | ε
+eps = 1e-9
+
+
+-- | Derived constants
+tickLength = fromIntegral dayLength / fromIntegral ticksPerDay
index cdc6ab4..fe6c716 100644 (file)
@@ -50,6 +50,9 @@ data ScreenContent = ScreenContent
        , scTime       :: String
        }
 
+-- | Light angle
+type Angle = Double
+
 -- Instances
 instance Functor Plant where
        fmap f (Bud x) = Bud (f x)
index 219302e..a13db2b 100644 (file)
@@ -20,8 +20,6 @@ type Line  = (Point, Point)
 
 lightFalloff = 0.7
 
-eps = 1e-9
-
 lineLength ((x1,y1),(x2,y2)) = sqrt ((x1-x2)^2 + (y1-y2)^2)
 
 -- | from http://www.pdas.com/lineint.htm
index 4b5392b..194e93e 100644 (file)
@@ -2,46 +2,56 @@ import Lseed.Renderer.Cairo
 import Lseed.Data
 import Lseed.Data.Functions
 import Lseed.LSystem
+import Lseed.Constants
+import Lseed.Geometry
 import Data.List
 import Control.Concurrent
 import Control.Monad
 import System.Random
 import System.Time
 import Text.Printf
+import Debug.Trace
 
--- | Length of one day, in seconds
-dayLength = 10 
-
-
-timeSpanFraction :: ClockTime -> ClockTime -> Double
-timeSpanFraction (TOD sa pa) (TOD sb pb) = 
+timeSpanFraction :: Double -> ClockTime -> ClockTime -> Double
+timeSpanFraction spanLenght (TOD sa pa) (TOD sb pb) = 
        min 1 $ max 0 $
        (fromIntegral $ (sb - sa) * 1000000000000 + (pb-pa)) /
-        (fromIntegral $ dayLength * 1000000000000 )
+        (spanLenght * 1000000000000 )
 
 formatTimeInfo :: Integer -> Double -> String
 formatTimeInfo day frac = let minutes = floor (frac * 12 * 60) :: Integer
                              (hour, minute) = divMod minutes 60
                           in  printf "Day %d %2d:%02d" day (6+hour) minute
 
+-- | Given the fraction of the time passed, returnes the angle of the sunlight
+lightAngle :: Double -> Angle
+lightAngle diff = pi/100 + diff * (98*pi/100)
+
+
 main = do
        renderGarden <- initRenderer
        -- mapM_ (\g -> threadDelay (500*1000) >> renderGarden g) (inits testGarden)
-       let nextDay (day,garden) = do
-               now <- getClockTime
+       let nextDay (tick, garden) = do
+               let (day, tickOfDay) = tick `divMod` ticksPerDay
+
+               tickStart <- getClockTime
                rgen <- newStdGen
-               let garden' = growGarden rgen garden
+               let sampleAngle = lightAngle $ (fromIntegral tickOfDay + 0.5) /
+                                                fromIntegral ticksPerDay
+               let growingGarden = growGarden sampleAngle rgen garden
 
                renderGarden $ \later -> 
-                       let timeDiff = timeSpanFraction now later
-                            timeInfo = formatTimeInfo day timeDiff
-                           angle = pi/100 + timeDiff * (98*pi/100)
-                           gardenNow = applyGrowth timeDiff garden'
-                       in ScreenContent gardenNow angle timeInfo
-
-               threadDelay (dayLength*1000*1000)
-               nextDay (succ day,finishGrowth garden')
-       nextDay (0::Integer,testGarden)
+                       let tickDiff = timeSpanFraction tickLength tickStart later
+                           dayDiff = (fromIntegral tickOfDay + tickDiff) /
+                                      fromIntegral ticksPerDay
+                            timeInfo = formatTimeInfo day dayDiff
+                           visualizeAngle = lightAngle dayDiff
+                           gardenNow = mapGarden (fmap (const ())) $ growingGarden tickDiff
+                       in ScreenContent gardenNow visualizeAngle timeInfo
+
+               threadDelay (round (tickLength * 1000 * 1000))
+               nextDay (succ tick, growingGarden 1)
+       nextDay (0::Integer, mapGarden (fmap (const Nothing)) testGarden)
 
 -- | Calculates the length to be grown
 remainingGrowth :: GrowingPlanted -> Double
@@ -53,30 +63,44 @@ remainingGrowth planted = go (phenotype planted)
        go p                    = error $ "Unexpected data in growing plant: " ++ show p
 
 
-growGarden :: (RandomGen g) => g -> Garden () -> GrowingGarden
-growGarden rgen garden = zipWithGarden (flip growPlanted) garden rgens
-  where rgens = unfoldr (Just . split) rgen
+growGarden :: (RandomGen g) => Angle -> g -> GrowingGarden -> (Double -> GrowingGarden)
+growGarden angle rgen garden = sequence $ zipWith3 growPlanted rgens garden lightings
+  where lightings = map (extractOutmost . subPieceSum . phenotype) $ lightenGarden angle garden
+        rgens = unfoldr (Just . split) rgen
 
 -- | Applies an L-System to a Plant, putting the new length in the additional
 --   information field
-growPlanted :: (RandomGen g) => g -> Planted () -> GrowingPlanted
-growPlanted rgen planted =
-       planted { phenotype = applyLSystem rgen (genome planted) (phenotype planted) }
+growPlanted :: (RandomGen g) => g -> GrowingPlanted -> Double -> (Double -> GrowingPlanted)
+growPlanted rgen planted light = 
+       let planted' = if remainingGrowth planted < eps
+                       then planted { phenotype =
+                               applyLSystem rgen (genome planted)
+                                                  (finishGrowth (phenotype planted))
+                               }
+                       else planted
+           remainingLength = remainingGrowth planted'
+       in  if remainingLength > eps
+            then let allowedGrowths = (growthPerDayAndLight * light + growthPerDay) /
+                                      (fromIntegral ticksPerDay) 
+                    growthThisTick = min remainingLength allowedGrowths
+                    growthFraction = growthThisTick / remainingLength 
+                in \tickDiff -> applyGrowth (tickDiff * growthFraction) planted'
+           else const planted' 
 
 -- | Finishes Growth by reading lenght from the additional information field
-finishGrowth :: Garden (Maybe Double) -> Garden ()
-finishGrowth = applyGrowth' (flip const)
-
--- | Applies Growth at given fraction
-applyGrowth :: Double -> GrowingGarden -> Garden ()
-applyGrowth r = applyGrowth' (\a b -> a * (1-r) + b * r)
-
-applyGrowth' :: (Double -> Double -> Double) -> GrowingGarden -> Garden ()
-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)
-       go (Stipe (Just l2) l1 p) = Stipe () (f l1 l2) (go p)
+finishGrowth :: GrowingPlant -> Plant ()
+finishGrowth = fmap (const ()) . applyGrowth' (flip const)
+
+-- | Applies Growth at given fraction, leaving the target lenght in place
+applyGrowth :: Double -> GrowingPlanted -> GrowingPlanted
+applyGrowth r = mapPlanted (applyGrowth' (\a b -> a * (1-r) + b * r))
+
+applyGrowth' :: (Double -> Double -> Double) -> GrowingPlant -> GrowingPlant
+applyGrowth' f = go
+  where go (Bud Nothing) = Bud Nothing
+        go (Stipe Nothing l p) = Stipe Nothing l (go p)
+        go (Fork Nothing a p1 p2) = Fork Nothing a (go p1) (go p2)
+       go (Stipe (Just l2) l1 p) = Stipe (Just l2) (f l1 l2) (go p)
        go p                    = error $ "Unexpected data in growing plant: " ++ show p
 
 testGarden =