fix(docx): honour percentage widths for SVG images

Signed-off-by: Edwin Török <[email protected]>
jgm · Dec 27, 2023 · 136bb84 · 136bb84
1 parent 779420b
commit 136bb84
Show file tree

Hide file tree

Showing 5 changed files with 11 additions and 7 deletions.
diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs
@@ -166,8 +166,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 pageWidth' s =
  case (getDim Width, getDim Height) of
  (Just w, Just h) -> (w, h)
  (Just w, Nothing) -> (w, w / ratio)
@@ -176,7 +176,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, pageWidth') of
+ (Width, Just pageWidth) ->
+ Just $ fromIntegral pageWidth * a
+ _ -> Nothing
  Just dim -> Just $ inPoints opts dim
  Nothing -> Nothing
 

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
@@ -1538,7 +1538,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
@@ -613,7 +613,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
@@ -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
@@ -44,6 +44,6 @@
 ^D
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
-2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 336.000000pt --height 336.000000pt
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
 ```