From 37931cb0c56c8ae770f696a31f7beba1d6cb0f08 Mon Sep 17 00:00:00 2001 From: mb21 Date: Sun, 6 Dec 2015 00:41:04 +0100 Subject: Docx reader: image attributes --- src/Text/Pandoc/Readers/Docx.hs | 15 +++++++++++---- src/Text/Pandoc/Readers/Docx/Parse.hs | 27 +++++++++++++++++++++------ 2 files changed, 32 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 3e934d272..44f67ce75 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -298,10 +298,17 @@ runToInlines (Footnote bps) = do runToInlines (Endnote bps) = do blksList <- concatReduce <$> (mapM bodyPartToBlocks bps) return $ note blksList -runToInlines (InlineDrawing fp bs) = do +runToInlines (InlineDrawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" + +extentToAttr :: Extent -> Attr +extentToAttr (Just (w, h)) = + ("", [], [("width", showDim w), ("height", showDim h)] ) + where + showDim d = show (d / 914400) ++ "in" +extentToAttr _ = nullAttr parPartToInlines :: ParPart -> DocxContext Inlines parPartToInlines (PlainRun r) = runToInlines r @@ -348,10 +355,10 @@ parPartToInlines (BookMark _ anchor) = unless inHdrBool (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}) return $ spanWith (newAnchor, ["anchor"], []) mempty -parPartToInlines (Drawing fp bs) = do +parPartToInlines (Drawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" parPartToInlines (InternalHyperLink anchor runs) = do ils <- concatReduce <$> mapM runToInlines runs return $ link ('#' : anchor) "" ils diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 91655d2b4..eec8b12c9 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -35,6 +35,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , Body(..) , BodyPart(..) , TblLook(..) + , Extent , ParPart(..) , Run(..) , RunElem(..) @@ -62,6 +63,7 @@ import Control.Monad.Reader import Control.Applicative ((<|>)) import qualified Data.Map as M import Text.Pandoc.Compat.Except +import Text.Pandoc.Shared (safeRead) import Text.TeXMath.Readers.OMML (readOMML) import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..)) import Text.TeXMath (Exp) @@ -196,20 +198,23 @@ data Row = Row [Cell] data Cell = Cell [BodyPart] deriving Show +-- (width, height) in EMUs +type Extent = Maybe (Double, Double) + data ParPart = PlainRun Run | Insertion ChangeId Author ChangeDate [Run] | Deletion ChangeId Author ChangeDate [Run] | BookMark BookMarkId Anchor | InternalHyperLink Anchor [Run] | ExternalHyperLink URL [Run] - | Drawing FilePath B.ByteString + | Drawing FilePath B.ByteString Extent | PlainOMath [Exp] deriving Show data Run = Run RunStyle [RunElem] | Footnote [BodyPart] | Endnote [BodyPart] - | InlineDrawing FilePath B.ByteString + | InlineDrawing FilePath B.ByteString Extent deriving Show data RunElem = TextRun String | LnBrk | Tab | SoftHyphen | NoBreakHyphen @@ -619,13 +624,13 @@ expandDrawingId s = do elemToParPart :: NameSpaces -> Element -> D ParPart elemToParPart ns element | isElem ns "w" "r" element - , Just _ <- findChild (elemName ns "w" "drawing") element = + , Just drawingElem <- findChild (elemName ns "w" "drawing") element = let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) element >>= findAttr (QName "embed" (lookup "r" ns) (Just "r")) in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem -- The below is an attempt to deal with images in deprecated vml format. elemToParPart ns element @@ -635,7 +640,7 @@ elemToParPart ns element >>= findAttr (elemName ns "r" "id") in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs Nothing) Nothing -> throwError WrongElem elemToParPart ns element | isElem ns "w" "r" element = @@ -687,6 +692,16 @@ lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s) lookupEndnote :: String -> Notes -> Maybe Element lookupEndnote s (Notes _ _ ens) = ens >>= (M.lookup s) +elemToExtent :: Element -> Extent +elemToExtent drawingElem = + case (getDim "cx", getDim "cy") of + (Just w, Just h) -> Just (w, h) + _ -> Nothing + where + wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing" + getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem + >>= findAttr (QName at Nothing Nothing) >>= safeRead + elemToRun :: NameSpaces -> Element -> D Run elemToRun ns element | isElem ns "w" "r" element @@ -697,7 +712,7 @@ elemToRun ns element in case drawing of Just s -> expandDrawingId s >>= - (\(fp, bs) -> return $ InlineDrawing fp bs) + (\(fp, bs) -> return $ InlineDrawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem elemToRun ns element | isElem ns "w" "r" element -- cgit v1.2.3