Remove unused function
[L-seed.git] / src / Lseed / Logic.hs
1 -- | This module is mostly a general dump...
2 module Lseed.Logic where
3
4 import Lseed.Data
5 import Lseed.Data.Functions
6 import Lseed.Grammar
7 import Lseed.Grammar.Compile
8 import Lseed.Grammar.Parse
9 import Lseed.LSystem
10 import Lseed.Constants
11 import Lseed.Geometry
12 import Lseed.StipeInfo
13 import System.Time
14 import Text.Printf
15 import System.Random
16 import Data.List
17
18 timeSpanFraction :: Double -> ClockTime -> ClockTime -> Double
19 timeSpanFraction spanLenght (TOD sa pa) (TOD sb pb) = 
20         min 1 $ max 0 $
21         (fromIntegral $ (sb - sa) * 1000000000000 + (pb-pa)) /
22         (spanLenght * 1000000000000 )
23
24 formatTimeInfo :: Integer -> Double -> String
25 formatTimeInfo day frac = let minutes = floor (frac * 12 * 60) :: Integer
26                               (hour, minute) = divMod minutes 60
27                           in  printf "Day %d %2d:%02d" day (6+hour) minute
28
29 -- | Given the fraction of the time passed, returnes the angle of the sunlight
30 lightAngle :: Double -> Angle
31 lightAngle diff = pi/100 + diff * (98*pi/100)
32
33 -- | Calculates the length to be grown
34 remainingGrowth :: GrowingPlanted -> Double
35 remainingGrowth planted = go (phenotype planted)
36   where go (Plant NoGrowth          _  _ _ ps) = sum (map go ps)
37         go (Plant (EnlargingTo l2)  l1 _ _ ps) = (l2 - l1) + sum (map go ps)
38         go (Plant (GrowingSeed done) _ _ _ ps) = (1-done) * seedGrowthCost + sum (map go ps)
39
40 growGarden :: (RandomGen g) => Angle -> g -> GrowingGarden -> (Double -> GrowingGarden)
41 growGarden angle rgen garden = sequence $ zipWith growPlanted garden' lightings
42   where lightings = map (plantTotalSum . fmap snd . phenotype) $ lightenGarden angle garden'
43         garden' = applyGenome angle rgen garden
44
45 -- | For all Growing plants that are done, find out the next step
46 applyGenome :: (RandomGen g) => Angle -> g -> GrowingGarden -> GrowingGarden 
47 applyGenome angle rgen garden = zipWith3 applyGenome' rgens garden lGarden
48   where rgens = unfoldr (Just . split) rgen
49         lGarden = lightenGarden angle garden
50         applyGenome' rgen planted lPlanted =
51                 if   remainingGrowth planted < eps
52                 then planted { phenotype = applyLSystem rgen
53                                                         (genome planted)
54                                                         (annotatePlant (phenotype lPlanted))
55                      -- here, we throw away the last eps of growth. Is that a problem?
56                              }
57                 else planted
58
59 -- | Applies an L-System to a Plant, putting the new length in the additional
60 --   information field
61 growPlanted :: GrowingPlanted -> Double -> (Double -> GrowingPlanted)
62 growPlanted planted light = 
63         let remainingLength = remainingGrowth planted
64         in  if remainingLength > eps
65             then let sizeOfPlant = plantLength (phenotype planted)
66                      lightAvailable = light - costPerLength * sizeOfPlant^2
67                      allowedGrowths = max 0 $
68                                       (growthPerDayAndLight * lightAvailable + growthPerDay) /
69                                       (fromIntegral ticksPerDay) 
70                      growthThisTick = min remainingLength allowedGrowths
71                      growthFraction = growthThisTick / remainingLength 
72                  in \tickDiff -> applyGrowth (tickDiff * growthFraction) planted
73             else const planted
74
75 -- | Applies Growth at given fraction, leaving the target length in place
76 applyGrowth :: Double -> GrowingPlanted -> GrowingPlanted
77 applyGrowth r = mapPlanted (applyGrowth' (\a b -> a * (1-r) + b * r))
78
79 applyGrowth' :: (Double -> Double -> Double) -> GrowingPlant -> GrowingPlant
80 applyGrowth' f = go
81   where go (Plant NoGrowth l ang ut ps) = 
82                 Plant NoGrowth l ang ut (map go ps)
83         go (Plant (EnlargingTo l2) l1 ang ut ps) =
84                 Plant (EnlargingTo l2) (f l1 l2) ang ut (map go ps)
85         go (Plant (GrowingSeed done) l ang ut ps) =
86                 Plant (GrowingSeed (f (done*seedGrowthCost) seedGrowthCost)) l ang ut (map go ps)