From: David Ponce via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: 69992@debbugs.gnu.org
Cc: Eli Zaretskii <eliz@gnu.org>,
Joseph Turner <joseph@breatheoutbreathe.in>
Subject: bug#69992: Minor improvement to image map transformation logic
Date: Thu, 28 Mar 2024 23:22:10 +0100 [thread overview]
Message-ID: <d700809c-b4ab-43bc-acbb-e548cc3123c1@orange.fr> (raw)
In-Reply-To: <87cyrfl265.fsf@breatheoutbreathe.in>
[-- 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")
next prev parent reply other threads:[~2024-03-28 22:22 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=d700809c-b4ab-43bc-acbb-e548cc3123c1@orange.fr \
--to=bug-gnu-emacs@gnu.org \
--cc=69992@debbugs.gnu.org \
--cc=da_vid@orange.fr \
--cc=eliz@gnu.org \
--cc=joseph@breatheoutbreathe.in \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).