From a80fa1cee0397f44266a1f517f3a54a6ebe9b636 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 12:39:24 +0000
Subject: [PATCH] fix(docx): honour percentage widths for SVG images
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 src/Text/Pandoc/ImageSize.hs            | 10 +++++++---
 src/Text/Pandoc/Writers/Docx/OpenXML.hs |  4 ++--
 src/Text/Pandoc/Writers/ICML.hs         |  2 +-
 src/Text/Pandoc/Writers/RTF.hs          |  2 +-
 test/command/9288.md                    |  3 ++-
 5 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs
index 6e0558f8fbc4..5ccdbe3d3e8e 100644
--- a/src/Text/Pandoc/ImageSize.hs
+++ b/src/Text/Pandoc/ImageSize.hs
@@ -174,8 +174,8 @@ sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf)
 -- | Calculate (height, width) in points, considering the desired dimensions in the
 -- attribute, while falling back on the image file's dpi metadata if no dimensions
 -- are specified in the attribute (or only dimensions in percentages).
-desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
-desiredSizeInPoints opts attr s =
+desiredSizeInPoints :: WriterOptions -> Attr -> Maybe Integer -> ImageSize -> (Double, Double)
+desiredSizeInPoints opts attr pageWidthPoints' s =
   case (getDim Width, getDim Height) of
     (Just w, Just h)   -> (w, h)
     (Just w, Nothing)  -> (w, w / ratio)
@@ -184,7 +184,11 @@ desiredSizeInPoints opts attr s =
   where
     ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
     getDim dir = case dimension dir attr of
-                   Just (Percent _) -> Nothing
+                   Just (Percent a) ->
+                     case (dir, pageWidthPoints') of
+                     (Width, Just pageWidthPoints) ->
+                       Just $ fromIntegral pageWidthPoints * a
+                     _ -> Nothing
                    Just dim         -> Just $ inPoints opts dim
                    Nothing          -> Nothing
 
diff --git a/src/Text/Pandoc/Writers/Docx/OpenXML.hs b/src/Text/Pandoc/Writers/Docx/OpenXML.hs
index c6c75fabb21f..d0ded5b348dd 100644
--- a/src/Text/Pandoc/Writers/Docx/OpenXML.hs
+++ b/src/Text/Pandoc/Writers/Docx/OpenXML.hs
@@ -928,7 +928,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do
               return i
   return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ]
 inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
-  pageWidth <- asks envPrintWidth
+  pageWidth <- asks envPrintWidth -- in Points
   imgs <- gets stImages
   let
     stImage = M.lookup (T.unpack src) imgs
@@ -936,7 +936,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
       docprid <- getUniqueId
       nvpicprid <- getUniqueId
       let
-        (xpt,ypt) = desiredSizeInPoints opts attr
+        (xpt,ypt) = desiredSizeInPoints opts attr (Just pageWidth)
                (either (const def) id (imageSize opts img))
         -- 12700 emu = 1 pt
         pageWidthPt = case dimension Width attr of
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 1d766ab13072..7bb649a60a30 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -615,7 +615,7 @@ imageICML opts style attr (src, _) = do
                report $ CouldNotFetchResource src $ tshow e
                return def)
   let (ow, oh) = sizeInPoints imgS
-      (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS
+      (imgWidth, imgHeight) = desiredSizeInPoints opts attr Nothing imgS
       hw = showFl $ ow / 2
       hh = showFl $ oh / 2
       scale = showFl (imgWidth / ow) <> " 0 0 " <> showFl (imgHeight / oh)
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 4a8f1d577f9e..c95a524ca06c 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -64,7 +64,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = catchError
                                 <> "\\pichgoal" <> tshow (floor (ypt * 20) :: Integer)
                         -- twip = 1/1440in = 1/20pt
                         where (xpx, ypx) = sizeInPixels sz
-                              (xpt, ypt) = desiredSizeInPoints opts attr sz
+                              (xpt, ypt) = desiredSizeInPoints opts attr Nothing sz
              let raw = "{\\pict" <> filetype <> sizeSpec <> " " <>
                         T.concat bytes <> "}"
              if B.null imgdata
diff --git a/test/command/9288.md b/test/command/9288.md
index 6205c6f3e2db..1dc70481d0ed 100644
--- a/test/command/9288.md
+++ b/test/command/9288.md
@@ -45,8 +45,9 @@
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
 2> [trace] Found fallback "media/rId20.svg_4572000_4572000.png"
 2> [trace] Found fallback "media/rId20.svg_4572000_4572000.png"
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 336.000000pt --height 336.000000pt
+2> [trace] Found fallback "media/rId20.svg_4267200_4267200.png"
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
 2> [trace] Found fallback "media/rId20.svg_952500_952500.png"
-2> [trace] Found fallback "media/rId20.svg_952500_952500.png"
 
 ```