@@ -59,7 +59,7 @@ data WriterState = WriterState{
5959 , stFootnotes :: [Element]
6060 , stSectionIds :: [String]
6161 , stExternalLinks :: M.Map String String
62− , stImages :: M.Map FilePath (String, B.ByteString)
62+ , stImages :: M.Map FilePath (String, String, Element, B.ByteString)
6363 , stListLevel :: Int
6464 , stListNumId :: Int
6565 , stNumStyles :: M.Map ListMarker Int
@@ -112,13 +112,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
112112 defaultWriterState
113113 epochtime <- floor `fmap` getPOSIXTime
114114 let imgs = M.elems $ stImages st
115− let imgPath ident img = "media/" ++ ident ++
116− case imageType img of
117− Just Png -> ".png"
118− Just Jpeg -> ".jpeg"
119− Just Gif -> ".gif"
120− Nothing -> ""
121− let toImgRel (ident,img) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",imgPath ident img)] ()
115+ let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
122116 let newrels = map toImgRel imgs
123117 let relpath = "word/_rels/document.xml.rels"
124118 let reldoc = case findEntryByPath relpath refArchive >>=
@@ -127,8 +121,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
127121 Nothing -> error $ relpath ++ "missing in reference docx"
128122 let reldoc' = reldoc{ elContent = elContent reldoc ++ map Elem newrels }
129123 -- create entries for images
130− let toImageEntry (ident,img) = toEntry ("word/" ++ imgPath ident img)
131− epochtime $ toLazy img
124+ let toImageEntry (_,path,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
132125 let imageEntries = map toImageEntry imgs
133126 -- NOW get list of external links and images from this, and do what's needed
134127 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
626619 return i
627620 return [ mknode "w:hyperlink" [("r:id",id')] contents ]
628621inlineToOpenXML opts (Image alt (src, tit)) = do
629− res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
630− -- res is Right (img, maybeMIMEString) or Left err
631− case res of
632− Left (_ :: E.SomeException) -> do
633− liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
634− inlinesToOpenXML opts alt
635− Right (img, _) -> do
636− imgs <- gets stImages
637− -- TODO move this check to before the getItem
638− -- also TODO, instead of storing ident, imagebs; store
639− -- the whole Element, so we don't have to reconstruct it at all.
640− (ident,size) <- case M.lookup src imgs of
641− Just (i,img') -> return (i, imageSize img')
642− Nothing -> do
643− ident' <- ("rId"++) `fmap` getUniqueId
644− let size' = imageSize img
645− modify $ \st -> st{
646− stImages = M.insert src (ident',img) $ stImages st }
647− return (ident',size')
648− let (xpt,ypt) = maybe (120,120) sizeInPoints size
649− -- 12700 emu = 1 pt
650− let (xemu,yemu) = (xpt * 12700, ypt * 12700)
651− let cNvPicPr = mknode "pic:cNvPicPr" [] $
652− mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
653− let nvPicPr = mknode "pic:nvPicPr" []
654− [ mknode "pic:cNvPr"
655− [("descr",src),("id","0"),("name","Picture")] ()
656− , cNvPicPr ]
657− let blipFill = mknode "pic:blipFill" []
658− [ mknode "a:blip" [("r:embed",ident)] ()
659− , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ]
660− let xfrm = mknode "a:xfrm" []
661− [ mknode "a:off" [("x","0"),("y","0")] ()
662− , mknode "a:ext" [("cx",show xemu),("cy",show yemu)] () ]
663− let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
664− mknode "a:avLst" [] ()
665− let ln = mknode "a:ln" [("w","9525")]
666− [ mknode "a:noFill" [] ()
667− , mknode "a:headEnd" [] ()
668− , mknode "a:tailEnd" [] () ]
669− let spPr = mknode "pic:spPr" [("bwMode","auto")]
670− [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
671− let graphic = mknode "a:graphic" [] $
672− mknode "a:graphicData" [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
673− [ mknode "pic:pic" []
674− [ nvPicPr
675− , blipFill
676− , spPr ] ]
677− return [ mknode "w:r" [] $
678− mknode "w:drawing" [] $
679− mknode "wp:inline" []
680− [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
681− , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
682− , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
683− , graphic ] ]
622+ -- first, check to see if we've already done this image
623+ imgs <- gets stImages
624+ case M.lookup src imgs of
625+ Just (_,_,elt,_) -> return [elt]
626+ Nothing -> do
627+ res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
628+ case res of
629+ Left (_ :: E.SomeException) -> do
630+ liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
631+ -- emit alt text
632+ inlinesToOpenXML opts alt
633+ Right (img, _) -> do
634+ ident <- ("rId"++) `fmap` getUniqueId
635+ let size = imageSize img
636+ let (xpt,ypt) = maybe (120,120) sizeInPoints size
637+ -- 12700 emu = 1 pt
638+ let (xemu,yemu) = (xpt * 12700, ypt * 12700)
639+ let cNvPicPr = mknode "pic:cNvPicPr" [] $
640+ mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
641+ let nvPicPr = mknode "pic:nvPicPr" []
642+ [ mknode "pic:cNvPr"
643+ [("descr",src),("id","0"),("name","Picture")] ()
644+ , cNvPicPr ]
645+ let blipFill = mknode "pic:blipFill" []
646+ [ mknode "a:blip" [("r:embed",ident)] ()
647+ , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ]
648+ let xfrm = mknode "a:xfrm" []
649+ [ mknode "a:off" [("x","0"),("y","0")] ()
650+ , mknode "a:ext" [("cx",show xemu),("cy",show yemu)] () ]
651+ let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
652+ mknode "a:avLst" [] ()
653+ let ln = mknode "a:ln" [("w","9525")]
654+ [ mknode "a:noFill" [] ()
655+ , mknode "a:headEnd" [] ()
656+ , mknode "a:tailEnd" [] () ]
657+ let spPr = mknode "pic:spPr" [("bwMode","auto")]
658+ [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
659+ let graphic = mknode "a:graphic" [] $
660+ mknode "a:graphicData" [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
661+ [ mknode "pic:pic" []
662+ [ nvPicPr
663+ , blipFill
664+ , spPr ] ]
665+ let imgElt = mknode "w:r" [] $
666+ mknode "w:drawing" [] $
667+ mknode "wp:inline" []
668+ [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
669+ , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
670+ , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
671+ , graphic ]
672+ modify $ \st -> st{ stImages = M.insert src (ident, imgPath ident img, imgElt, img) $ stImages st }
673+ return [imgElt]
674+
675+imgPath :: String -> B.ByteString -> String
676+imgPath ident img = "media/" ++ ident ++
677+ case imageType img of
678+ Just Png -> ".png"
679+ Just Jpeg -> ".jpeg"
680+ Just Gif -> ".gif"
681+ Nothing -> ""
684682
685683br :: Element
686684br = mknode "w:r" [] [mknode "w:cr" [] () ]