Refactor Grammar a bit
authorJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 11:35:14 +0000 (13:35 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Sat, 30 May 2009 11:35:14 +0000 (13:35 +0200)
Now, there can be only one Branch or one Grow action per rule. Branch
rules takes more than one ANGLE, LENGHT pairs. Both actions can be
followed by "SET TAG = ..".

src/Lseed/Grammar.hs
src/Lseed/Grammar/Compile.hs
src/Lseed/Grammar/Parse.hs

index 2990b06..5befeb9 100644 (file)
@@ -25,7 +25,7 @@ data GrammarRule = GrammarRule
        , grPriority :: Priority
        , grWeight :: Weight
        , grCondition :: Condition
-       , grActions :: [GrammarAction]
+       , grAction :: GrammarAction
        }
        deriving (Read,Show)
 
@@ -55,8 +55,8 @@ data Condition
        deriving (Read,Show)
         
 data GrammarAction
-       = SetLength LengthDescr (Maybe UserTag)
-       | AddBranch Double Angle Double (Maybe UserTag)
+       = SetLength (Maybe UserTag) LengthDescr
+       | AddBranches (Maybe UserTag) Double [(Angle, Double, (Maybe UserTag))]
        deriving (Read,Show)
 
 data LengthDescr = Absolute Double
@@ -64,17 +64,3 @@ data LengthDescr = Absolute Double
                  | AdditionalRelative Double -- ^ in Percent
        deriving (Read,Show)
 
-actionsAreInvalid :: [GrammarAction] -> Maybe String
-actionsAreInvalid [_] = Nothing
-actionsAreInvalid acts
-       = if all isAddBranch acts 
-          then case nub (map addBranchAngle acts) of
-           [frac] -> Nothing
-           _      -> Just "Can not branch at different points at the same time."
-         else        Just "Can not grow and branch at the same time."
-
-isAddBranch (AddBranch _ _ _ _) = True
-isAddBranch _ = False
-
-addBranchAngle (AddBranch angle _ _ _) = angle
-
index 773eab5..bfa2837 100644 (file)
@@ -11,7 +11,7 @@ compileGrammarFile = map compileGrammarRule
 compileGrammarRule :: GrammarRule -> LRule
 compileGrammarRule rule plant = 
        if   plant `conformsTo` grCondition rule
-       then Just ({- grPriority rule, -}grWeight rule, grToLAction (grActions rule) plant)
+       then Just ({- grPriority rule, -}grWeight rule, grToLAction (grAction rule) plant)
        else Nothing
 
 
@@ -36,16 +36,11 @@ conformsTo (Stipe si l _) = go
        doCompare Greater = (>)
        doCompare GE = (>=)
 
-grToLAction :: [GrammarAction] -> AnnotatedPlant -> LRuleAction
-grToLAction [SetLength ld _] (Stipe _ l _)
+grToLAction :: GrammarAction -> AnnotatedPlant -> LRuleAction
+grToLAction (SetLength _ ld) (Stipe _ l _)
        = EnlargeStipe (calcLengthDescr ld l)
-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"
+grToLAction (AddBranches _ frac branches) (Stipe _ l _)
+       = ForkStipe frac $ map (\(angle,length,_) -> (angle, length)) branches
 
 -- | Length reductions are silenty turned into no-ops
 calcLengthDescr :: LengthDescr -> Double -> Double
index f465ced..5708ca4 100644 (file)
@@ -10,7 +10,7 @@ import Lseed.Grammar
 
 -- The lexer
 lexer       = P.makeTokenParser $ javaStyle
-       { P.reservedNames = ["RULE", "WHEN", "Tag", "Light", "Branch", "At",
+       { P.reservedNames = ["RULE", "WHEN", "SET", "Tag", "Light", "Branch", "At",
                             "Length", "Light", "Sublength", "Sublight", "Direction", "Angle",
                             "BY", "TO", "IMPORTANCE", "WEIGHT"]
        }
@@ -38,7 +38,11 @@ parseGrammar = parse pFile
 type Parser = Parsec String ()
 
 pFile :: Parser GrammarFile
-pFile = whiteSpace >> many1 pRule
+pFile = do
+       whiteSpace 
+       gf <- many1 pRule
+       eof
+       return gf
 
 pRule :: Parser GrammarRule
 pRule = do
@@ -47,16 +51,15 @@ pRule = do
        condition <- option (Always True) $ do
                reserved "WHEN"
                pCondition
-       actions <- many1 pAction
-       maybe (return ()) fail (actionsAreInvalid actions)
+       action <- pAction
+       -- maybe (return ()) fail (actionIsInvalid action)
        priority <- option 1 $ do
                reserved "IMPORTANCE"
                fromIntegral `fmap` natural
        weight <- option 1 $ do
                reserved "WEIGHT"
                fromIntegral `fmap` natural
-       skipMany nl
-       return $ GrammarRule name priority weight condition actions
+       return $ GrammarRule name priority weight condition action
 
 pCondition :: Parser Condition
 pCondition = buildExpressionParser table term
@@ -82,30 +85,45 @@ pAction = pBranch <|> pGrow
 pBranch :: Parser GrammarAction
 pBranch = do
        reserved "BRANCH"
-       reserved "AT"
-       fraction <- pFloat
-       unless (0 <= fraction && fraction <= 100) $
-               fail "Fork position has to be in between 0% and 100%."
-       reservedOp "%"
-       reserved "ANGLE"
-       reservedOp "="
-       angle <- pFloat
-       comma
-       reserved "LENGTH"
-       reservedOp "="
-       length <- pFloat
-       mTag <- optionMaybe $ do
+       fraction <- (do
+               reserved "AT"
+               fraction <- pFloat
+               unless (0 <= fraction && fraction <= 100) $
+                       fail "Fork position has to be in between 0% and 100%."
+               reservedOp "%"
+               return fraction
+               ) <|> (return 100)
+       branches <- many1 $ do
+               reserved "ANGLE"
+               reservedOp "="
+               angle <- pFloat
                comma
+               reserved "LENGTH"
+               reservedOp "="
+               length <- pFloat
+               mTag <- optionMaybe $ do
+                       comma
+                       reserved "TAG"
+                       reservedOp "="
+                       pString
+               return (angle, length, mTag)
+       mTag <- optionMaybe $ do
+               reserved "SET"
                reserved "TAG"
                reservedOp "="
                pString
-       return (AddBranch (fraction/100) angle length mTag)
+       return (AddBranches mTag (fraction/100) branches)
 
 pGrow :: Parser GrammarAction
 pGrow = do
        reserved "GROW"
        desc <- by <|> to
-       return (SetLength desc Nothing)
+       mTag <- optionMaybe $ do
+               reserved "SET"
+               reserved "TAG"
+               reservedOp "="
+               pString
+       return (SetLength mTag desc)
   where by = do
                reserved "BY"
                value <- pFloat
@@ -116,7 +134,6 @@ pGrow = do
                value <- pFloat
                return (Absolute value)
                
-
 pMatchable =
        choice $ map (\(a,b) -> const b `fmap` reserved a) $
                [ ("LIGHT", MatchLight)
@@ -146,5 +163,3 @@ pFloat = do value <- try (do
            (deg >> return (value / 180 * pi)) <|> return value
 
 deg = reservedOp "\194\176"
-       
-nl = char '\n'