author Joachim Breitner Mon, 2 Mar 2009 09:03:01 +0000 (10:03 +0100) committer Joachim Breitner 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 patch | blob | history src/Lseed/Data.hs patch | blob | history src/Lseed/Geometry.hs patch | blob | history src/main.hs patch | blob | history

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 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
-
-               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 =