bug#69992: Minor improvement to image map transformation logic

* lisp/image.el (image--compute-rotation): New function.
(image--compute-map, image--compute-original-map): Use it.
Ensure all transformations are applied or undone according to what
Emacs does internally.  Call a transformation function only when
needed.  Fix doc string.
(image--scale-map, image--rotate-map): Assume effective scale
argument.
(image--rotate-coord): Improve doc string.
(image--flip-map): Remove no more used argument FLIP.

* test/lisp/image-tests.el (image-create-image-with-map): Use a
valid SVG image otherwise `image-size' will not return a valid
value and calculation of scale could fail.
(image-transform-map): Update according to changed signature of
`image--flip-map'.

(cherry picked from commit cc212ea314d45c98761ae7f68600ad8bf799ea36)

diff --git a/lisp/image.el b/lisp/image.el
index d7496485acad0853b1cabf1154437c2cd7b22ad0..e973dff32c71507bc133acec0ea39b6723a930e1 100644 (file)
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1423,115 +1423,142 @@ is recomputed to fit the newly transformed image."
   :type 'boolean
   :version "30.1")
 
+(defsubst image--compute-rotation (image)
+  "Return the current rotation of IMAGE, or 0 if no rotation.
+Also return nil if rotation is not a multiples of 90 degrees (0, 90,
+180[-180] and 270[-90])."
+  (let ((degrees (or (image-property image :rotation) 0)))
+    (and (= 0 (mod degrees 1))
+         (car (memql (truncate (mod degrees 360)) '(0 90 180 270))))))
+
 (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,
+Return a copy of :original-map 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)
+  (when-let ((map (image-property image :original-map)))
+    (setq map (copy-tree map t))
+    (let* ((size (image-size image t))
+           ;; The image can be scaled for many reasons (:scale,
+           ;; :max-width, etc), so using `image--current-scaling' to
+           ;; calculate the current scaling is the correct method.  But,
+           ;; since each call to `image_size' is expensive, the code is
+           ;; duplicated here to save the a call to `image-size'.
+           (scale (/ (float (car size))
+                     (car (image-size
+                           (image--image-without-parameters image) t))))
+           (rotation (image--compute-rotation image))
+           ;; Image is flipped only if rotation is a multiple of 90,
+           ;; including 0.
+           (flip (and rotation (image-property image :flip))))
+      ;; SIZE fits MAP after transformations.  Scale MAP before flip and
+      ;; rotate operations, since both need MAP to fit SIZE.
+      (unless (= scale 1)
+        (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))
+      (when (memql rotation '(90 180 270))
+        (image--rotate-map
+         map rotation (if (= rotation 180)
+                          size
                         ;; If rotated ±90°, swap width and height.
-                        (cons height width)
-                      size))
+                        (cons (cdr size) (car size)))))
       ;; After rotation, there's no need to swap width and height.
-      (image--flip-map map flip size))
+      (when flip
+        (image--flip-map map 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* ((original-map (copy-tree (image-property image :map) t))
-           (scale (or (image-property image :scale) 1))
-           (rotation (or (image-property image :rotation) 0))
-           (flip (image-property image :flip))
-           (size (image-size image 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
-        ;; ORIGINAL-MAP before transformations are applied.  Therefore,
-        ;; scale ORIGINAL-MAP after flip and rotate operations, since
-        ;; both need ORIGINAL-MAP to fit SIZE.
-        (image--flip-map original-map flip size)
-        (image--rotate-map original-map (- rotation) size)
-        (image--scale-map original-map (/ 1.0 scale)))
-      original-map)))
+When there is no transformation, return copy of :map."
+  (when-let ((original-map (image-property image :map)))
+    (setq original-map (copy-tree original-map t))
+    (let* ((size (image-size image t))
+           ;; The image can be scaled for many reasons (:scale,
+           ;; :max-width, etc), so using `image--current-scaling' to
+           ;; calculate the current scaling is the correct method.  But,
+           ;; since each call to `image_size' is expensive, the code is
+           ;; duplicated here to save the a call to `image-size'.
+           (scale (/ (float (car size))
+                     (car (image-size
+                           (image--image-without-parameters image) t))))
+           (rotation (image--compute-rotation image))
+           ;; Image is flipped only if rotation is a multiple of 90
+           ;; including 0.
+           (flip (and rotation (image-property image :flip))))
+      ;; In rendered images, rotation is always applied before flip.
+      ;; To undo the transformation, flip before rotating.  SIZE fits
+      ;; ORIGINAL-MAP before transformations are applied.  Therefore,
+      ;; scale ORIGINAL-MAP after flip and rotate operations, since
+      ;; both need ORIGINAL-MAP to fit SIZE.
+      ;; In rendered images, rotation is always applied before flip.
+      (when flip
+        (image--flip-map original-map size))
+      (when (memql rotation '(90 180 270))
+        (image--rotate-map original-map (- rotation) size))
+      (unless (= scale 1)
+        (image--scale-map original-map (/ 1.0 scale))))
+    original-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))))))))
+  (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.
+ROTATION must be a non-zero multiple of 90.
 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))))))))
+  (setq rotation (mod rotation 360))
+  (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 rotation ; 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)."
+ANGLE must be a multiple of 90 in [90 180 270].  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
@@ -1552,25 +1579,24 @@ coordinates (X1 Y1)."
                (y1 (- y1)))
     (cons (round x1) (round y1))))
 
-(defun image--flip-map (map flip size)
-  "Horizontally flip MAP according to FLIP and SIZE.
+(defun image--flip-map (map size)
+  "Horizontally flip MAP according to 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)))))))))
+  (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)

diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 6a5f03e38a02a3e3e54e1899de0bb493805d4cd8..020781eff506fd9a30d79d647701f6c26ea5a1b1 100644 (file)
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -158,7 +158,7 @@
 (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")
+  (let ((data "<svg width=\"30\" height=\"30\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"></svg>")
         (map '(((circle (1 .  1) .  1) a)))
         (original-map '(((circle (2 .  2) .  2) a)))
         (original-map-other '(((circle (3 . 3) . 3) a))))
@@ -282,7 +282,7 @@ corresponding coordinate in B.  When nil, TOLERANCE defaults to 5."
                    '(((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))
+    (should (equal (image--flip-map (copy-tree map t) `(,width . ,height))
                    '(((circle (6 . 3) . 2) "circle")
                      ((rect (2 . 6) 7 . 8) "rect")
                      ((poly . [4 11 3 13 8 14]) "poly"))))
@@ -291,7 +291,7 @@ corresponding coordinate in B.  When nil, TOLERANCE defaults to 5."
       ;; 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)))
+      (image--flip-map copy `(,(* 2 height) . ,(* 2 width)))
       (should (equal copy
                      '(((circle (6 . 8) . 4) "circle")
                        ((rect (12 . 6) 16 . 16) "rect")