* bug#69992: Minor improvement to image map transformation logic @ 2024-03-25 1:00 Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 11:16 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 13+ messages in thread From: Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-25 1:00 UTC (permalink / raw) To: 69992 [-- Attachment #1: Type: text/plain, Size: 67 bytes --] Hello, This patch is slight simplification/optimization. Joseph [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-copy-tree-just-image-map-not-entire-image.patch --] [-- Type: text/x-diff, Size: 2443 bytes --] From 96a30a0450384eaeda21f234911f947952c4dcde Mon Sep 17 00:00:00 2001 From: Joseph Turner <joseph@breatheoutbreathe.in> Date: Sat, 23 Mar 2024 13:29:17 -0700 Subject: [PATCH] copy-tree just image map, not entire image. * lisp/image.el (image--compute-original-map): --- lisp/image.el | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/lisp/image.el b/lisp/image.el index 55340ea03dc..d7496485aca 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1455,24 +1455,23 @@ image--compute-original-map 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))) + (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 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))) + ;; 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))) (defun image--scale-map (map scale) "Scale MAP according to SCALE. -- 2.41.0 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-25 1:00 bug#69992: Minor improvement to image map transformation logic Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 11:16 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 12:50 ` Eli Zaretskii 0 siblings, 1 reply; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 11:16 UTC (permalink / raw) To: 69992 [-- Attachment #1: Type: text/plain, Size: 539 bytes --] 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! [-- Attachment #2: image.el.patch --] [-- Type: text/x-patch, Size: 13373 bytes --] 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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-27 11:16 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 12:50 ` Eli Zaretskii 2024-03-27 14:21 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 13+ messages in thread From: Eli Zaretskii @ 2024-03-27 12:50 UTC (permalink / raw) To: David Ponce, Joseph Turner; +Cc: 69992 > 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" <bug-gnu-emacs@gnu.org> > > 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? ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-27 12:50 ` Eli Zaretskii @ 2024-03-27 14:21 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 14:21 UTC (permalink / raw) To: Eli Zaretskii, Joseph Turner; +Cc: 69992 [-- Attachment #1: Type: text/plain, Size: 837 bytes --] 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" <bug-gnu-emacs@gnu.org> >> >> 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. [-- Attachment #2: image.el-compute-map-V1.patch --] [-- Type: text/x-patch, Size: 13333 bytes --] 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 ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-27 14:21 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 23:53 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 2 replies; 13+ messages in thread From: Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 22:17 UTC (permalink / raw) To: David Ponce; +Cc: Eli Zaretskii, 69992 David Ponce <da_vid@orange.fr> writes: > 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" <bug-gnu-emacs@gnu.org> >>> >>> Many thanks for this feature, which is particularly useful to >>> automatically recalculate the map of computed images like SVG. You're welcome! >>> 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. Thanks for reviewing and optimizing this feature. Please share the tests/benchmarks that you've performed. >>> Furthermore, I wonder if the term :base-map would not be more >>> descriptive than :original-map? I am fine with changing :original-map to :base-map. If you want to do this, I suggest making this change in its own commit which also updates the relevant docstrings and manual pages. >> Thanks. >> Joseph, any comments or suggestions? On my machine, not all tests pass with the patch. Please be sure that these three new tests pass: image-create-image-with-map image--compute-map-and-original-map image-transform-map Personally, I find it easier to understand image map transformation when the logic is split into multiple functions. However, the benefit of readability could certainly be outweighed by a noticeable improvement to user experience. Please share some benchmarks. Please keep in mind that `image--delayed-change-size' already debounces image transformation, so this code may not be so performance-critical. Thank you, Joseph > Attached the same patch slightly cleaned up. > > [2. text/x-patch; image.el-compute-map-V1.patch]... ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 23:53 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 1 sibling, 0 replies; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-27 23:53 UTC (permalink / raw) To: Joseph Turner; +Cc: Eli Zaretskii, 69992 On 27/03/2024 23:17, Joseph Turner wrote: > > David Ponce <da_vid@orange.fr> writes: > >> 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" <bug-gnu-emacs@gnu.org> >>>> >>>> Many thanks for this feature, which is particularly useful to >>>> automatically recalculate the map of computed images like SVG. > > You're welcome! > >>>> 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. > > Thanks for reviewing and optimizing this feature. Please share the > tests/benchmarks that you've performed. OK >>>> Furthermore, I wonder if the term :base-map would not be more >>>> descriptive than :original-map? > > I am fine with changing :original-map to :base-map. If you want to do > this, I suggest making this change in its own commit which also updates > the relevant docstrings and manual pages. I was just wondering. If everyone is happy with :original-map, I'm fine with it. >>> Thanks. >>> Joseph, any comments or suggestions? > > On my machine, not all tests pass with the patch. Please be sure that > these three new tests pass: > > image-create-image-with-map > image--compute-map-and-original-map > image-transform-map Maybe some tests didn't pass because with my patch the computed hot spots are pushed in a new map in reverse order? I will have a look at this as soon as possible. > Personally, I find it easier to understand image map transformation when > the logic is split into multiple functions. However, the benefit of > readability could certainly be outweighed by a noticeable improvement to > user experience. Please share some benchmarks. In this case, I have the opposite feeling ;-) I find harder to read the logic splits into multiple functions that operate by side effect on hot spots coords. But it could be just me :-) > Please keep in mind that `image--delayed-change-size' already debounces > image transformation, so this code may not be so performance-critical. Related to `image--delayed-change-size', you are probably right. My concern is more about computed images and associated maps (I use such kind of images+maps in computed SVG buttons grids). In this case it could be interesting to keep `create-image' as efficient as possible. > Thank you, You are welcome! Thank you for your feedback! > > Joseph > >> Attached the same patch slightly cleaned up. >> >> [2. text/x-patch; image.el-compute-map-V1.patch]... > ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 23:53 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-29 10:19 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 1 sibling, 1 reply; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-28 22:22 UTC (permalink / raw) To: 69992; +Cc: Eli Zaretskii, Joseph Turner [-- Attachment #1: Type: text/plain, Size: 3435 bytes --] Re-sent to all (sorry) On 27/03/2024 23:17, Joseph Turner wrote: [...] > On my machine, not all tests pass with the patch. Please be sure that > these three new tests pass: > > image-create-image-with-map > image--compute-map-and-original-map > image-transform-map > > Personally, I find it easier to understand image map transformation when > the logic is split into multiple functions. However, the benefit of > readability could certainly be outweighed by a noticeable improvement to > user experience. Please share some benchmarks. > > Please keep in mind that `image--delayed-change-size' already debounces > image transformation, so this code may not be so performance-critical. Hello, After more work, testing and benchmarks, I can finally confirm that my proposed version of `image--compute-*map' without the logic splits into multiple functions is not significantly faster than the current version with the logic splits into multiple functions :-) What I found interesting after profiling both current and proposed functions is that most of the time is consumed by the call to `image-size'! I also found that the current implementation is not correct when rotation is not a multiple of 90 degrees. In this case, Emacs still scales the image if specified, but ignores rotation and flipping. However, in this case, the `image--compute-*map' functions do not recompute map. 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. This new version passes the `image-create-image-with-map' and `image-transform-map' tests. But on my laptop, the `image--compute-map-and-original-map' fails the same for both the current and proposed version of the functions: F image--compute-map-and-original-map Test ‘image--compute-map’ and ‘image--compute-original-map’. (ert-test-failed ((should (image-tests--map-equal (image--compute-map image) rotated-map)) :form (image-tests--map-equal (((circle ... . 24) "a" (help-echo "A")) ((rect ... 127 . 77) "b" (help-echo "B")) ((poly . [199 161 206 160 213 154 218 146 221 136 ...]) "c" (help-echo "C"))) (((circle ... . 24) "a" (help-echo "A")) ((rect ... 54 . 77) "b" (help-echo "B")) ((poly . [126 161 133 160 140 154 145 146 148 136 ...]) "c" (help-echo "C")))) :value nil)) Thanks! [-- Attachment #2: image-compute-map-V0.patch --] [-- Type: text/x-patch, Size: 13928 bytes --] diff --git a/lisp/image.el b/lisp/image.el index d7496485aca..b609f0fc34c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1423,115 +1423,139 @@ image-recompute-map-p :type 'boolean :version "30.1") +(defsubst image--compute-scaling (image) + "Return the current scaling of IMAGE, or 1 if no scaling." + ;; The image may be scaled due to many reasons (:scale, :max-width, + ;; etc), so using `image--current-scaling' to get ratio between the + ;; original image size and the displayed size) is better than just + ;; using the :scale value. Unfortunately each call to `image_size' is + ;; very resource consuming! + ;; (image--current-scaling + ;; image (image--image-without-parameters image)) + (or (image-property image :scale) 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 (image-property image :rotation))) + (and degrees (= 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* ((scale (image--compute-scaling image)) + (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 (image-size image t))) + ;; 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)) +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* ((scale (image--compute-scaling image)) + (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 (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))) + ;; 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 +1576,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") ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-29 10:19 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 8:10 ` Eli Zaretskii 0 siblings, 1 reply; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-29 10:19 UTC (permalink / raw) To: 69992; +Cc: Eli Zaretskii, Joseph Turner [-- Attachment #1: Type: text/plain, Size: 1397 bytes --] [...] > 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. Regards [-- Attachment #2: image-compute-map-V1.patch --] [-- Type: text/x-patch, Size: 13927 bytes --] diff --git a/lisp/image.el b/lisp/image.el index d7496485aca..2627d0be10a 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1423,115 +1423,139 @@ image-recompute-map-p :type 'boolean :version "30.1") +(defsubst image--compute-scaling (image) + "Return the current scaling of IMAGE, or 1 if no scaling." + ;; The image may be scaled due to many reasons (:scale, :max-width, + ;; etc), so using `image--current-scaling' to get ratio between the + ;; original image size and the displayed size) is better than just + ;; using the :scale value. Unfortunately each call to `image_size' is + ;; very resource consuming! + ;; (image--current-scaling + ;; image (image--image-without-parameters image)) + (or (image-property image :scale) 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* ((scale (image--compute-scaling image)) + (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 (image-size image t))) + ;; 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)) +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* ((scale (image--compute-scaling image)) + (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 (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))) + ;; 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 +1576,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") ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-29 10:19 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 8:10 ` Eli Zaretskii 2024-03-30 8:55 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 13+ messages in thread From: Eli Zaretskii @ 2024-03-30 8:10 UTC (permalink / raw) To: David Ponce; +Cc: 69992, joseph > 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. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-30 8:10 ` Eli Zaretskii @ 2024-03-30 8:55 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 8:55 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 69992, joseph 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! ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-30 8:55 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 13:37 ` Eli Zaretskii 2024-03-30 19:07 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 2 replies; 13+ messages in thread From: David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 12:59 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 69992, joseph [-- 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") ^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 13:37 ` Eli Zaretskii 2024-03-30 19:07 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 1 sibling, 0 replies; 13+ messages in thread From: Eli Zaretskii @ 2024-03-30 13:37 UTC (permalink / raw) To: David Ponce; +Cc: 69992-done, joseph > Date: Sat, 30 Mar 2024 13:59:41 +0100 > From: David Ponce <da_vid@orange.fr> > Cc: 69992@debbugs.gnu.org, joseph@breatheoutbreathe.in > > 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: Thanks, installed on master, and closing the bug. ^ permalink raw reply [flat|nested] 13+ messages in thread
* bug#69992: Minor improvement to image map transformation logic 2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 13:37 ` Eli Zaretskii @ 2024-03-30 19:07 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 1 sibling, 0 replies; 13+ messages in thread From: Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-30 19:07 UTC (permalink / raw) To: David Ponce; +Cc: Eli Zaretskii, 69992 David Ponce <da_vid@orange.fr> writes: > 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 :-) Thank you for these fixes and optimizations!!! The tests pass for me. > 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. With this fix, I think we can remove `image-tests--map-equal'. I'll submit a new bug. > (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! > > [2. text/x-patch; image-compute-map-V2.patch]... ^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2024-03-30 19:07 UTC | newest] Thread overview: 13+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2024-03-25 1:00 bug#69992: Minor improvement to image map transformation logic Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 11:16 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 12:50 ` Eli Zaretskii 2024-03-27 14:21 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-27 23:53 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-29 10:19 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 8:10 ` Eli Zaretskii 2024-03-30 8:55 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors 2024-03-30 13:37 ` Eli Zaretskii 2024-03-30 19:07 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).