bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1967 bytes --]

Joseph Turner <joseph@breatheoutbreathe.in> writes:

> The attached patch adds two hooks in `image.el' which allow packages to
> recompute an image's map after it's rescaled or rotated.

In this new attached patch, rescaling image maps is handled within
image.el.  No new hooks are added.  This change should be backwards
compatible, except that :unscaled-map is now a reserved image property.

If we decide to install this patch, I'll work on modifying image maps
inside of `image-rotate', as well as update the manual and NEWS.

Test it out!

(with-current-buffer (get-buffer-create "*image-properties-test*")
  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n<!-- Generated by graphviz version 2.43.0 (0)\n -->\n<!-- Title: orggraphview Pages: 1 -->\n<svg width=\"128pt\" height=\"128pt\"\n viewBox=\"0.00 0.00 127.59 127.59\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n<g id=\"graph0\" class=\"graph\" transform=\"scale(1 1) rotate(0) translate(4 123.59)\">\n<title>orggraphview</title>\n<polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-123.59 123.59,-123.59 123.59,4 -4,4\"/>\n<!-- a -->\n<g id=\"node1\" class=\"node\">\n<title>a</title>\n<g id=\"a_node1\"><a xlink:href=\"1\" xlink:title=\"Hover me!\">\n<ellipse fill=\"none\" stroke=\"black\" cx=\"59.79\" cy=\"-59.79\" rx=\"59.59\" ry=\"59.59\"/>\n<text text-anchor=\"middle\" x=\"59.79\" y=\"-56.09\" font-family=\"Times,serif\" font-size=\"14.00\" fill=\"#000000\">Hover me!</text>\n</a>\n</g>\n</g>\n</g>\n</svg>\n")
         (map '(((circle (85 . 85) . 80) "1" (help-echo "Surprise!"))))
         (image (create-image svg-string 'svg t :map map)))
    (erase-buffer)
    (insert-image image)
    (goto-char (point-min))
    (pop-to-buffer (current-buffer))))

Thank you!

Joseph


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Recalculate-map-when-image-scale-changes.patch --]
[-- Type: text/x-diff, Size: 3937 bytes --]

From 7a3d9fa5cc08c40696ad65101d62cb4babb4dc76 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recalculate :map when image :scale changes

Now, when rescaling an image with a :map using `image-increase-size' or
`image-decrease-size', the image map scales along with the image.

Image map coordinates are integers, so when scaling :map, coordinates
must be rounded.  To prevent an image from drifting from its map after
repeatedly scaling up and down, `create-image' now stores the original
:unscaled-map, which is combined with the image's scale after resizing
to recalculate :map.

* lisp/image.el (create-image): Add :unscaled-map image property
(image--delayed-change-size): Fix comment
(image--change-size): Also scale image map
(image--scale-map): Add function to scale an image map
---
 lisp/image.el | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c72332172f0 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,13 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add unscaled map.
+      (when-let ((map (plist-get props :map)))
+        (setq image (nconc image
+                           (list :unscaled-map
+                                 (image--scale-map
+                                  (copy-tree map t)
+                                  (/ 1.0 (image-property image :scale)))))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1185,7 +1192,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes :scale and :map.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1267,9 +1274,34 @@ image--get-imagemagick-and-warn
 (defun image--change-size (factor &optional position)
   (let* ((image (image--get-imagemagick-and-warn position))
          (new-image (image--image-without-parameters image))
-         (scale (image--current-scaling image new-image)))
+         (unscaled-map (image-property image :unscaled-map))
+         (scale (image--current-scaling image new-image))
+         (new-scale (* scale factor)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale new-scale)
+    (when unscaled-map
+      (setf (image-property image :map)
+            (image--scale-map (copy-tree unscaled-map t) new-scale)))))
+
+(defun image--scale-map (map factor)
+  "Scale MAP by FACTOR, destructively modifying it."
+  (unless (= 1 factor)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cadr coords) (round (* (cadr coords) factor)))
+         (setf (cddr coords) (round (* (cddr coords) factor))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cdr coords) (round (* (cdr coords) factor))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) factor))))))))
+  map)
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
-- 
2.41.0