diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Docx.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 128 |
1 files changed, 63 insertions, 65 deletions
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" [] () ] |