Allow multiple branches
authorJoachim Breitner <mail@joachim-breitner.de>
Thu, 7 May 2009 14:38:57 +0000 (16:38 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Thu, 7 May 2009 14:38:57 +0000 (16:38 +0200)
src/Lseed/Grammar.hs
src/Lseed/Grammar/Compile.hs
src/Lseed/Grammar/Parse.hs

index 85e7929..67808b2 100644 (file)
@@ -24,7 +24,7 @@ data GrammarRule = GrammarRule
        , grPriority :: Priority
        , grWeight :: Weight
        , grCondition :: Condition
-       , grAction :: GrammarAction
+       , grActions :: [GrammarAction]
        }
        deriving (Read,Show)
 
index 42a3e5c..1599d79 100644 (file)
@@ -3,6 +3,7 @@ module Lseed.Grammar.Compile where
 
 import Lseed.Data
 import Lseed.Grammar
+import Data.List (nub)
 
 compileGrammarFile :: GrammarFile -> LSystem
 compileGrammarFile = map compileGrammarRule
@@ -10,7 +11,7 @@ compileGrammarFile = map compileGrammarRule
 compileGrammarRule :: GrammarRule -> LRule
 compileGrammarRule rule plant = 
        if   plant `conformsTo` grCondition rule
-       then Just ({- grPriority rule, -}grWeight rule, grToLAction (grAction rule) plant)
+       then Just ({- grPriority rule, -}grWeight rule, grToLAction (grActions rule) plant)
        else Nothing
 
 
@@ -31,11 +32,21 @@ conformsTo (Stipe () l _) = go
        doCompare Greater = (>)
        doCompare GE = (>=)
 
-grToLAction :: GrammarAction -> Plant () -> LRuleAction
-grToLAction (SetLength ld _) (Stipe () l _)
+grToLAction :: [GrammarAction] -> Plant () -> LRuleAction
+grToLAction [SetLength ld _] (Stipe () l _)
        = EnlargeStipe (calcLengthDescr ld l)
-grToLAction (AddBranch frac angle length _) (Stipe () l _)
-       = ForkStipe frac [(angle, length)]
+grToLAction acts  (Stipe () l _)
+       | all isAddBranch acts
+       = case nub (map addBranchAngle acts) of
+           [frac] -> ForkStipe frac $ map (\(AddBranch _ angle length _) -> (angle, length)) acts
+           _ -> error "Can not branch at different points at the same time"
+       | otherwise
+       = error "Can not grow and branch at the same time"
+
+isAddBranch (AddBranch _ _ _ _) = True
+isAddBranch _ = False
+
+addBranchAngle (AddBranch angle _ _ _) = angle
 
 -- | Length reductions are silenty turned into no-ops
 calcLengthDescr :: LengthDescr -> Double -> Double
index 49b9dde..08846f9 100644 (file)
@@ -53,7 +53,7 @@ pRule = do
                reserved "WEIGHT"
                fromIntegral `fmap` natural
        skipMany nl
-       return $ GrammarRule name priority weight condition (head actions)
+       return $ GrammarRule name priority weight condition actions
 
 pCondition :: Parser Condition
 pCondition = buildExpressionParser table term