From 6da581d6f08a462fc2eb033096288a932643e39e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Tue, 26 Dec 2023 23:32:05 +0000
Subject: [PATCH] fix(docx): improve DPI on SVG fallback PNG
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 src/Text/Pandoc/App.hs   | 5 ++++-
 src/Text/Pandoc/Image.hs | 6 +++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 40105902fb4c..ede0d20b7be7 100644
--- a/src/Text/Pandoc/App.hs
+++ b/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"
diff --git a/src/Text/Pandoc/Image.hs b/src/Text/Pandoc/Image.hs
index 5f95b19d970f..2d4169db35b5 100644
--- a/src/Text/Pandoc/Image.hs
+++ b/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"