Allow "SET TAG" nach BLOSSOM
authorJoachim Breitner <mail@joachim-breitner.de>
Sun, 7 Jun 2009 20:40:26 +0000 (22:40 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sun, 7 Jun 2009 20:40:26 +0000 (22:40 +0200)
src/Lseed/Data.hs
src/Lseed/Grammar.hs
src/Lseed/Grammar/Compile.hs
src/Lseed/Grammar/Parse.hs
src/Lseed/LSystem.hs

index 423e739..7e49c7b 100644 (file)
@@ -67,7 +67,7 @@ type AnnotatedPlant = Plant StipeInfo
 data LRuleAction
        = EnlargeStipe UserTag Double -- ^ Extend this Stipe to the given length
         | ForkStipe UserTag Double [(Angle, Double, UserTag)] -- ^ Branch this stipe at the given fraction and angles and let it grow to the given lengths
-       | DoBlossom -- ^ Start a to grow a new seed
+       | DoBlossom UserTag -- ^ Start a to grow a new seed
        deriving (Show)
 
 -- | A (compiled) rule of an L-system, with a matching function returning an action and weight
index 89f80fd..0c5e8db 100644 (file)
@@ -55,7 +55,7 @@ data Condition
 data GrammarAction
        = SetLength (Maybe UserTag) LengthDescr
        | AddBranches (Maybe UserTag) Double [(Angle, Double, Maybe UserTag)]
-       | Blossom
+       | Blossom (Maybe UserTag)
        deriving (Read,Show)
 
 data LengthDescr = Absolute Double
index 1d8f3a1..d47bf30 100644 (file)
@@ -43,8 +43,8 @@ grToLAction (SetLength mut ld) (Plant { pLength = l, pUserTag = oldUt })
 grToLAction (AddBranches mut frac branches) (Plant { pLength = l, pUserTag = oldUt })
        = ForkStipe (fromMaybe oldUt mut) frac $
                map (\(a,b,c) -> (a,b,fromMaybe oldUt c)) branches
-grToLAction Blossom _ 
-       = DoBlossom
+grToLAction (Blossom mut) (Plant { pLength = l, pUserTag = oldUt })
+       = DoBlossom (fromMaybe oldUt mut)
 
 -- | Length reductions are silenty turned into no-ops
 calcLengthDescr :: LengthDescr -> Double -> Double
index 6228a90..4bace5f 100644 (file)
@@ -6,6 +6,7 @@ import Text.Parsec.Language (javaStyle)
 import Text.Parsec.Expr
 import Control.Monad
 
+import Lseed.Data
 import Lseed.Grammar
 
 -- The lexer
@@ -107,22 +108,14 @@ pBranch = do
                        reservedOp "="
                        pString
                return (angle, length, mTag)
-       mTag <- optionMaybe $ do
-               reserved "SET"
-               reserved "TAG"
-               reservedOp "="
-               pString
+       mTag <- pSetTag
        return (AddBranches mTag (fraction/100) branches)
 
 pGrow :: Parser GrammarAction
 pGrow = do
        reserved "GROW"
        desc <- by <|> to
-       mTag <- optionMaybe $ do
-               reserved "SET"
-               reserved "TAG"
-               reservedOp "="
-               pString
+       mTag <- pSetTag
        return (SetLength mTag desc)
   where by = do
                reserved "BY"
@@ -137,7 +130,15 @@ pGrow = do
 pBlossom :: Parser GrammarAction
 pBlossom = do
        reserved "BLOSSOM"
-       return Blossom
+       mTag <- pSetTag
+       return (Blossom mTag)
+
+pSetTag :: Parser (Maybe UserTag)
+pSetTag = optionMaybe $ do
+               reserved "SET"
+               reserved "TAG"
+               reservedOp "="
+               pString
 
 pMatchable =
        choice $ map (\(a,b) -> const b `fmap` reserved a) $
index d315ea8..73685cb 100644 (file)
@@ -11,7 +11,7 @@ import Data.List
 applyLSystem :: RandomGen g => g -> LSystem -> AnnotatedPlant -> GrowingPlant
 applyLSystem rgen rules plant = go plant
   where applyAction :: AnnotatedPlant -> LRuleAction -> GrowingPlant
-       applyAction (Plant _ oldSize ang ut ps) DoBlossom
+       applyAction (Plant _ oldSize ang _ ps) (DoBlossom ut)
                = Plant (GrowingSeed 0) oldSize ang ut $
                   map go ps
        applyAction (Plant _ oldSize ang _ ps) (EnlargeStipe ut newSize)