fix(docx): improve DPI on SVG fallback PNG

Pass --width and --height to `rsvg-convert` where available.

Signed-off-by: Edwin Török <[email protected]>

src/Text/Pandoc/App.hs

@@ -71,6 +71,7 @@ import Text.Pandoc.URI (isURI)
 import Text.Pandoc.Writers.Shared (lookupMetaString)
 import Text.Pandoc.Readers.Markdown (yamlToMeta)
 import qualified Text.Pandoc.UTF8 as UTF8
+import Text.Pandoc.ImageSize (desiredSizeInPoints, imageSize)
 #ifndef _WINDOWS
 import System.Posix.IO (stdOutput)
 import System.Posix.Terminal (queryTerminal)
@@ -382,7 +383,9 @@ createPngFallbacks opts = do
     case T.takeWhile (/=';') mt of
       "image/svg+xml" -> do
         let attr = Data.Map.findWithDefault nullAttr fp attributes
-        res <- svgToPng (writerDpi opts) bs
+        let imageSize' = imageSize opts (BL.toStrict bs)
+        let dims = either (const Nothing) (Just . desiredSizeInPoints opts attr) imageSize'
+        res <- svgToPng (writerDpi opts) dims bs
         case res of
           Right bs' -> do
             let fp' = fp <> ".png"

src/Text/Pandoc/Image.hs

@@ -20,16 +20,20 @@ import qualified Control.Exception as E
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Text.Pandoc.Class.PandocMonad
 import qualified Data.Text as T
+import Text.Printf (printf)
 
 -- | Convert svg image to png. rsvg-convert
 -- is used and must be available on the path.
 svgToPng :: (PandocMonad m, MonadIO m)
          => Int           -- ^ DPI
+         -> Maybe (Double, Double) -- desired size in points
          -> L.ByteString  -- ^ Input image as bytestring
          -> m (Either Text L.ByteString)
-svgToPng dpi bs = do
+svgToPng dpi dims bs = do
   let dpi' = show dpi
+  let whArg (w, h) = ["--width", printf "%.6fpt" w, "--height", printf "%.6fpt" h]
   let args = ["-f","png","-a","--dpi-x",dpi',"--dpi-y",dpi']
+       ++ maybe [] whArg dims
   trace (T.intercalate " " $ map T.pack $ "rsvg-convert" : args)
   liftIO $ E.catch
        (do (exit, out) <- pipeProcess Nothing "rsvg-convert"