bug#69992: Minor improvement to image map transformation logic

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

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

On 30/03/2024 09:55, David Ponce wrote:
> On 30/03/2024 09:10, Eli Zaretskii wrote:
>>> Date: Fri, 29 Mar 2024 11:19:11 +0100
>>> From: David Ponce <da_vid@orange.fr>
>>> Cc: Eli Zaretskii <eliz@gnu.org>, Joseph Turner <joseph@breatheoutbreathe.in>
>>>
>>>> The attached new patch fixes the logic to be consistent with Emacs
>>>> internal implementation, plus some other tweaks to check if a
>>>> transformation apply before to call the transformation function.
>>>> I also updated some tests according to functions changes.
>>>> Here is a possible change log:
>>>>
>>>> 2024-03-28  David Ponce  <da_vid@orange.fr>
>>>>
>>>>       * lisp/image.el (image--compute-scaling)
>>>>       (image--compute-rotation): New functions.
>>>>       (image--compute-map, image--compute-original-map): Use them.
>>>>       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): Assume effective scale argument.
>>>>       (image--rotate-map): Assume effective rotation argument.
>>>>       (image--rotate-coord): Improve doc string.
>>>>       (image--flip-map): Remove no more used flip argument.
>>>>
>>>>       * 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.
>>> [...]
>>>
>>> Hello,
>>>
>>> Please find attached a new patch with an additional small fix I forgot to
>>> include.  Sorry.
>>
>> Thanks.  Please resend with the updated commit log message, and I will
>> install it.
> 
> Hello Eli,
> 
> The change log is the same.  The last patch include a slightly modified
> version of the new function `image--compute-rotation' to return 0 by default
> when no rotation is specified, instead of nil.
> 
> Please let me know if you need anything else.
> Thanks!

Hello,

Here is my last patch. The only change compared to the previous patch is that
now the scale factor is correctly calculated based on the size of the image and
the displayed size. To minimize the performance impact, I saved a call to
`image-size' by doing the calculation directly in the `image--compute-map' and
`image--compute-original-map' functions. I did some benchmarks and the
difference is not significant. The tests still give the same results :-)

Here is the new change log:

2024-03-30  David Ponce  <da_vid@orange.fr>

	* 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): Assume effective scale argument.
	(image--rotate-map): Assume effective rotation argument.
	(image--rotate-coord): Improve doc string.
	(image--flip-map): Remove no more used flip argument.

	* 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.

Thanks!

[-- Attachment #2: image-compute-map-V2.patch --]
[-- Type: text/x-patch, Size: 14325 bytes --]

diff --git a/lisp/image.el b/lisp/image.el
index d7496485aca..e973dff32c7 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1423,115 +1423,142 @@ image-recompute-map-p
   :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 @@ image--rotate-coord
                (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 6a5f03e38a0..020781eff50 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -158,7 +158,7 @@ image-rotate
 (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 @@ image-transform-map
                    '(((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 @@ image-transform-map
       ;; 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")