Subject: Re: Minor improvement to image map transformation logic

From: David Ponce <[email-masked]>
Date: Wed, 27 Mar 2024 12:16:11 +0100

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 again for this valuable feature!

diff --git a/lisp/image.el b/lisp/image.el
index 55340ea03dc..2e3928478ca 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 (1- (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 (1- (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