Thread growth to the renderer, draw blossom
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 13:17:39 +0000 (15:17 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 13:17:39 +0000 (15:17 +0200)
src/Lseed/Constants.hs
src/Lseed/Data.hs
src/Lseed/Geometry.hs
src/Lseed/Logic.hs
src/Lseed/Mainloop.hs
src/Lseed/Renderer/Cairo.hs
src/Lseed/StipeInfo.hs

index 0b6e4c2..7576636 100644 (file)
@@ -4,6 +4,7 @@ module Lseed.Constants where
 groundLevel = 0.03
 budSize     = 0.01
 stipeLength = 0.05
+blossomSize = 0.03
 stipeWidth  = 0.01
 
 -- | Light and growths interpolation frequency
index 5285037..4c44e85 100644 (file)
@@ -49,12 +49,15 @@ data StipeInfo = StipeInfo
        , siSubLight  :: Double
        , siAngle     :: Angle
        , siDirection :: Angle
+       , siGrowth    :: GrowthState
        }
        deriving (Show)
 
+-- | A GrowingPlant can be growing in one of these three ways:
 data GrowthState = NoGrowth
                 | EnlargingTo Double -- ^ value indicates the growth target 
                 | GrowingSeed Double -- ^ value indicates the current state [0..1]
+       deriving (Show)
 
 -- | Named variants of a Plant, for more expressive type signatures
 type GrowingPlant = Plant GrowthState
@@ -75,7 +78,7 @@ type LSystem = [LRule]
 
 -- | Representation of what is on screen
 data ScreenContent = ScreenContent
-       { scGarden     :: Garden ()
+       { scGarden     :: AnnotatedGarden
        , scLightAngle :: Double
        , scTime       :: String
        }
index 1be4e04..0991011 100644 (file)
@@ -14,6 +14,7 @@ import Data.Traversable (mapM,forM)
 import Prelude hiding (mapM)
 import Control.Monad.ST
 import Data.STRef
+import Control.Applicative
 
 type Point = (Double, Double)
 type Line  = (Point, Point)
@@ -172,19 +173,19 @@ allKindsOfStuffWithAngle angle lines = (lighted, polygons)
                                                        , (p1,p2,p3,p4,intensity))
 
 -- | Annotates each piece of the garden with the amount of line it attacts
-lightenGarden :: Double -> Garden a -> Garden Double
+lightenGarden :: Angle -> Garden a -> Garden (a, Double)
 lightenGarden angle = mapLine (lightenLines angle) 0 (+) 
 
 
 -- | Helper to apply a function that works on lines to a garden
 mapLine :: (forall b. [(Line, b)] -> [(Line, b, c)]) ->
-           c -> (c -> c -> c) -> Garden a -> Garden c
+           c -> (c -> c -> c) -> Garden a -> Garden (a,c)
 mapLine process init combine garden = runST $ do
-       gardenWithPointers <- mapM (mapM (const (newSTRef init))) garden
+       gardenWithPointers <- mapM (mapM (\d -> (,) d <$> newSTRef init)) garden
        let linesWithPointers = gardenToLines gardenWithPointers
        let processedLines = process linesWithPointers
        -- Update values via the STRef
-       forM_ processedLines $ \(_,stRef,result) -> modifySTRef stRef (combine result)
+       forM_ processedLines $ \(_,(_,stRef),result) -> modifySTRef stRef (combine result)
        -- Undo the STRefs
-       mapM (mapM readSTRef) gardenWithPointers
+       mapM (mapM (\(d,stRef) -> (,) d <$> readSTRef stRef)) gardenWithPointers
 
index f30c3ba..b9c295d 100644 (file)
@@ -39,7 +39,7 @@ remainingGrowth planted = go (phenotype planted)
 
 growGarden :: (RandomGen g) => Angle -> g -> GrowingGarden -> (Double -> GrowingGarden)
 growGarden angle rgen garden = sequence $ zipWith growPlanted garden' lightings
-  where lightings = map (plantTotalSum . phenotype) $ lightenGarden angle garden'
+  where lightings = map (plantTotalSum . fmap snd . phenotype) $ lightenGarden angle garden'
        garden' = applyGenome angle rgen garden
 
 -- | For all Growing plants that are done, find out the next step
index 1e85aed..215d6dc 100644 (file)
@@ -7,6 +7,7 @@ import Lseed.Geometry
 import Lseed.Data.Functions
 import Lseed.Constants
 import Lseed.Logic
+import Lseed.StipeInfo
 import System.Time
 import System.Random
 import Control.Concurrent
@@ -41,7 +42,7 @@ lseedMainLoop rt obs maxDays garden = do
                                              fromIntegral ticksPerDay
                                    timeInfo = formatTimeInfo day dayDiff
                                    visualizeAngle = lightAngle dayDiff
-                                   gardenNow = mapGarden (fmap (const ())) $
+                                   gardenNow = annotateGarden visualizeAngle $ 
                                                growingGarden tickDiff
                                in ScreenContent gardenNow visualizeAngle timeInfo
 
index 2786a33..0e388ce 100644 (file)
@@ -8,7 +8,6 @@ import Data.IORef
 import Data.Maybe
 import Lseed.Data
 import Lseed.Data.Functions
-import Lseed.StipeInfo
 import Lseed.Constants
 import Lseed.Geometry
 import Text.Printf
@@ -63,11 +62,10 @@ cairoObserver = do
                        mainQuit
                }
 
-render :: Double -> Garden () -> Render ()
+render :: Double -> AnnotatedGarden -> Render ()
 render angle garden = do
        -- TODO the following can be optimized to run allKindsOfStuffWithAngle only once.
        -- by running it here. This needs modification to lightenGarden and mapLine
-       let garden' = map (mapPlanted annotatePlant) (lightenGarden angle garden)
        renderGround
        mapM_ renderLightedPoly (lightPolygons angle (gardenToLines garden))
 
@@ -75,9 +73,9 @@ render angle garden = do
        --mapM_ renderLine (gardenToLines garden)
        --mapM_ renderLightedPlanted (lightenGarden angle garden)
        --
-       mapM_ renderPlanted garden'
+       mapM_ renderPlanted garden
 
-       renderInfo angle garden'
+       renderInfo angle garden
 
 renderPlanted :: AnnotatedPlanted -> Render ()
 renderPlanted planted = preserve $ do
@@ -92,9 +90,16 @@ renderPlant (Plant si len ang ut ps) = preserve $ do
        setLineWidth (stipeWidth*(0.5 + 0.5 * sqrt (siSubLength si)))
        moveTo 0 0
        lineTo 0 (len * stipeLength)
+       setSourceRGB 0 0.8 0
        stroke
        translate 0 (len * stipeLength)
        mapM_ renderPlant ps
+       case siGrowth si of
+         GrowingSeed done -> do
+               setSourceRGB 1 1 0
+               arc 0 0 (done * blossomSize/2) 0 (2*pi)
+               fill
+         _ -> return ()
                
 renderLightedPlanted :: Planted Double -> Render ()
 renderLightedPlanted planted = preserve $ do
index 229caed..820d859 100644 (file)
@@ -4,15 +4,19 @@ import Lseed.Data
 import Lseed.Data.Functions
 import Lseed.Geometry
 
-annotatePlant :: Plant Double -> AnnotatedPlant
+annotateGarden :: Angle -> GrowingGarden -> AnnotatedGarden
+annotateGarden angle  = map (mapPlanted annotatePlant) . lightenGarden angle
+
+annotatePlant :: Plant (GrowthState, Double) -> AnnotatedPlant
 annotatePlant = go 0
-  where go d (Plant light len ang ut ps) = Plant (StipeInfo
+  where go d (Plant (gs, light) len ang ut ps) = Plant (StipeInfo
                { siLength    = len
                , siSubLength = len + sum (map (siSubLength . pData) ps')
                , siLight     = light
                , siSubLight  = light + sum (map (siSubLight . pData) ps')
                , siAngle     = ang
                , siDirection = normAngle d'
+               , siGrowth    = gs
                }) len ang ut ps'
          where ps' = map (go d') ps
                d' = (d+ang)