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: 2138 bytes --]


Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Fri, 22 Mar 2024 17:11:17 -0700
>>
>> > Thanks.  The tests you added have some problems:
>> >
>> >  . you use thread-first, but don't require subr-x when compiling
>>
>> I removed thread-first.
>>
>> >  . the tests fail when run in batch mode
>>
>> I added (skip-unless (display-images-p)) to the two problematic tests,
>> and it solved the issue on my machine.
>
> Solves it here as well.
>
>> >  . when invoked interactively in a GUI session, one test fails:
>> >
>> >     F image--compute-map-and-original-map
>> > 	Test ‘image--compute-map’ and ‘image--compute-original-map’.
>> > 	(ert-test-failed
>> > 	 ((should (equal (image--compute-map image) flipped-map)) :form
>> > 	  (equal
>> > 	   (((circle ... . 24) "a" (help-echo "A"))
>> > 	    ((rect ... 162 . 149) "b" (help-echo "B"))
>> > 	    ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C")))
>> > 	   (((circle ... . 24) "a" (help-echo "A"))
>> > 	    ((rect ... 161 . 149) "b" (help-echo "B"))
>> > 	    ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C"))))
>> > 	  :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...))))))
>> >
>> > It looks like some pixels do not match exactly?  Perhaps some
>> > tolerances need to be allowed?
>>
>> Interesting - does the result of `image-size` vary per machine?
>
> I guess so.  The transformations are AFAIK done in floating-point
> arithmetics, so some minor inaccuracies are possible.
>
>> In any case, I added `image-tests--map-equal' to compare image maps with
>> some tolerance. Do the tests pass on your machine now?
>
> Yes, they do now, thanks.  However, there's a warning when compiling
> the tests:
>
>   In image-tests--map-equal:
>   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
>
> Can you fix this, please?

Oops!  I just re-read the dotimes docstring to discover that the RESULT
arg is deprecated.  Fixed.  Thank you!

Joseph


[-- Attachment #2: 0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch --]
[-- Type: text/x-diff, Size: 28045 bytes --]

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

Now, when transforming an image, its :map is recomputed to fit.

Image map coordinates are integers, so when computing :map, coordinates
are rounded.  To prevent an image from drifting from its map after
repeated transformations, `create-image' now adds a new image property
:original-map, which is combined with the image's transformation
parameters to recompute :map.

* lisp/image.el (image-recompute-map-p): Add user option to control
whether :map is recomputed when an image is transformed.
(create-image): Create :map from :original-map and vice versa.
(image--delayed-change-size): Fix comment.
(image--change-size, image-rotate, image-flip-horizontally,
image-flip-vertically): Recompute image map after transformation and
mention image-recompute-map-p in docstring.
(image--compute-map): Add function to compute a map from original map.
(image--compute-map): Add function to compute an original map from map.
(image--scale-map): Add function to scale a map based on :scale.
(image--rotate-map): Add function to rotate a map based on :rotation.
(image--rotate-coord): Add function to rotate a map coordinate pair.
(image--flip-map): Add function to flip a map based on :flip.
(image-increase-size, image-decrease-size, image-mouse-increase-size,
image-mouse-decrease-size): Mention image-recompute-map-p in docstring.
* etc/NEWS: Add NEWS entry.
* doc/lispref/display.texi (Image Descriptors): Document :original-map
and new user option image-recompute-map-p.
* test/lisp/image-tests.el (image--compute-map-and-original-map): Test
`image--compute-map' and `image--compute-original-map'.
(image-tests--map-equal): Add equality predicate to compare image maps.
(image-create-image-with-map): Test that `create-image' adds :map and/or
:original-map as appropriate.
(image-transform-map): Test functions related to transforming maps.
---
 doc/lispref/display.texi |  24 +++++
 etc/NEWS                 |  12 +++
 lisp/image.el            | 221 ++++++++++++++++++++++++++++++++++++---
 test/lisp/image-tests.el | 144 +++++++++++++++++++++++++
 4 files changed, 389 insertions(+), 12 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..8335a02b5c5 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6055,6 +6055,30 @@ Image Descriptors
 when creating the image, or use the result of
 @code{image-compute-scaling-factor} to compute the elements of the
 map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
 @end table
 
 @defun image-mask-p spec &optional frame
diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..cbd97b495b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,18 @@ without specifying a file, like this:
     (notifications-notify
       :title "I am playing music" :app-icon 'multimedia-player)
 
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
 ** Image Dired
 
 *** New user option 'image-dired-thumb-naming'.
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c5082c78b75 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,16 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add original map from map.
+      (when (and (plist-get props :map)
+                 (not (plist-get props :original-map)))
+        (setq image (nconc image (list :original-map
+                                       (image--compute-original-map image)))))
+      ;; Add map from original map.
+      (when (and (plist-get props :original-map)
+                 (not (plist-get props :map)))
+        (setq image (nconc image (list :map
+                                       (image--compute-map image)))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1173,7 +1183,10 @@ image-increase-size
 If N is 3, then the image size will be increased by 30%.  More
 generally, the image size is multiplied by 1 plus N divided by 10.
 N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (1+ (/ (prefix-numeric-value n) 10.0))
@@ -1185,7 +1198,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 two values in a plist.  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.
@@ -1196,7 +1209,10 @@ image-decrease-size
 If N is 3, then the image size will be decreased by 30%.  More
 generally, the image size is multiplied by 1 minus N divided by 10.
 N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1208,7 +1224,10 @@ image-decrease-size
 (defun image-mouse-increase-size (&optional event)
   "Increase the image size using the mouse-gesture EVENT.
 This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1218,7 +1237,10 @@ image-mouse-increase-size
 (defun image-mouse-decrease-size (&optional event)
   "Decrease the image size using the mouse-gesture EVENT.
 This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1269,7 +1291,9 @@ image--change-size
          (new-image (image--image-without-parameters image))
          (scale (image--current-scaling image new-image)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale (* scale factor))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
@@ -1296,7 +1320,10 @@ image-rotate
 If nil, ANGLE defaults to 90.  Interactively, rotate the image 90
 degrees clockwise with no prefix argument, and counter-clockwise
 with a prefix argument.  Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive (and current-prefix-arg '(-90)))
   (let ((image (image--get-imagemagick-and-warn)))
     (setf (image-property image :rotation)
@@ -1304,7 +1331,9 @@ image-rotate
                          (or angle 90))
                       ;; We don't want to exceed 360 degrees rotation,
                       ;; because it's not seen as valid in Exif data.
-                      360))))
+                      360)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image))))
   (set-transient-map image--repeat-map nil nil
                      "Use %k for further adjustments"))
 
@@ -1325,23 +1354,191 @@ image-save
                     (read-file-name "Write image to file: ")))))
 
 (defun image-flip-horizontally ()
-  "Horizontally flip the image under point."
+  "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-flush image)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image-flip-vertically ()
-  "Vertically flip the image under point."
+  "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-rotate 180)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
 
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+  "Recompute image map when scaling, rotating, or flipping an image."
+  :type 'boolean
+  :version "30.1")
+
+(defun image--compute-map (image)
+  "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip.  When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+  (pcase-let* ((original-map (image-property image :original-map))
+               (map (copy-tree original-map t))
+               (scale (or (image-property image :scale) 1))
+               (rotation (or (image-property image :rotation) 0))
+               (flip (image-property image :flip))
+               ((and size `(,width . ,height)) (image-size image t)))
+    (when (and ; Handle only 90-degree rotations
+           (zerop (mod rotation 1))
+           (zerop (% (truncate rotation) 90)))
+      ;; SIZE fits MAP after transformations.  Scale MAP before
+      ;; flip and rotate operations, since both need MAP to fit SIZE.
+      (image--scale-map map scale)
+      ;; In rendered images, rotation is always applied before flip.
+      (image--rotate-map
+       map rotation (if (or (= 90 rotation) (= 270 rotation))
+                        ;; If rotated ±90°, swap width and height.
+                        (cons height width)
+                      size))
+      ;; After rotation, there's no need to swap width and height.
+      (image--flip-map map flip size))
+    map))
+
+(defun image--compute-original-map (image)
+  "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+  (when (image-property image :map)
+    (let* ((image-copy (copy-tree image t))
+           (map (image-property image-copy :map))
+           (scale (or (image-property image-copy :scale) 1))
+           (rotation (or (image-property image-copy :rotation) 0))
+           (flip (image-property image-copy :flip))
+           (size (image-size image-copy t)))
+      (when (and ; Handle only 90-degree rotations
+             (zerop (mod rotation 1))
+             (zerop (% (truncate rotation) 90)))
+        ;; In rendered images, rotation is always applied before flip.
+        ;; To undo the transformation, flip before rotating.
+        ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
+        ;; Therefore, scale MAP after flip and rotate operations, since
+        ;; both need MAP to fit SIZE.
+        (image--flip-map map flip size)
+        (image--rotate-map map (- rotation) size)
+        (image--scale-map map (/ 1.0 scale)))
+      map)))
+
+(defun image--scale-map (map scale)
+  "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+  (unless (= 1 scale)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setf (cadr coords) (round (* (cadr coords) scale)))
+         (setf (cddr coords) (round (* (cddr coords) scale))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setcdr coords (round (* (cdr coords) scale))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) scale))))))))
+  map)
+
+(defun image--rotate-map (map rotation size)
+  "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+  (unless (zerop rotation)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ( x0 y0  ; New upper left corner
+                x1 y1) ; New bottom right corner
+           (pcase (truncate (mod rotation 360)) ; Set new corners to...
+             (90 ; ...old bottom left and upper right
+              (setq x0 (caar coords) y0 (cddr coords)
+                    x1 (cadr coords) y1 (cdar coords)))
+             (180 ; ...old bottom right and upper left
+              (setq x0 (cadr coords) y0 (cddr coords)
+                    x1 (caar coords) y1 (cdar coords)))
+             (270 ; ...old upper right and bottom left
+              (setq x0 (cadr coords) y0 (cdar coords)
+                    x1 (caar coords) y1 (cddr coords))))
+           (setcar coords (image--rotate-coord x0 y0 rotation size))
+           (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+        ('circle
+         (setcar coords (image--rotate-coord
+                         (caar coords) (cdar coords) rotation size)))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (pcase-let ((`(,x . ,y)
+                          (image--rotate-coord
+                           (aref coords i) (aref coords (1+ i)) rotation size)))
+               (aset coords i x)
+               (aset coords (1+ i) y))))))))
+  map)
+
+(defun image--rotate-coord (x y angle size)
+  "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90.  Returns a cons cell of rounded
+coordinates (X1 Y1)."
+  (pcase-let* ((radian (* (/ angle 180.0) float-pi))
+               (`(,width . ,height) size)
+               ;; y is positive, but we are in the bottom-right quadrant
+               (y (- y))
+               ;; Rotate clockwise
+               (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+               (y1 (- (* (cos radian) y) (* (sin radian) x)))
+               ;; Translate image back into bottom-right quadrant
+               (`(,x1 . ,y1)
+                (pcase (truncate (mod angle 360))
+                  (90 ; Translate right by height
+                   (cons (+ x1 height) y1))
+                  (180 ; Translate right by width and down by height
+                   (cons (+ x1 width) (- y1 height)))
+                  (270 ; Translate down by width
+                   (cons x1 (- y1 width)))))
+               ;; Invert y1 to make both x1 and y1 positive
+               (y1 (- y1)))
+    (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+  "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+  (when flip
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ((x0 (- (car size) (cadr coords)))
+               (y0 (cdar coords))
+               (x1 (- (car size) (caar coords)))
+               (y1 (cddr coords)))
+           (setcar coords (cons x0 y0))
+           (setcdr coords (cons x1 y1))))
+        ('circle
+         (setf (caar coords) (- (car size) (caar coords))))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (aset coords i (- (car size) (aref coords i)))))))))
+  map)
+
 (provide 'image)
 
 ;;; image.el ends here
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..6a5f03e38a0 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,148 @@ image-rotate
     (image-rotate -154.5)
     (should (equal image '(image :rotation 91.0)))))
 
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+  "Test that `create-image' correctly adds :map and/or :original-map."
+  (skip-unless (display-images-p))
+  (let ((data "foo")
+        (map '(((circle (1 .  1) .  1) a)))
+        (original-map '(((circle (2 .  2) .  2) a)))
+        (original-map-other '(((circle (3 . 3) . 3) a))))
+    ;; Generate :original-map from :map.
+    (let* ((image (create-image data 'svg t :map map :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map)))
+    ;; Generate :map from :original-map.
+    (let* ((image (create-image
+                   data 'svg t :original-map original-map :scale 0.5))
+           (got-map (image-property image :map)))
+      (should (equal got-map map)))
+    ;; Use :original-map if both it and :map are specified.
+    (let* ((image (create-image
+                   data 'svg t :map map
+                   :original-map original-map-other :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map-other)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+  "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B.  When nil, TOLERANCE defaults to 5."
+  (unless tolerance (setq tolerance 5))
+  (catch 'different
+    (cl-labels ((check-tolerance
+                  (coord-a coord-b)
+                  (unless (>= tolerance (abs (- coord-a coord-b)))
+                    (throw 'different nil))))
+      (dotimes (i (length a))
+        (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+                    (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+          (unless (eq type-a type-b)
+            (throw 'different nil))
+          (pcase-exhaustive type-a
+            ('rect
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cadr coords-a) (cadr coords-b))
+             (check-tolerance (cddr coords-a) (cddr coords-b)))
+            ('circle
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b)))
+            ('poly
+             (dotimes (i (length coords-a))
+               (check-tolerance (aref coords-a i) (aref coords-b i))))))))
+    t))
+
+(ert-deftest image--compute-map-and-original-map ()
+  "Test `image--compute-map' and `image--compute-original-map'."
+  (skip-unless (display-images-p))
+  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+         (original-map
+          '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+            ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+            ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+         (scaled-map
+          '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+            ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+            ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+         (flipped-map
+          '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+            ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+            ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+         (rotated-map
+          '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+            ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+            ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+         (scaled-rotated-flipped-map
+          '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+            ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+            ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+         (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+                              :scale 2 :rotation 90 :flip t)))
+    ;; Test that `image--compute-original-map' correctly generates
+    ;; original-map when creating an already transformed image.
+    (should (image-tests--map-equal (image-property image :original-map)
+                                    original-map))
+    (setf (image-property image :flip) nil)
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :scale) 2)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-map))
+    (setf (image-property image :scale) 1)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    rotated-map))
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :flip) t)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    flipped-map))
+    (setf (image-property image :scale) 2)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-rotated-flipped-map))
+
+    ;; Uncomment to test manually by interactively transforming the
+    ;; image and checking the map boundaries by hovering them.
+
+    ;; (with-current-buffer (get-buffer-create "*test image map*")
+    ;;   (erase-buffer)
+    ;;   (insert-image image)
+    ;;   (goto-char (point-min))
+    ;;   (pop-to-buffer (current-buffer)))
+    ))
+
+(ert-deftest image-transform-map ()
+  "Test functions related to transforming image maps."
+  (let ((map '(((circle (4 . 3) . 2) "circle")
+               ((rect (3 . 6) 8 . 8) "rect")
+               ((poly . [6 11 7 13 2 14]) "poly")))
+        (width 10)
+        (height 15))
+    (should (equal (image--scale-map (copy-tree map t) 2)
+                   '(((circle (8 . 6) . 4) "circle")
+                     ((rect (6 . 12) 16 . 16) "rect")
+                     ((poly . [12 22 14 26 4 28]) "poly"))))
+    (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+                   '(((circle (12 . 4) . 2) "circle")
+                     ((rect (7 . 3) 9 . 8) "rect")
+                     ((poly . [4 6 2 7 1 2]) "poly"))))
+    (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+                   '(((circle (6 . 3) . 2) "circle")
+                     ((rect (2 . 6) 7 . 8) "rect")
+                     ((poly . [4 11 3 13 8 14]) "poly"))))
+    (let ((copy (copy-tree map t)))
+      (image--scale-map copy 2)
+      ;; Scale size because the map has been scaled.
+      (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+      ;; Swap width and height because the map has been flipped.
+      (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+      (should (equal copy
+                     '(((circle (6 . 8) . 4) "circle")
+                       ((rect (12 . 6) 16 . 16) "rect")
+                       ((poly . [22 12 26 14 28 4]) "poly")))))))
+
 ;;; image-tests.el ends here
-- 
2.41.0