module Lseed.Logic where
import Lseed.Data
import Lseed.Data.Functions
import Lseed.Grammar.Parse
import Lseed.LSystem
import Lseed.Constants
import Lseed.Geometry
import Lseed.StipeInfo
import System.Time
import Text.Printf
import System.Random
import Data.List
import qualified Data.Foldable as F
timeSpanFraction :: Double -> ClockTime -> ClockTime -> Double
timeSpanFraction spanLenght (TOD sa pa) (TOD sb pb) =
min 1 $ max 0 $
(fromIntegral $ (sb sa) * 1000000000000 + (pbpa)) /
(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
lightAngle :: Double -> Angle
lightAngle diff = pi/100 + diff * (98*pi/100)
remainingGrowth :: (a -> GrowthState) -> Planted a -> Double
remainingGrowth getGrowths planted = go (phenotype planted)
where go p@(Plant { pLength = l1, pBranches = ps }) =
sum (map go ps) + case getGrowths (pData p) of
NoGrowth -> 0
EnlargingTo l2 -> l2 l1
GrowingSeed done -> (1done) * seedGrowthCost
growGarden :: (RandomGen g) => Angle -> g -> GrowingGarden -> (Double -> GrowingGarden)
growGarden angle rgen garden = sequence $ zipWith growPlanted garden' lightings
where lightings = map (plantTotalSum . fmap snd . phenotype) $ lightenGarden angle garden'
garden' = applyGenome angle rgen garden
applyGenome :: (RandomGen g) => Angle -> g -> GrowingGarden -> GrowingGarden
applyGenome angle rgen garden = concat $ zipWith applyGenome' rgens aGarden
where rgens = unfoldr (Just . split) rgen
aGarden = annotateGarden angle garden
applyGenome' rgen planted =
if remainingGrowth siGrowth planted < eps
then planted { phenotype = applyLSystem rgen
(genome planted)
(phenotype planted)
} :
collectSeeds rgen planted
else [fmap siGrowth planted]
collectSeeds :: (RandomGen g) => g -> AnnotatedPlanted -> GrowingGarden
collectSeeds rgen planted = snd $ F.foldr go (rgen,[]) planted
where go si (rgen,newPlants) = case siGrowth si of
GrowingSeed _ ->
let spread = ( siHeight si + siOffset si
, siHeight si + siOffset si
)
(posDelta,rgen') = randomR spread rgen
p = Planted (plantPosition planted + posDelta)
(plantOwner planted)
(genome planted)
(fmap (const NoGrowth) inititalPlant)
in (rgen, p:newPlants)
_ -> (rgen,newPlants)
growPlanted :: GrowingPlanted -> Double -> (Double -> GrowingPlanted)
growPlanted planted light =
let remainingLength = remainingGrowth id planted
in if remainingLength > eps
then let sizeOfPlant = plantLength (phenotype planted)
lightAvailable = light costPerLength * sizeOfPlant^2
lowerBound = if sizeOfPlant < smallPlantBoostSize
then smallPlantBoostLength
else 0
allowedGrowths = max lowerBound $
(growthPerDayAndLight * lightAvailable) /
(fromIntegral ticksPerDay)
growthThisTick = min remainingLength allowedGrowths
growthFraction = growthThisTick / remainingLength
in \tickDiff -> applyGrowth (tickDiff * growthFraction) planted
else const planted
applyGrowth :: Double -> GrowingPlanted -> GrowingPlanted
applyGrowth r = mapPlanted (applyGrowth' (\a b -> a * (1r) + b * r))
applyGrowth' :: (Double -> Double -> Double) -> GrowingPlant -> GrowingPlant
applyGrowth' f = go
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)