Subject: bug#69992: Minor improvement to image map transformation logic

From: David Ponce <[email-masked]>
Date: Wed, 27 Mar 2024 15:21:18 +0100

On 27/03/2024 13:50, Eli Zaretskii wrote:
>> Date: Wed, 27 Mar 2024 12:16:11 +0100
>> From:  David Ponce via "Bug reports for GNU Emacs,
>>   the Swiss army knife of text editors" <[email-masked]>
>>
>> Many thanks for this feature, which is particularly useful to
>> automatically recalculate the map of computed images like SVG.
>>
>> To make the code faster, by avoiding multiple scans of the map for
>> copy and parsing, I propose the following patch which factors most of
>> the code into the functions `image--compute-map' and `image--compute
>> -original-map'. I have done some tests on my side which are
>> conclusive.
>>
>> Furthermore, I wonder if the term :base-map would not be more
>> descriptive than :original-map?
> 
> Thanks.
> 
> Joseph, any comments or suggestions?

Attached the same patch slightly cleaned up.

diff --git a/lisp/image.el b/lisp/image.el
index 55340ea03dc..92b9dff01e1 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1427,107 +1427,170 @@ image--compute-map
   "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))
+When there is no transformation, return :original-map."
+  (when-let ((omap (image-property image :original-map)))
+    (let* ((scale (let ((s (image--current-scaling
+                            image
+                            (image--image-without-parameters image))))
+                    (unless (= s 1) s)))
+           (rotate (let ((d (image-property image :rotation)))
+                     ;; Handle only 90-degree rotations
+                     (and d (= 0 (mod d 1)) (= 0 (% d 90))
+                          (truncate (mod d 360)))))
+           (flip (image-property image :flip))
+           (map omap)
+           size flip-w)
+      (when (or scale rotate flip)
+        (setq map nil
+              size (image-size image t)
+              flip-w (car size))
+        (if (memql rotate '(90 270))
+            ;; If rotated ±90°, swap width and height.
+            (setq size (cons (cdr size) (car size))))
+        ;; SIZE fits MAP after transformations.  Scale MAP before flip
+        ;; and rotate operations, since both need MAP to fit SIZE.
+        (pcase-dolist (`(,area ,id ,plist) omap)
+          (pcase-exhaustive area
+            ;; Rectangle hot spot.
+            (`(rect . ((,x0 . ,y0) . (,x1 . ,y1)))
+             (if scale
+                 (setq x0 (round (* x0 scale)) y0 (round (* y0 scale))
+                       x1 (round (* x1 scale)) y1 (round (* y1 scale))))
+             (if rotate
+                 (let ((p0 (image--rotate-coord x0 y0 rotate size))
+                       (p1 (image--rotate-coord x1 y1 rotate size)))
+                   (setq x0 (car p0) y0 (cdr p0)
+                         x1 (car p1) y1 (cdr p1))))
+             (if flip
+                 (let ((xa x0) (xb x1))
+                   (setq x0 (- flip-w xb)
+                         x1 (- flip-w xa))))
+             ;; Normalize rect coords to be top/left bottom/right.
+             (if (> x0 x1)
+                 (let ((rw (abs (- x0 x1))))
+                   (setq x0 (- x0 rw) x1 (+ x1 rw))))
+             (if (> y0 y1)
+                 (let ((rh (abs (- y0 y1))))
+                   (setq y0 (- y0 rh) y1 (+ y1 rh))))
+             (push `((rect . ((,x0 . ,y0) . (,x1 . ,y1))) ,id ,plist)
+                   map))
+            ;; Circle hot spot.
+            (`(circle . ((,x0 . ,y0) . ,r))
+             (if scale
+                 (setq x0 (round (* x0 scale)) y0 (round (* y0 scale))
+                       r  (round (* r scale))))
+             (if rotate
+                 (let ((p0 (image--rotate-coord x0 y0 rotate size)))
+                   (setq x0 (car p0) y0 (cdr p0))))
+             (if flip
+                 (setq x0 (- flip-w x0)))
+             (push `((circle . ((,x0 . ,y0) . ,r)) ,id ,plist) map))
+            ;; Poly hot spot.
+            (`(poly . ,coords)
+             (setq coords (copy-sequence coords))
+             (let ((i 0) (n (length coords)))
+               (while (< i n)
+                 (let* ((j (1+ i))
+                        (x (aref coords i))
+                        (y (aref coords j)))
+                   (if scale
+                       (setq x (round (* x scale))
+                             y (round (* y scale))))
+                   (if rotate
+                       (let ((p (image--rotate-coord x y rotate size)))
+                         (setq x (car p) y (cdr p))))
+                   (if flip
+                       (setq x (- flip-w x)))
+                   (aset coords i x)
+                   (aset coords j y))
+                 (setq i (+ i 2))))
+             (push `((poly . ,coords) ,id ,plist) map))
+            )))
+      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)))
+When there is no transformation, return :map."
+  (when-let ((map (image-property image :map)))
+    (let* ((scale (let ((s (image--current-scaling
+                            image
+                            (image--image-without-parameters image))))
+                    (unless (= s 1) s)))
+           (rotate (let ((d (image-property image :rotation)))
+                     ;; Handle only 90-degree rotations
+                     (and d (= 0 (mod d 1)) (= 0 (% d 90))
+                          (truncate (mod (- d) 360)))))
+           (flip (image-property image :flip))
+           (omap map)
+           size flip-w)
+      (when (or scale rotate flip)
+        (setq omap nil
+              size (image-size image t)
+              flip-w (car size))
         ;; 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)
+        ;; 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.
+        (pcase-dolist (`(,area ,id ,plist) map)
+          (pcase-exhaustive area
+            ;; Rectangle hot spot.
+            (`(rect . ((,x0 . ,y0) . (,x1 . ,y1)))
+             (if flip
+                 (let ((xa x0) (xb x1))
+                   (setq x0 (- flip-w xb)
+                         x1 (- flip-w xa))))
+             (if rotate
+                 (let ((p0 (image--rotate-coord x0 y0 rotate size))
+                       (p1 (image--rotate-coord x1 y1 rotate size)))
+                   (setq x0 (car p0) y0 (cdr p0)
+                         x1 (car p1) y1 (cdr p1))))
+             (if scale
+                 (setq x0 (round (/ x0 scale)) y0 (round (/ y0 scale))
+                       x1 (round (/ x1 scale)) y1 (round (/ y1 scale))))
+             ;; Normalize rect coords to be top/left bottom/right.
+             (if (> x0 x1)
+                 (let ((rw (abs (- x0 x1))))
+                   (setq x0 (- x0 rw) x1 (+ x1 rw))))
+             (if (> y0 y1)
+                 (let ((rh (abs (- y0 y1))))
+                   (setq y0 (- y0 rh) y1 (+ y1 rh))))
+             (push `((rect . ((,x0 . ,y0) . (,x1 . ,y1))) ,id ,plist)
+                   omap))
+            ;; Circle hot spot.
+            (`(circle . ((,x0 . ,y0) . ,r))
+             (if flip
+                 (setq x0 (- flip-w x0)))
+             (if rotate
+                 (let ((p0 (image--rotate-coord x0 y0 rotate size)))
+                   (setq x0 (car p0) y0 (cdr p0))))
+             (if scale
+                 (setq x0 (round (/ x0 scale)) y0 (round (/ y0 scale))
+                       r  (round (/ r scale))))
+             (push `((circle . ((,x0 . ,y0) . ,r)) ,id ,plist) omap))
+            ;; Poly hot spot.
+            (`(poly . ,coords)
+             (setq coords (copy-sequence coords))
+             (let ((i 0) (n (length coords)))
+               (while (< i n)
+                 (let* ((j (1+ i))
+                        (x (aref coords i))
+                        (y (aref coords j)))
+                   (if flip
+                       (setq x (- flip-w x)))
+                   (if rotate
+                       (let ((p (image--rotate-coord x y rotate size)))
+                         (setq x (car p) y (cdr p))))
+                   (if scale
+                       (setq x (round (/ x scale))
+                             y (round (/ y scale))))
+                   (aset coords i x)
+                   (aset coords j y))
+                 (setq i (+ i 2))))
+             (push `((poly . ,coords) ,id ,plist) omap))
+            )))
+      omap)))
 
 (defun image--rotate-coord (x y angle size)
   "Rotate coordinates X and Y by ANGLE in image of SIZE.
@@ -1553,27 +1616,6 @@ 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.
-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