aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs15
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs27
2 files changed, 32 insertions, 10 deletions
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