@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
1+{-# LANGUAGE PatternGuards, ViewPatterns #-}
22
33{-
44Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -59,18 +59,19 @@ import Data.Bits ((.|.))
5959import qualified Data.ByteString.Lazy as B
6060import qualified Text.Pandoc.UTF8 as UTF8
6161import Control.Monad.Reader
62−import Control.Applicative ((<$>))
62+import Control.Applicative ((<$>), (<|>))
6363import qualified Data.Map as M
6464import Text.Pandoc.Compat.Except
6565import Text.TeXMath.Readers.OMML (readOMML)
6666import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))
6767import Text.TeXMath (Exp)
68−import Data.Char (readLitChar)
68+import Data.Char (readLitChar, ord, chr)
6969
7070data ReaderEnv = ReaderEnv { envNotes :: Notes
7171 , envNumbering :: Numbering
7272 , envRelationships :: [Relationship]
7373 , envMedia :: Media
74+ , envFont :: Maybe Font
7475 }
7576 deriving Show
7677
@@ -234,7 +235,7 @@ archiveToDocx archive = do
234235 numbering = archiveToNumbering archive
235236 rels = archiveToRelationships archive
236237 media = archiveToMedia archive
237− rEnv = ReaderEnv notes numbering rels media
238+ rEnv = ReaderEnv notes numbering rels media Nothing
238239 doc <- runD (archiveToDocument archive) rEnv
239240 return $ Docx doc
240241
@@ -672,12 +673,21 @@ elemToRunElem :: NameSpaces -> Element -> D RunElem
672673elemToRunElem ns element
673674 | isElem ns "w" "t" element
674675 || isElem ns "w" "delText" element
675− || isElem ns "m" "t" element =
676− return $ TextRun $ strContent element
676+ || isElem ns "m" "t" element = do
677+ let str = strContent element
678+ font <- asks envFont
679+ case font of
680+ Nothing -> return $ TextRun str
681+ Just f -> return . TextRun $
682+ map (\x -> fromMaybe x . getUnicode f . lowerFromPrivate $ x) str
677683 | isElem ns "w" "br" element = return LnBrk
678684 | isElem ns "w" "tab" element = return Tab
679685 | isElem ns "w" "sym" element = return (getSymChar ns element)
680686 | otherwise = throwError WrongElem
687+ where
688+ lowerFromPrivate (ord -> c)
689+ | c >= ord '\xF000' = chr $ c - ord '\xF000'
690+ | otherwise = chr c
681691
682692-- The char attribute is a hex string
683693getSymChar :: NameSpaces -> Element -> RunElem
@@ -700,6 +710,15 @@ stringToFont _ = Nothing
700710elemToRunElems :: NameSpaces -> Element -> D [RunElem]
701711elemToRunElems ns element
702712 | isElem ns "w" "r" element
703− || isElem ns "m" "r" element =
704− mapD (elemToRunElem ns) (elChildren element)
713+ || isElem ns "m" "r" element = do
714+ let qualName = elemName ns "w"
715+ let font = do
716+ fontElem <- findElement (qualName "rFonts") element
717+ stringToFont =<<
718+ (foldr (<|>) Nothing $
719+ map (flip findAttr fontElem . qualName) ["ascii", "hAnsi"])
720+ local (setFont font) (mapD (elemToRunElem ns) (elChildren element))
705721elemToRunElems _ _ = throwError WrongElem
722+
723+setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
724+setFont f s = s{envFont = f}