module Text.TeXMath.OMML (toOMML, showExp)
where
import Text.XML.Light
import Text.TeXMath.Types
import Data.Generics (everywhere, mkT)
toOMML :: DisplayType -> [Exp] -> Element
toOMML dt = container . concatMap showExp
. everywhere (mkT $ handleDownup dt)
where container = case dt of
DisplayBlock -> \x -> mnode "oMathPara"
[ mnode "oMathParaPr"
$ mnodeA "jc" "center" ()
, mnode "oMath" x ]
DisplayInline -> mnode "oMath"
mnode :: Node t => String -> t -> Element
mnode s = node (QName s Nothing (Just "m"))
mnodeA :: Node t => String -> String -> t -> Element
mnodeA s v = add_attr (Attr (QName "val" Nothing (Just "m")) v) . mnode s
str :: [Element] -> String -> Element
str props s = mnode "r" [ mnode "rPr" props
, mnode "t" s ]
showBinary :: String -> Exp -> Exp -> Element
showBinary c x y =
case c of
"\\frac" -> mnode "f" [ mnode "fPr" $
mnodeA "type" "bar" ()
, mnode "num" x'
, mnode "den" y']
"\\dfrac" -> showBinary "\\frac" x y
"\\tfrac" -> mnode "f" [ mnode "fPr" $
mnodeA "type" "lin" ()
, mnode "num" x'
, mnode "den" y']
"\\sqrt" -> mnode "rad" [ mnode "radPr" $
mnodeA "degHide" "on" ()
, mnode "deg" y'
, mnode "e" x']
"\\stackrel" -> mnode "limUpp" [ mnode "e" x'
, mnode "lim" y']
"\\overset" -> mnode "limUpp" [ mnode "e" x'
, mnode "lim" y' ]
"\\underset" -> mnode "limLow" [ mnode "e" x'
, mnode "lim" y' ]
"\\binom" -> mnode "d" [ mnode "dPr" $
mnodeA "sepChr" "," ()
, mnode "e" $
mnode "f" [ mnode "fPr" $
mnodeA "type"
"noBar" ()
, mnode "num" x'
, mnode "den" y' ]]
_ -> error $ "Unknown binary operator " ++ c
where x' = showExp x
y' = showExp y
makeArray :: [Alignment] -> [ArrayLine] -> Element
makeArray as rs = mnode "m" $ mProps : map toMr rs
where mProps = mnode "mPr"
[ mnodeA "baseJc" "center" ()
, mnodeA "plcHide" "on" ()
, mnode "mcs" $ map toMc as' ]
as' = take (length rs) $ as ++ cycle [AlignDefault]
toMr r = mnode "mr" $ map (mnode "e" . concatMap showExp) r
toMc a = mnode "mc" $ mnode "mcPr"
$ mnodeA "mcJc" (toAlign a) ()
toAlign AlignLeft = "left"
toAlign AlignRight = "right"
toAlign AlignCenter = "center"
toAlign AlignDefault = "left"
makeText :: TextType -> String -> Element
makeText a s = str attrs s
where attrs = case a of
TextNormal -> [sty "p"]
TextBold -> [sty "b"]
TextItalic -> [sty "i"]
TextMonospace -> [sty "p", scr "monospace"]
TextSansSerif -> [sty "p", scr "sans-serif"]
TextDoubleStruck -> [sty "p", scr "double-struck"]
TextScript -> [sty "p", scr "script"]
TextFraktur -> [sty "p", scr "fraktur"]
TextBoldItalic -> [sty "i"]
TextBoldSansSerif -> [sty "b", scr "sans-serif"]
TextBoldScript -> [sty "b", scr "script"]
TextBoldFraktur -> [sty "b", scr "fraktur"]
TextSansSerifItalic -> [sty "i", scr "sans-serif"]
TextBoldSansSerifItalic -> [sty "bi", scr "sans-serif"]
sty x = mnodeA "sty" x ()
scr x = mnodeA "scr" x ()
handleDownup :: DisplayType -> [Exp] -> [Exp]
handleDownup dt (exp' : xs) =
case exp' of
EDown x y
| isNary x -> EGrouped [constructor x y emptyGroup, next] : rest
| otherwise -> case dt of
DisplayBlock -> EUnder x y : xs
DisplayInline -> ESub x y : xs
EUp x y
| isNary x -> EGrouped [constructor x emptyGroup y, next] : rest
| otherwise -> case dt of
DisplayBlock -> EOver x y : xs
DisplayInline -> ESuper x y : xs
EDownup x y z
| isNary x -> EGrouped [constructor x y z, next] : rest
| otherwise -> case dt of
DisplayBlock -> EUnderover x y z : xs
DisplayInline -> ESubsup x y z : xs
ESub x y
| isNary x -> EGrouped [ESubsup x y emptyGroup, next] : rest
ESuper x y
| isNary x -> EGrouped [ESubsup x emptyGroup y, next] : rest
ESubsup x y z
| isNary x -> EGrouped [ESubsup x y z, next] : rest
EOver x y
| isNary x -> EGrouped [EUnderover x y emptyGroup, next] : rest
EUnder x y
| isNary x -> EGrouped [EUnderover x emptyGroup y, next] : rest
EUnderover x y z
| isNary x -> EGrouped [EUnderover x y z, next] : rest
_ -> exp' : next : rest
where (next, rest) = case xs of
(t:ts) -> (t,ts)
[] -> (emptyGroup, [])
emptyGroup = EGrouped []
constructor = case dt of
DisplayBlock -> EUnderover
DisplayInline -> ESubsup
handleDownup _ [] = []
showExp :: Exp -> [Element]
showExp e =
case e of
ENumber x -> [str [] x]
EGrouped [EUnderover (ESymbol Op s) y z, w] -> [makeNary "undOvr" s y z w]
EGrouped [ESubsup (ESymbol Op s) y z, w] -> [makeNary "subSup" s y z w]
EGrouped xs -> concatMap showExp xs
EDelimited start end xs ->
[mnode "d" [ mnode "dPr"
[ mnodeA "begChr" start ()
, mnodeA "endChr" end ()
, mnode "grow" () ]
, mnode "e" $ concatMap showExp xs
] ]
EIdentifier x -> [str [] x]
EMathOperator x -> [str [] x]
EStretchy x -> showExp x
ESymbol _ x -> [str [] x]
ESpace "0.167em" -> [str [] "\x2009"]
ESpace "0.222em" -> [str [] "\x2005"]
ESpace "0.278em" -> [str [] "\x2004"]
ESpace "0.333em" -> [str [] "\x2004"]
ESpace "1em" -> [str [] "\x2001"]
ESpace "2em" -> [str [] "\x2001\x2001"]
ESpace _ -> []
EBinary c x y -> [showBinary c x y]
EUnder x (ESymbol Accent [c]) | isBarChar c ->
[mnode "bar" [ mnode "barPr" $
mnodeA "pos" "bot" ()
, mnode "e" $ showExp x ]]
EOver x (ESymbol Accent [c]) | isBarChar c ->
[mnode "bar" [ mnode "barPr" $
mnodeA "pos" "top" ()
, mnode "e" $ showExp x ]]
EOver x (ESymbol Accent y) ->
[mnode "acc" [ mnode "accPr" $
mnodeA "chr" y ()
, mnode "e" $ showExp x ]]
ESub x y -> [mnode "sSub" [ mnode "e" $ showExp x
, mnode "sub" $ showExp y]]
ESuper x y -> [mnode "sSup" [ mnode "e" $ showExp x
, mnode "sup" $ showExp y]]
ESubsup x y z -> [mnode "sSubSup" [ mnode "e" $ showExp x
, mnode "sub" $ showExp y
, mnode "sup" $ showExp z]]
EUnder x y -> [mnode "limLow" [ mnode "e" $ showExp x
, mnode "lim" $ showExp y]]
EOver x y -> [mnode "limUpp" [ mnode "e" $ showExp x
, mnode "lim" $ showExp y]]
EUnderover x y z -> showExp (EUnder x (EOver y z))
EUnary "\\sqrt" x -> [mnode "rad" [ mnode "radPr" $ mnodeA "degHide" "on" ()
, mnode "deg" ()
, mnode "e" $ showExp x]]
EUnary "\\surd" x -> showExp $ EUnary "\\sqrt" x
EScaled _ x -> showExp x
EArray as ls -> [makeArray as ls]
EText a s -> [makeText a s]
x -> error $ "showExp encountered " ++ show x
isBarChar :: Char -> Bool
isBarChar c = c == '\x203E' || c == '\x00AF'
isNary :: Exp -> Bool
isNary (ESymbol Op _) = True
isNary _ = False
makeNary :: String -> String -> Exp -> Exp -> Exp -> Element
makeNary t s y z w =
mnode "nary" [ mnode "naryPr"
[ mnodeA "chr" s ()
, mnodeA "limLoc" t ()
, mnode "grow" ()
, mnodeA "supHide"
(if y == EGrouped [] then "on" else "off") ()
, mnodeA "supHide"
(if y == EGrouped [] then "on" else "off") ()
]
, mnode "e" $ showExp w
, mnode "sub" $ showExp y
, mnode "sup" $ showExp z ]