Add Seed Growths parameter
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 12:52:10 +0000 (14:52 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 12:54:20 +0000 (14:54 +0200)
src/Lseed/Constants.hs
src/Lseed/Data.hs
src/Lseed/LSystem.hs
src/Lseed/Logic.hs
src/Lseed/Mainloop.hs
src/Lseed/Renderer/Cairo.hs

index 8e690f5..0b6e4c2 100644 (file)
@@ -21,6 +21,9 @@ growthPerDay = 3.0
 -- | Cost (in light units) per (length for maintaining the plant)^2, to limit the growth of the plants
 costPerLength = 0.002
 
+-- | Cost (in length growths equivalent) per seed to be grown
+seedGrowthCost = 1.0
+
 -- | Length of one day, in seconds
 dayLength = 10 
 
index cc40a4b..5fbe6b4 100644 (file)
@@ -12,7 +12,7 @@ import System.Time (ClockTime)
 type Garden a = [ Planted a ]
 
 -- | Named variants of a garden, for more expressive type signatures
-type GrowingGarden = Garden (Maybe Double)
+type GrowingGarden = Garden GrowthState
 type AnnotatedGarden = Garden StipeInfo
 
 -- | A plant with metainformatoin
@@ -24,7 +24,7 @@ data Planted a = Planted
        }
 
 -- | Named variants of a Planted, for more expressive type signatures
-type GrowingPlanted = Planted (Maybe Double)
+type GrowingPlanted = Planted GrowthState
 type AnnotatedPlanted = Planted StipeInfo
 
 -- | A plant, which is
@@ -42,9 +42,6 @@ data Plant a
 -- | A straight, untagged plant with length zero and no branches.
 inititalPlant = Plant () 0 0 "" []
 
--- | Named variants of a Plant, for more expressive type signatures
-type GrowingPlant = Plant (Maybe Double)
-
 data StipeInfo = StipeInfo
        { siLength    :: Double -- ^ a bit redundant, but what shells
        , siSubLength :: Double
@@ -55,6 +52,12 @@ data StipeInfo = StipeInfo
        }
        deriving (Show)
 
+data GrowthState = NoGrowth
+                | EnlargingTo Double -- ^ value indicates the growth target 
+                | GrowingSeed Double -- ^ value indicates the current state [0..1]
+
+-- | Named variants of a Plant, for more expressive type signatures
+type GrowingPlant = Plant GrowthState
 type AnnotatedPlant = Plant StipeInfo
 
 -- | Possible action to run on a Stipe in a Rule
index 7158749..f508bdf 100644 (file)
@@ -12,25 +12,25 @@ applyLSystem :: RandomGen g => g -> LSystem -> AnnotatedPlant -> GrowingPlant
 applyLSystem rgen rules plant = go plant
   where applyAction :: AnnotatedPlant -> LRuleAction -> GrowingPlant
        applyAction (Plant _ oldSize ang _ ps) (EnlargeStipe ut newSize) 
-               = Plant (Just newSize) oldSize ang ut $
+               = Plant (EnlargingTo newSize) oldSize ang ut $
                   map go ps
        applyAction (Plant _ oldSize ang _ ps) (ForkStipe ut pos [])-- No branches
-               = Plant Nothing oldSize ang ut $
+               = Plant NoGrowth oldSize ang ut $
                  map go ps
        applyAction (Plant _ oldSize ang _ ps) (ForkStipe ut pos branchSpecs)
                | 1-pos < eps -- Fork at the end
-               = Plant Nothing oldSize ang ut $
+               = Plant NoGrowth oldSize ang ut $
                        ps' ++
                        newForks
                | otherwise -- Fork not at the end
-               = Plant Nothing (oldSize * pos) ang ut $
-                       [ Plant Nothing (oldSize * (1-pos)) 0 ut ps' ] ++
+               = Plant NoGrowth (oldSize * pos) ang ut $
+                       [ Plant NoGrowth (oldSize * (1-pos)) 0 ut ps' ] ++
                        newForks
-         where newForks = map (\(angle, newSize, ut) -> Plant (Just newSize) 0 angle ut []) branchSpecs
+         where newForks = map (\(angle, newSize, ut) -> Plant (EnlargingTo newSize) 0 angle ut []) branchSpecs
                ps' = map go ps
 
        noAction (Plant _ oldSize ang ut ps)
-               = Plant Nothing oldSize ang ut $ map go ps
+               = Plant NoGrowth oldSize ang ut $ map go ps
 
        go :: AnnotatedPlant -> GrowingPlant
        go p = case filter (isValid.snd) $ map (second (applyAction p)) $ mapMaybe ($ p) rules of
index e951f41..f30c3ba 100644 (file)
@@ -29,11 +29,13 @@ formatTimeInfo day frac = let minutes = floor (frac * 12 * 60) :: Integer
 -- | Given the fraction of the time passed, returnes the angle of the sunlight
 lightAngle :: Double -> Angle
 lightAngle diff = pi/100 + diff * (98*pi/100)
+
 -- | Calculates the length to be grown
 remainingGrowth :: GrowingPlanted -> Double
 remainingGrowth planted = go (phenotype planted)
-  where go (Plant Nothing   _  _ _ ps) = sum (map go ps)
-       go (Plant (Just l2) l1 _ _ ps) = (l2 - l1) + sum (map go ps)
+  where go (Plant NoGrowth          _  _ _ ps) = sum (map go ps)
+       go (Plant (EnlargingTo l2)  l1 _ _ ps) = (l2 - l1) + sum (map go ps)
+       go (Plant (GrowingSeed done) _ _ _ ps) = (1-done) * seedGrowthCost + sum (map go ps)
 
 growGarden :: (RandomGen g) => Angle -> g -> GrowingGarden -> (Double -> GrowingGarden)
 growGarden angle rgen garden = sequence $ zipWith growPlanted garden' lightings
@@ -80,5 +82,9 @@ applyGrowth r = mapPlanted (applyGrowth' (\a b -> a * (1-r) + b * r))
 
 applyGrowth' :: (Double -> Double -> Double) -> GrowingPlant -> GrowingPlant
 applyGrowth' f = go
-  where go (Plant Nothing   l  ang ut ps) = Plant Nothing   l         ang ut (map go ps)
-       go (Plant (Just l2) l1 ang ut ps) = Plant (Just l2) (f l1 l2) ang ut (map go ps)
+  where go (Plant NoGrowth l ang ut ps) = 
+               Plant NoGrowth l ang ut (map go ps)
+       go (Plant (EnlargingTo l2) l1 ang ut ps) =
+               Plant (EnlargingTo l2) (f l1 l2) ang ut (map go ps)
+       go (Plant (GrowingSeed done) l ang ut ps) =
+               Plant (GrowingSeed (f (done*seedGrowthCost) seedGrowthCost)) l ang ut (map go ps)
index 713a3fb..1e85aed 100644 (file)
@@ -47,4 +47,4 @@ lseedMainLoop rt obs maxDays garden = do
 
                        threadDelay (round (tickLength * 1000 * 1000))
                nextDay (succ tick, growingGarden 1)
-       nextDay (0::Integer, mapGarden (fmap (const Nothing)) garden)
+       nextDay (0::Integer, mapGarden (fmap (const NoGrowth)) garden)
index 7024d95..dc21f26 100644 (file)
@@ -151,9 +151,9 @@ renderInfo angle garden = do
        forM_ garden $ \planted -> do
                let x = plantPosition planted
                let text1 = printf "Light: %.2f" $
-                               siSubLength . pData . phenotype $ planted
-               let text2 = printf "Size: %.2f" $
                                siSubLight . pData . phenotype $ planted
+               let text2 = printf "Size: %.2f" $
+                               siSubSize . pData . phenotype $ planted
                preserve $ do
                        scale 1 (-1)
                        setSourceRGB 0 0 0