diff --git a/Text/TeXMath/MathMLWriter.hs b/Text/TeXMath/MathMLWriter.hs --- a/Text/TeXMath/MathMLWriter.hs +++ b/Text/TeXMath/MathMLWriter.hs @@ -32,7 +32,7 @@ toMathML :: DisplayType -> [Exp] -> Element toMathML dt exprs = - add_attr dtattr $ math $ map showExp exprs + add_attr dtattr $ math $ map (showExp . expandMathOp dt) exprs where dtattr = Attr (unqual "display") dt' dt' = case dt of DisplayBlock -> "block" @@ -78,7 +78,7 @@ Just c' -> unode c' (showExp x) Nothing -> error $ "Unknown unary op: " ++ c -binaryOps :: Node a => M.Map String (a -> Element) +binaryOps :: M.Map String ([Element] -> Element) binaryOps = M.fromList [ ("\\frac", unode "mfrac") , ("\\tfrac", withAttribute "displaystyle" "false" . @@ -89,8 +89,15 @@ , ("\\stackrel", unode "mover") , ("\\overset", unode "mover") , ("\\underset", unode "munder") + , ("\\binom", showBinom) ] +showBinom :: [Element] -> Element +showBinom lst = mrow [ (withAttribute "stretchy" "true" $ unode "mo" "(") + , unode "mtable" $ map (unode "mtr" . unode "mtd") lst + , (withAttribute "stretchy" "true" $ unode "mo" ")") + ] + showBinary :: String -> Exp -> Exp -> Element showBinary c x y = case M.lookup c binaryOps of @@ -131,6 +138,14 @@ accent = add_attr (Attr (unqual "accent") "true") . unode "mo" +expandMathOp :: DisplayType -> Exp -> Exp +expandMathOp DisplayInline (EMathOperator x) = EIdentifier x +expandMathOp DisplayInline x = x +expandMathOp DisplayBlock (ESub (EMathOperator x) y) = EUnder (EIdentifier x) y +expandMathOp DisplayBlock (ESubsup (EMathOperator x) y z) = EUnder (ESuper (EIdentifier x) z) y +expandMathOp DisplayBlock (EMathOperator x) = EIdentifier x +expandMathOp DisplayBlock x = x + showExp :: Exp -> Element showExp e = case e of @@ -138,7 +153,12 @@ EGrouped [x] -> showExp x EGrouped xs -> mrow $ map showExp xs EIdentifier x -> unode "mi" x + EMathOperator x -> unode "mi" x --in case expandMathOp is not used ESymbol Accent x -> accent x + EStretchy (ESymbol Open x) -> makeStretchy $ unode "mo" x + EStretchy (ESymbol Close x) -> makeStretchy $ unode "mo" x + ESymbol Open x -> withAttribute "stretchy" "false" $ unode "mo" x + ESymbol Close x -> withAttribute "stretchy" "false" $ unode "mo" x ESymbol _ x -> unode "mo" x ESpace x -> spaceWidth x EBinary c x y -> showBinary c x y diff --git a/Text/TeXMath/Parser.hs b/Text/TeXMath/Parser.hs --- a/Text/TeXMath/Parser.hs +++ b/Text/TeXMath/Parser.hs @@ -41,6 +41,7 @@ ENumber String | EGrouped [Exp] | EIdentifier String + | EMathOperator String | ESymbol TeXSymbolType String | ESpace String | EBinary String Exp Exp @@ -110,20 +111,37 @@ number = lexeme $ liftM ENumber $ many1 digit enclosure :: GenParser Char st Exp -enclosure = basicEnclosure <|> leftright <|> scaledEnclosure +enclosure = basicEnclosure <|> left <|> right <|> scaledEnclosure basicEnclosure :: GenParser Char st Exp basicEnclosure = choice $ map (\(s, v) -> try (symbol s) >> return v) enclosures -leftright :: GenParser Char st Exp -leftright = try $ do - typ <- (try (symbol "\\left") >> return Open) - <|> (symbol "\\right" >> return Close) - enc <- enclosure <|> (symbol "." >> return (ESymbol typ "\xFEFF")) +left :: GenParser Char st Exp +left = try $ do + try (symbol "\\left") + enc <- basicEnclosure <|> (symbol "." >> return (ESymbol Open "\xFEFF")) case enc of - ESymbol t x | t == typ -> return $ EStretchy $ ESymbol t x - _ -> pzero + (ESymbol Open _) -> tilRight enc <|> return (EStretchy enc) + _ -> pzero +right :: GenParser Char st Exp +right = try $ do + try (symbol "\\right") + enc <- basicEnclosure <|> (symbol "." >> return (ESymbol Open "\xFEFF")) + case enc of + (ESymbol Close x) -> return (EStretchy $ ESymbol Open x) + _ -> pzero + +-- We want stuff between \left( and \right) to be in an mrow, +-- so that the scaling is based just on this unit, and not the +-- whole containing formula. +tilRight :: Exp -> GenParser Char st Exp +tilRight start = try $ do + contents <- manyTill expr + (try $ symbol "\\right" >> lookAhead basicEnclosure) + end <- basicEnclosure + return $ EGrouped $ EStretchy start : (contents ++ [EStretchy end]) + scaledEnclosure :: GenParser Char st Exp scaledEnclosure = try $ do cmd <- command @@ -340,7 +358,7 @@ brackets = lexeme . P.brackets lexer binaryOps :: [String] -binaryOps = ["\\frac", "\\tfrac", "\\dfrac", "\\stackrel", "\\overset", "\\underset"] +binaryOps = ["\\frac", "\\tfrac", "\\dfrac", "\\stackrel", "\\overset", "\\underset", "\\binom"] scalers :: M.Map String String scalers = M.fromList @@ -612,37 +630,37 @@ , ("~", ESpace "0.333em") , ("\\quad", ESpace "1em") , ("\\qquad", ESpace "2em") - , ("\\arccos", EIdentifier "arccos") - , ("\\arcsin", EIdentifier "arcsin") - , ("\\arctan", EIdentifier "arctan") - , ("\\arg", EIdentifier "arg") - , ("\\cos", EIdentifier "cos") - , ("\\cosh", EIdentifier "cosh") - , ("\\cot", EIdentifier "cot") - , ("\\coth", EIdentifier "coth") - , ("\\csc", EIdentifier "csc") - , ("\\deg", EIdentifier "deg") - , ("\\det", EIdentifier "det") - , ("\\dim", EIdentifier "dim") - , ("\\exp", EIdentifier "exp") - , ("\\gcd", EIdentifier "gcd") - , ("\\hom", EIdentifier "hom") - , ("\\inf", EIdentifier "inf") - , ("\\ker", EIdentifier "ker") - , ("\\lg", EIdentifier "lg") - , ("\\lim", EIdentifier "lim") - , ("\\liminf", EIdentifier "liminf") - , ("\\limsup", EIdentifier "limsup") - , ("\\ln", EIdentifier "ln") - , ("\\log", EIdentifier "log") - , ("\\max", EIdentifier "max") - , ("\\min", EIdentifier "min") - , ("\\Pr", EIdentifier "Pr") - , ("\\sec", EIdentifier "sec") - , ("\\sin", EIdentifier "sin") - , ("\\sinh", EIdentifier "sinh") - , ("\\sup", EIdentifier "sup") - , ("\\tan", EIdentifier "tan") - , ("\\tanh", EIdentifier "tanh") + , ("\\arccos", EMathOperator "arccos") + , ("\\arcsin", EMathOperator "arcsin") + , ("\\arctan", EMathOperator "arctan") + , ("\\arg", EMathOperator "arg") + , ("\\cos", EMathOperator "cos") + , ("\\cosh", EMathOperator "cosh") + , ("\\cot", EMathOperator "cot") + , ("\\coth", EMathOperator "coth") + , ("\\csc", EMathOperator "csc") + , ("\\deg", EMathOperator "deg") + , ("\\det", EMathOperator "det") + , ("\\dim", EMathOperator "dim") + , ("\\exp", EMathOperator "exp") + , ("\\gcd", EMathOperator "gcd") + , ("\\hom", EMathOperator "hom") + , ("\\inf", EMathOperator "inf") + , ("\\ker", EMathOperator "ker") + , ("\\lg", EMathOperator "lg") + , ("\\lim", EMathOperator "lim") + , ("\\liminf", EMathOperator "liminf") + , ("\\limsup", EMathOperator "limsup") + , ("\\ln", EMathOperator "ln") + , ("\\log", EMathOperator "log") + , ("\\max", EMathOperator "max") + , ("\\min", EMathOperator "min") + , ("\\Pr", EMathOperator "Pr") + , ("\\sec", EMathOperator "sec") + , ("\\sin", EMathOperator "sin") + , ("\\sinh", EMathOperator "sinh") + , ("\\sup", EMathOperator "sup") + , ("\\tan", EMathOperator "tan") + , ("\\tanh", EMathOperator "tanh") ] diff --git a/tests/02.xhtml b/tests/02.xhtml --- a/tests/02.xhtml +++ b/tests/02.xhtml @@ -8,24 +8,28 @@ 2 = - ( - - - ( - 3 - - - x - ) - × - 2 - - - 3 - - - x - - - ) + + ( + + + + ( + 3 + - + x + ) + + × + 2 + + + 3 + - + x + + + ) + diff --git a/tests/04.xhtml b/tests/04.xhtml --- a/tests/04.xhtml +++ b/tests/04.xhtml @@ -17,16 +17,16 @@ - - - ( - 5 - - - T - + + + ( + 5 + - + T ) - 2 - - + + 2 + 2 diff --git a/tests/05.xhtml b/tests/05.xhtml --- a/tests/05.xhtml +++ b/tests/05.xhtml @@ -20,9 +20,9 @@ s f - ( + ( y - ) + ) d y @@ -36,14 +36,14 @@ x f - ( + ( y - ) - ( + ) + ( x - y - ) + ) d y diff --git a/tests/06.xhtml b/tests/06.xhtml --- a/tests/06.xhtml +++ b/tests/06.xhtml @@ -38,21 +38,23 @@ 3 m - ( - m - - - 3 - n - - + - n - - - 3 + + ( m - - ) + + + 3 + n + + + + n + + + 3 + m + + ) + diff --git a/tests/07.xhtml b/tests/07.xhtml --- a/tests/07.xhtml +++ b/tests/07.xhtml @@ -11,22 +11,22 @@ ʹ + p - ( + ( x - ) + ) u ʹ + q - ( + ( x - ) + ) u = f - ( + ( x - ) + ) , x diff --git a/tests/08.xhtml b/tests/08.xhtml --- a/tests/08.xhtml +++ b/tests/08.xhtml @@ -6,49 +6,49 @@ - ∣ + ∣ z ‾ - ∣ + ∣ = - ∣ + ∣ z - ∣ + ∣ , - ∣ - ( + ∣ + ( z ‾ - ) + ) n - ∣ + ∣ = - ∣ + ∣ z - ∣ + ∣ n , arg - ( + ( z n - ) + ) = n arg - ( + ( z - ) + ) diff --git a/tests/09.xhtml b/tests/09.xhtml --- a/tests/09.xhtml +++ b/tests/09.xhtml @@ -6,7 +6,7 @@ - + lim z @@ -16,19 +16,19 @@ 0 - + f - ( + ( z - ) + ) = f - ( + ( z 0 - ) + ) diff --git a/tests/10.xhtml b/tests/10.xhtml --- a/tests/10.xhtml +++ b/tests/10.xhtml @@ -10,9 +10,9 @@ φ n - ( + ( κ - ) + ) = 1 @@ -36,10 +36,10 @@ sin - ( + ( κ R - ) + ) κ @@ -53,28 +53,30 @@ R - [ - - R - 2 - - - - ∂ - - D - n - - ( - R - ) - - - ∂ + + [ + R - - - ] + 2 + + + + ∂ + + D + n + + ( + R + ) + + + ∂ + R + + + ] + d R diff --git a/tests/11.xhtml b/tests/11.xhtml --- a/tests/11.xhtml +++ b/tests/11.xhtml @@ -10,9 +10,9 @@ φ n - ( + ( κ - ) + ) = 0 . diff --git a/tests/12.xhtml b/tests/12.xhtml --- a/tests/12.xhtml +++ b/tests/12.xhtml @@ -7,9 +7,9 @@ f - ( + ( x - ) + ) = { diff --git a/tests/13.xhtml b/tests/13.xhtml --- a/tests/13.xhtml +++ b/tests/13.xhtml @@ -14,7 +14,7 @@ F q - ( + ( a 1 @@ -40,7 +40,7 @@ ; z - ) + ) = ∑ @@ -53,44 +53,44 @@ - ( + ( a 1 - ) + ) n ⋯ - ( + ( a p - ) + ) n - ( + ( c 1 - ) + ) n ⋯ - ( + ( c q - ) + ) n diff --git a/tests/19.xhtml b/tests/19.xhtml --- a/tests/19.xhtml +++ b/tests/19.xhtml @@ -7,7 +7,7 @@ - [ + [ @@ -99,10 +99,10 @@ - ] + ] - ( + ( @@ -121,10 +121,10 @@ - ) + ) - { + { @@ -143,10 +143,10 @@ - } + } - ∣ + ∣ @@ -165,10 +165,10 @@ - ∣ + ∣ - ∥ + ∥ @@ -187,7 +187,7 @@ - ∥ + ∥ diff --git a/texmath.cabal b/texmath.cabal --- a/texmath.cabal +++ b/texmath.cabal @@ -1,5 +1,5 @@ Name: texmath -Version: 0.1.1 +Version: 0.2 Cabal-version: >= 1.2 Build-type: Simple Synopsis: Conversion of LaTeX math formulas to MathML.