From 51caa8b78d66ac81253766cc2c6916d39c14efc2 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 28 Aug 2021 09:19:50 -0700
Subject: Docx writer: handle SVG images.

This change has several parts:

- In Text.Pandoc.App, if the writer is docx, we fill the media
  bag and attempt to convert any SVG images to PNG, adding these
  to the media bag.  The PNG backups have the same filenames as
  the SVG images, but with an added .png extension.  If the conversion
  cannot be done (e.g. because rsvg-convert is not present),
  a warning is omitted.
- In Text.Pandoc.Writers.Docx, we now use Word 2016's syntax for
  including SVG images. If a PNG fallback is present in the media bag,
  we include a link to that too.

It would be helpful if someone with an old Word version could test
to see that the documents we produce can be opened and viewed with
the PNG fallbacks.  If not, then perhaps we can eliminate the
slightly complex code for producing these fallbacks.

Closes #4058.
---
 src/Text/Pandoc/Writers/Docx.hs | 41 ++++++++++++++++++++++++++++++++++++++---
 1 file changed, 38 insertions(+), 3 deletions(-)

(limited to 'src/Text/Pandoc/Writers')

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index efd8b2658..c0e2aae97 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -36,7 +36,9 @@ import Data.Time.Clock.POSIX
 import Data.Digest.Pure.SHA (sha1, showDigest)
 import Skylighting
 import Text.Collate.Lang (renderLang)
-import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang, translateTerm)
+import Text.Pandoc.Class (PandocMonad, report, toLang, translateTerm,
+                           getMediaBag)
+import Text.Pandoc.MediaBag (lookupMedia, mediaItems, MediaItem(..))
 import qualified Text.Pandoc.Translations as Term
 import qualified Text.Pandoc.Class.PandocMonad as P
 import Data.Time
@@ -1233,9 +1235,42 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
   imgs <- gets stImages
   let
     stImage = M.lookup (T.unpack src) imgs
-    generateImgElt (ident, _, _, img) = do
+    generateImgElt (ident, _fp, mt, img) = do
       docprid <- getUniqueId
       nvpicprid <- getUniqueId
+      (blipAttrs, blipContents) <-
+        case T.takeWhile (/=';') <$> mt of
+          Just "image/svg+xml" -> do
+            -- get fallback png
+            mediabag <- getMediaBag
+            mbFallback <-
+              case lookupMedia (T.unpack (src <> ".png")) mediabag of
+                Just item -> do
+                  id' <- T.unpack . ("rId" <>) <$> getUniqueId
+                  let fp' = "media/" <> id' <> ".png"
+                  let imgdata = (id',
+                                 fp',
+                                 Just (mediaMimeType item),
+                                 BL.toStrict $ mediaContents item)
+                  modify $ \st -> st { stImages =
+                            M.insert fp' imgdata $ stImages st }
+                  return $ Just id'
+                Nothing -> return Nothing
+            let extLst = mknode "a:extLst" []
+                            [ mknode "a:ext"
+                              [("uri","{28A0092B-C50C-407E-A947-70E740481C1C}")]
+                              [ mknode "a14:useLocalDpi"
+                                [("xmlns:a14","http://schemas.microsoft.com/office/drawing/2010/main"),
+                                 ("val","0")] () ]
+                            , mknode "a:ext"
+                              [("uri","{96DAC541-7B7A-43D3-8B79-37D633B846F1}")]
+                              [ mknode "asvg:svgBlip"
+                                [("xmlns:asvg", "http://schemas.microsoft.com/office/drawing/2016/SVG/main"),
+                                 ("r:embed",T.pack ident)] () ]
+                            ]
+            return (maybe [] (\id'' -> [("r:embed", T.pack id'')]) mbFallback,
+                    [extLst])
+          _ -> return ([("r:embed", T.pack ident)], [])
       let
         (xpt,ypt) = desiredSizeInPoints opts attr
                (either (const def) id (imageSize opts img))
@@ -1252,7 +1287,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
                             ,("name","Picture")] ()
                         , cNvPicPr ]
         blipFill = mknode "pic:blipFill" []
-          [ mknode "a:blip" [("r:embed",T.pack ident)] ()
+          [ mknode "a:blip" blipAttrs blipContents
           , mknode "a:stretch" [] $
               mknode "a:fillRect" [] ()
           ]
-- 
cgit v1.2.3