diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 5d220ca79..f40429aaa 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -59,7 +59,7 @@ data WriterState = WriterState{
, stFootnotes :: [Element]
, stSectionIds :: [String]
, stExternalLinks :: M.Map String String
- , stImages :: M.Map FilePath (String, B.ByteString)
+ , stImages :: M.Map FilePath (String, String, Element, B.ByteString)
, stListLevel :: Int
, stListNumId :: Int
, stNumStyles :: M.Map ListMarker Int
@@ -112,13 +112,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
defaultWriterState
epochtime <- floor `fmap` getPOSIXTime
let imgs = M.elems $ stImages st
- let imgPath ident img = "media/" ++ ident ++
- case imageType img of
- Just Png -> ".png"
- Just Jpeg -> ".jpeg"
- Just Gif -> ".gif"
- Nothing -> ""
- let toImgRel (ident,img) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",imgPath ident img)] ()
+ let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
let newrels = map toImgRel imgs
let relpath = "word/_rels/document.xml.rels"
let reldoc = case findEntryByPath relpath refArchive >>=
@@ -127,8 +121,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
Nothing -> error $ relpath ++ "missing in reference docx"
let reldoc' = reldoc{ elContent = elContent reldoc ++ map Elem newrels }
-- create entries for images
- let toImageEntry (ident,img) = toEntry ("word/" ++ imgPath ident img)
- epochtime $ toLazy img
+ let toImageEntry (_,path,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
let imageEntries = map toImageEntry imgs
-- NOW get list of external links and images from this, and do what's needed
let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
@@ -626,61 +619,66 @@ inlineToOpenXML opts (Link txt (src,_)) = do
return i
return [ mknode "w:hyperlink" [("r:id",id')] contents ]
inlineToOpenXML opts (Image alt (src, tit)) = do
- res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
- -- res is Right (img, maybeMIMEString) or Left err
- case res of
- Left (_ :: E.SomeException) -> do
- liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
- inlinesToOpenXML opts alt
- Right (img, _) -> do
- imgs <- gets stImages
- -- TODO move this check to before the getItem
- -- also TODO, instead of storing ident, imagebs; store
- -- the whole Element, so we don't have to reconstruct it at all.
- (ident,size) <- case M.lookup src imgs of
- Just (i,img') -> return (i, imageSize img')
- Nothing -> do
- ident' <- ("rId"++) `fmap` getUniqueId
- let size' = imageSize img
- modify $ \st -> st{
- stImages = M.insert src (ident',img) $ stImages st }
- return (ident',size')
- let (xpt,ypt) = maybe (120,120) sizeInPoints size
- -- 12700 emu = 1 pt
- let (xemu,yemu) = (xpt * 12700, ypt * 12700)
- let cNvPicPr = mknode "pic:cNvPicPr" [] $
- mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
- let nvPicPr = mknode "pic:nvPicPr" []
- [ mknode "pic:cNvPr"
- [("descr",src),("id","0"),("name","Picture")] ()
- , cNvPicPr ]
- let blipFill = mknode "pic:blipFill" []
- [ mknode "a:blip" [("r:embed",ident)] ()
- , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ]
- let xfrm = mknode "a:xfrm" []
- [ mknode "a:off" [("x","0"),("y","0")] ()
- , mknode "a:ext" [("cx",show xemu),("cy",show yemu)] () ]
- let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
- mknode "a:avLst" [] ()
- let ln = mknode "a:ln" [("w","9525")]
- [ mknode "a:noFill" [] ()
- , mknode "a:headEnd" [] ()
- , mknode "a:tailEnd" [] () ]
- let spPr = mknode "pic:spPr" [("bwMode","auto")]
- [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
- let graphic = mknode "a:graphic" [] $
- mknode "a:graphicData" [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
- [ mknode "pic:pic" []
- [ nvPicPr
- , blipFill
- , spPr ] ]
- return [ mknode "w:r" [] $
- mknode "w:drawing" [] $
- mknode "wp:inline" []
- [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
- , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
- , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
- , graphic ] ]
+ -- first, check to see if we've already done this image
+ imgs <- gets stImages
+ case M.lookup src imgs of
+ Just (_,_,elt,_) -> return [elt]
+ Nothing -> do
+ res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
+ case res of
+ Left (_ :: E.SomeException) -> do
+ liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+ -- emit alt text
+ inlinesToOpenXML opts alt
+ Right (img, _) -> do
+ ident <- ("rId"++) `fmap` getUniqueId
+ let size = imageSize img
+ let (xpt,ypt) = maybe (120,120) sizeInPoints size
+ -- 12700 emu = 1 pt
+ let (xemu,yemu) = (xpt * 12700, ypt * 12700)
+ let cNvPicPr = mknode "pic:cNvPicPr" [] $
+ mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
+ let nvPicPr = mknode "pic:nvPicPr" []
+ [ mknode "pic:cNvPr"
+ [("descr",src),("id","0"),("name","Picture")] ()
+ , cNvPicPr ]
+ let blipFill = mknode "pic:blipFill" []
+ [ mknode "a:blip" [("r:embed",ident)] ()
+ , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ]
+ let xfrm = mknode "a:xfrm" []
+ [ mknode "a:off" [("x","0"),("y","0")] ()
+ , mknode "a:ext" [("cx",show xemu),("cy",show yemu)] () ]
+ let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
+ mknode "a:avLst" [] ()
+ let ln = mknode "a:ln" [("w","9525")]
+ [ mknode "a:noFill" [] ()
+ , mknode "a:headEnd" [] ()
+ , mknode "a:tailEnd" [] () ]
+ let spPr = mknode "pic:spPr" [("bwMode","auto")]
+ [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
+ let graphic = mknode "a:graphic" [] $
+ mknode "a:graphicData" [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
+ [ mknode "pic:pic" []
+ [ nvPicPr
+ , blipFill
+ , spPr ] ]
+ let imgElt = mknode "w:r" [] $
+ mknode "w:drawing" [] $
+ mknode "wp:inline" []
+ [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
+ , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
+ , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
+ , graphic ]
+ modify $ \st -> st{ stImages = M.insert src (ident, imgPath ident img, imgElt, img) $ stImages st }
+ return [imgElt]
+
+imgPath :: String -> B.ByteString -> String
+imgPath ident img = "media/" ++ ident ++
+ case imageType img of
+ Just Png -> ".png"
+ Just Jpeg -> ".jpeg"
+ Just Gif -> ".gif"
+ Nothing -> ""
br :: Element
br = mknode "w:r" [] [mknode "w:cr" [] () ]