1 files changed, 33 insertions(+), 2 deletions(-)

M src/SSML.hs

@@ 4,14 4,18 @@ module SSML(styleToSSML, postorder) where
 import Text.XML
 import qualified Data.Text as Txt
 import Data.Map
-import Data.Maybe (isNothing, fromMaybe)
+import Data.Maybe (isNothing, fromMaybe, fromJust)
 import qualified Data.Map as M
 import Data.CSS.StyleTree
 
+import Data.CSS.Syntax.Tokens
+import Data.Scientific (toRealFloat)
+import Data.List (elemIndex)
+
 import SpeechStyle
 
 styleToSSML :: StyleTree SpeechStyle -> Element
-styleToSSML = Element "{http://www.w3.org/2001/10/synthesis}speak" M.empty . styleToNodes
+styleToSSML = Element "{http://www.w3.org/2001/10/synthesis}speak" M.empty . collapseBreaks' . styleToNodes
 styleToNodes :: StyleTree SpeechStyle -> [Node]
 styleToNodes = Prelude.map style . postorder styleToSSML'
 


@@ 85,3 89,30 @@ unit2txt (Unit' unit n) = relativeUnit n `Txt.append` unit
 pitch2txt (Pitch kw _) = kw
 pitch2txt (Absolute (Unit' unit n)) = Txt.pack (show n) `Txt.append` unit
 pitch2txt (Relative n) = unit2txt n
+
+-- <break> collapse
+collapseBreaks :: Element -> Element
+collapseBreaks (Element name attrs elChildren) =
+    Element name attrs $ collapseBreaks' elChildren
+collapseBreaks' :: [Node] -> [Node]
+collapseBreaks' (
+        NodeElement a@(Element "break" _ _):
+        NodeElement b@(Element "break" _ _):
+        nodes
+    ) = NodeElement (maxBreak a b) : collapseBreaks' nodes
+collapseBreaks' (NodeElement el:nodes) = NodeElement (collapseBreaks el) : collapseBreaks' nodes
+collapseBreaks' (node:nodes) = node:collapseBreaks' nodes
+collapseBreaks' [] = []
+
+volumes = ["x-weak", "weak", "medium", "strong", "x-strong"]
+maxBreak x@(Element _ a _) y@(Element _ b _)
+    | Just a' <- "strength" `M.lookup` a, Just b' <- "strength" `M.lookup` b, a' /= b' =
+        if fromJust (elemIndex a' volumes) > fromJust (elemIndex b' volumes) then x else y
+    | Just a' <- "time" `M.lookup` a, Just b' <- "time" `M.lookup` b, a' /= b' =
+        if toMS (tokenize a') > toMS (tokenize b') then x else y
+    | otherwise = x
+toMS [Dimension _ n "s"] = cssFloat n * 1000
+toMS [Dimension _ n "ms"] = cssFloat n
+toMS _ = 0 -- Should never happen.
+cssFloat (NVInteger i) = fromInteger i
+cssFloat (NVNumber n) = toRealFloat n