@@ -123,7 +123,7 @@ data WriterState = WriterState{
123123 , stComments :: [([(String,String)], [Inline])]
124124 , stSectionIds :: Set.Set String
125125 , stExternalLinks :: M.Map String String
126− , stImages :: M.Map FilePath (String, String, Maybe MimeType, Element, B.ByteString)
126+ , stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
127127 , stLists :: [ListMarker]
128128 , stInsId :: Int
129129 , stDelId :: Int
@@ -294,7 +294,7 @@ writeDocx opts doc@(Pandoc meta _) = do
294294 let imgs = M.elems $ stImages st
295295
296296 -- create entries for images in word/media/...
297− let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
297+ let toImageEntry (_,path,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
298298 let imageEntries = map toImageEntry imgs
299299
300300 let stdAttributes =
@@ -326,7 +326,7 @@ writeDocx opts doc@(Pandoc meta _) = do
326326 -- [Content_Types].xml
327327 let mkOverrideNode (part', contentType') = mknode "Override"
328328 [("PartName",part'),("ContentType",contentType')] ()
329− let mkImageOverride (_, imgpath, mbMimeType, _, _) =
329+ let mkImageOverride (_, imgpath, mbMimeType, _) =
330330 mkOverrideNode ("/word/" ++ imgpath,
331331 fromMaybe "application/octet-stream" mbMimeType)
332332 let mkMediaOverride imgpath =
@@ -407,7 +407,7 @@ writeDocx opts doc@(Pandoc meta _) = do
407407 let renumHeaders = renumIds (\q -> qName q == "Id") idMap headers
408408 let renumFooters = renumIds (\q -> qName q == "Id") idMap footers
409409 let baserels = baserels' ++ renumHeaders ++ renumFooters
410− let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
410+ let toImgRel (ident,path,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()
411411 let imgrels = map toImgRel imgs
412412 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
413413 let linkrels = map toLinkRel $ M.toList $ stExternalLinks st
@@ -1275,87 +1275,103 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do
12751275 return i
12761276 return [ mknode "w:hyperlink" [("r:id",id')] contents ]
12771277inlineToOpenXML' opts (Image attr alt (src, title)) = do
1278− -- first, check to see if we've already done this image
12791278 pageWidth <- asks envPrintWidth
1280− imgs <- gets stImages
1281− case M.lookup src imgs of
1282− Just (_,_,_,elt,_) -> return [elt]
1283− Nothing ->
1284− catchError
1285− (do (img, mt) <- P.fetchItem src
1286− ident <- ("rId"++) `fmap` getUniqueId
1287− let (xpt,ypt) = desiredSizeInPoints opts attr
1288− (either (const def) id (imageSize opts img))
1289− -- 12700 emu = 1 pt
1290− let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700)
1291− (pageWidth * 12700)
1292− let cNvPicPr = mknode "pic:cNvPicPr" [] $
1293− mknode "a:picLocks" [("noChangeArrowheads","1")
1294− ,("noChangeAspect","1")] ()
1295− let nvPicPr = mknode "pic:nvPicPr" []
1296− [ mknode "pic:cNvPr"
1297− [("descr",src),("id","0"),("name","Picture")] ()
1298− , cNvPicPr ]
1299− let blipFill = mknode "pic:blipFill" []
1300− [ mknode "a:blip" [("r:embed",ident)] ()
1301− , mknode "a:stretch" [] $
1302− mknode "a:fillRect" [] () ]
1303− let xfrm = mknode "a:xfrm" []
1304− [ mknode "a:off" [("x","0"),("y","0")] ()
1305− , mknode "a:ext" [("cx",show xemu)
1306− ,("cy",show yemu)] () ]
1307− let prstGeom = mknode "a:prstGeom" [("prst","rect")] $
1308− mknode "a:avLst" [] ()
1309− let ln = mknode "a:ln" [("w","9525")]
1310− [ mknode "a:noFill" [] ()
1311− , mknode "a:headEnd" [] ()
1312− , mknode "a:tailEnd" [] () ]
1313− let spPr = mknode "pic:spPr" [("bwMode","auto")]
1314− [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
1315− let graphic = mknode "a:graphic" [] $
1316− mknode "a:graphicData"
1317− [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
1318− [ mknode "pic:pic" []
1319− [ nvPicPr
1320− , blipFill
1321− , spPr ] ]
1322− let imgElt = mknode "w:r" [] $
1323− mknode "w:drawing" [] $
1324− mknode "wp:inline" []
1325− [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
1326− , mknode "wp:effectExtent"
1327− [("b","0"),("l","0"),("r","0"),("t","0")] ()
1328− , mknode "wp:docPr" [("descr",stringify alt)
1329− ,("title", title)
1330− ,("id","1")
1331− ,("name","Picture")] ()
1332− , graphic ]
1333− let imgext = case mt >>= extensionFromMimeType of
1334− Just x -> '.':x
1335− Nothing -> case imageType img of
1336− Just Png -> ".png"
1337− Just Jpeg -> ".jpeg"
1338− Just Gif -> ".gif"
1339− Just Pdf -> ".pdf"
1340− Just Eps -> ".eps"
1341− Just Svg -> ".svg"
1342− Just Emf -> ".emf"
1343− Nothing -> ""
1344− if null imgext
1345− then -- without an extension there is no rule for content type
1346− inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
1347− else do
1348− let imgpath = "media/" ++ ident ++ imgext
1349− let mbMimeType = mt <|> getMimeType imgpath
1350− -- insert mime type to use in constructing [Content_Types].xml
1351− modify $ \st -> st{ stImages =
1352− M.insert src (ident, imgpath, mbMimeType, imgElt, img)
1353− $ stImages st }
1354− return [imgElt])
1355− (\e -> do
1356− report $ CouldNotFetchResource src (show e)
1357− -- emit alt text
1358− inlinesToOpenXML opts alt)
1279+ imgs <- gets stImages
1280+ let
1281+ stImage = M.lookup src imgs
1282+ generateImgElt (ident, _, _, img) =
1283+ let
1284+ (xpt,ypt) = desiredSizeInPoints opts attr
1285+ (either (const def) id (imageSize opts img))
1286+ -- 12700 emu = 1 pt
1287+ (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700)
1288+ (pageWidth * 12700)
1289+ cNvPicPr = mknode "pic:cNvPicPr" [] $
1290+ mknode "a:picLocks" [("noChangeArrowheads","1")
1291+ ,("noChangeAspect","1")] ()
1292+ nvPicPr = mknode "pic:nvPicPr" []
1293+ [ mknode "pic:cNvPr"
1294+ [("descr",src),("id","0"),("name","Picture")] ()
1295+ , cNvPicPr ]
1296+ blipFill = mknode "pic:blipFill" []
1297+ [ mknode "a:blip" [("r:embed",ident)] ()
1298+ , mknode "a:stretch" [] $
1299+ mknode "a:fillRect" [] ()
1300+ ]
1301+ xfrm = mknode "a:xfrm" []
1302+ [ mknode "a:off" [("x","0"),("y","0")] ()
1303+ , mknode "a:ext" [("cx",show xemu)
1304+ ,("cy",show yemu)] () ]
1305+ prstGeom = mknode "a:prstGeom" [("prst","rect")] $
1306+ mknode "a:avLst" [] ()
1307+ ln = mknode "a:ln" [("w","9525")]
1308+ [ mknode "a:noFill" [] ()
1309+ , mknode "a:headEnd" [] ()
1310+ , mknode "a:tailEnd" [] () ]
1311+ spPr = mknode "pic:spPr" [("bwMode","auto")]
1312+ [xfrm, prstGeom, mknode "a:noFill" [] (), ln]
1313+ graphic = mknode "a:graphic" [] $
1314+ mknode "a:graphicData"
1315+ [("uri","http://schemas.openxmlformats.org/drawingml/2006/picture")]
1316+ [ mknode "pic:pic" []
1317+ [ nvPicPr
1318+ , blipFill
1319+ , spPr
1320+ ]
1321+ ]
1322+ imgElt = mknode "w:r" [] $
1323+ mknode "w:drawing" [] $
1324+ mknode "wp:inline" []
1325+ [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] ()
1326+ , mknode "wp:effectExtent"
1327+ [("b","0"),("l","0"),("r","0"),("t","0")] ()
1328+ , mknode "wp:docPr"
1329+ [ ("descr", stringify alt)
1330+ , ("title", title)
1331+ , ("id","1")
1332+ , ("name","Picture")
1333+ ] ()
1334+ , graphic
1335+ ]
1336+ in
1337+ imgElt
1338+
1339+ case stImage of
1340+ Just imgData -> return $ [generateImgElt imgData]
1341+ Nothing -> ( do --try
1342+ (img, mt) <- P.fetchItem src
1343+ ident <- ("rId"++) `fmap` getUniqueId
1344+
1345+ let
1346+ imgext = case mt >>= extensionFromMimeType of
1347+ Just x -> '.':x
1348+ Nothing -> case imageType img of
1349+ Just Png -> ".png"
1350+ Just Jpeg -> ".jpeg"
1351+ Just Gif -> ".gif"
1352+ Just Pdf -> ".pdf"
1353+ Just Eps -> ".eps"
1354+ Just Svg -> ".svg"
1355+ Just Emf -> ".emf"
1356+ Nothing -> ""
1357+ imgpath = "media/" ++ ident ++ imgext
1358+ mbMimeType = mt <|> getMimeType imgpath
1359+
1360+ imgData = (ident, imgpath, mbMimeType, img)
1361+
1362+ if null imgext
1363+ then -- without an extension there is no rule for content type
1364+ inlinesToOpenXML opts alt -- return alt to avoid corrupted docx
1365+ else do
1366+ -- insert mime type to use in constructing [Content_Types].xml
1367+ modify $ \st -> st { stImages = M.insert src imgData $ stImages st }
1368+ return [generateImgElt imgData]
1369+ )
1370+ `catchError` ( \e -> do
1371+ report $ CouldNotFetchResource src (show e)
1372+ -- emit alt text
1373+ inlinesToOpenXML opts alt
1374+ )
13591375
13601376br :: Element
13611377br = breakElement "textWrapping"