From: Joseph Turner via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
Subject: bug#69602: 29.1; Image :map should adjust with :scale and :rotation
Date: Wed, 20 Mar 2024 23:45:34 -0700 [thread overview]
Message-ID: <87il1g5b8m.fsf@breatheoutbreathe.in> (raw)
In-Reply-To: <8634t10woh.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 1319 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Fri, 08 Mar 2024 00:39:16 -0800
>>
>> > Are we sure no Lisp program out there would want the coordinates in
>> > :map to remain unchanged under these transformation? Maybe we should
>> > add a variable to control this, so that the change could be truly
>> > backward-compatible?
>>
>> Good point. Thanks!
>>
>> What if explicitly passing :unscaled-map 'no-recalculate in
>> `create-image' prevented :map from being recalculated later?
>
> I think that's less desirable, since some images could be created
> outside of control of a Lisp program that wants to control the
> coordinates.
>
>> If not, what kind of variable did you have in mind? A special variable
>> let-bound the call? Or another argument to `create-image'?
>
> I had in mind a special variable (we'd need to mention it in NEWS and
> in the doc string of the relevant functions). Adding an argument is a
> heavier change, and I think it is not justified in this case, because
> I do agree with you that most, if not all, applications would want the
> coordinates to scale together with the image.
Thanks for your feedback and your patience!
Please see attached patch.
Joseph
[-- Attachment #2: 0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch --]
[-- Type: text/x-diff, Size: 26184 bytes --]
From 7b454df8f7335751c96c946ca09711b16c1de193 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recompute :map when image :scale, :rotation, or :flip changes
Now, when transforming an image, its :map is recomputed to fit.
Image map coordinates are integers, so when computing :map, coordinates
are rounded. To prevent an image from drifting from its map after
repeated transformations, `create-image' now adds a new image property
:original-map, which is combined with the image's transformation
parameters to recompute :map.
* lisp/image.el (image-recompute-map-p): Add user option to control
whether :map is recomputed when an image is transformed.
(create-image): Create :map from :original-map and vice versa.
(image--delayed-change-size): Fix comment.
(image--change-size, image-rotate, image-flip-horizontally,
image-flip-vertically): Recompute image map after transformation and
mention image-recompute-map-p in docstring.
(image--compute-map): Add function to compute a map from original map.
(image--compute-map): Add function to compute an original map from map.
(image--scale-map): Add function to scale a map based on :scale.
(image--rotate-map): Add function to rotate a map based on :rotation.
(image--rotate-coord): Add function to rotate a map coordinate pair.
(image--flip-map): Add function to flip a map based on :flip.
(image-increase-size, image-decrease-size, image-mouse-increase-size,
image-mouse-decrease-size): Mention image-recompute-map-p in docstring.
* etc/NEWS: Add NEWS entry.
* doc/lispref/display.texi (Image Descriptors): Document :original-map
and new user option image-recompute-map-p.
* test/lisp/image-tests.el (image--compute-map-and-original-map): Test
`image--compute-map' and `image--compute-original-map'.
(image-create-image-with-map): Test that `create-image' adds :map and/or
:original-map as appropriate.
(image-transform-map): Test functions related to transforming maps.
---
doc/lispref/display.texi | 24 +++++
etc/NEWS | 12 +++
lisp/image.el | 221 ++++++++++++++++++++++++++++++++++++---
test/lisp/image-tests.el | 111 ++++++++++++++++++++
4 files changed, 356 insertions(+), 12 deletions(-)
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..8335a02b5c5 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6055,6 +6055,30 @@ Image Descriptors
when creating the image, or use the result of
@code{image-compute-scaling-factor} to compute the elements of the
map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
@end table
@defun image-mask-p spec &optional frame
diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..cbd97b495b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,18 @@ without specifying a file, like this:
(notifications-notify
:title "I am playing music" :app-icon 'multimedia-player)
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
** Image Dired
*** New user option 'image-dired-thumb-naming'.
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..ed94b9eb621 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,16 @@ create-image
('t t)
('nil nil)
(func (funcall func image)))))))
+ ;; Add original map from map.
+ (when (and (plist-get props :map)
+ (not (plist-get props :original-map)))
+ (setq image (nconc image (list :original-map
+ (image--compute-original-map image)))))
+ ;; Add map from original map.
+ (when (and (plist-get props :original-map)
+ (not (plist-get props :map)))
+ (setq image (nconc image (list :map
+ (image--compute-map image)))))
image)))
(defun image--default-smoothing (image)
@@ -1173,7 +1183,10 @@ image-increase-size
If N is 3, then the image size will be increased by 30%. More
generally, the image size is multiplied by 1 plus N divided by 10.
N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(1+ (/ (prefix-numeric-value n) 10.0))
@@ -1185,7 +1198,7 @@ image-increase-size
(defun image--delayed-change-size (size position)
;; Wait for a bit of idle-time before actually performing the change,
;; so as to batch together sequences of closely consecutive size changes.
- ;; `image--change-size' just changes one value in a plist. The actual
+ ;; `image--change-size' just changes two values in a plist. The actual
;; image resizing happens later during redisplay. So if those
;; consecutive calls happen without any redisplay between them,
;; the costly operation of image resizing should happen only once.
@@ -1196,7 +1209,10 @@ image-decrease-size
If N is 3, then the image size will be decreased by 30%. More
generally, the image size is multiplied by 1 minus N divided by 10.
N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1208,7 +1224,10 @@ image-decrease-size
(defun image-mouse-increase-size (&optional event)
"Increase the image size using the mouse-gesture EVENT.
This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1218,7 +1237,10 @@ image-mouse-increase-size
(defun image-mouse-decrease-size (&optional event)
"Decrease the image size using the mouse-gesture EVENT.
This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1269,7 +1291,9 @@ image--change-size
(new-image (image--image-without-parameters image))
(scale (image--current-scaling image new-image)))
(setcdr image (cdr new-image))
- (plist-put (cdr image) :scale (* scale factor))))
+ (plist-put (cdr image) :scale (* scale factor))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image--image-without-parameters (image)
(cons (pop image)
@@ -1296,7 +1320,10 @@ image-rotate
If nil, ANGLE defaults to 90. Interactively, rotate the image 90
degrees clockwise with no prefix argument, and counter-clockwise
with a prefix argument. Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive (and current-prefix-arg '(-90)))
(let ((image (image--get-imagemagick-and-warn)))
(setf (image-property image :rotation)
@@ -1304,7 +1331,9 @@ image-rotate
(or angle 90))
;; We don't want to exceed 360 degrees rotation,
;; because it's not seen as valid in Exif data.
- 360))))
+ 360)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image))))
(set-transient-map image--repeat-map nil nil
"Use %k for further adjustments"))
@@ -1325,23 +1354,191 @@ image-save
(read-file-name "Write image to file: ")))))
(defun image-flip-horizontally ()
- "Horizontally flip the image under point."
+ "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-flush image)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image-flip-vertically ()
- "Vertically flip the image under point."
+ "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-rotate 180)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+ "Recompute image map when scaling, rotating, or flipping an image."
+ :type 'boolean
+ :version "30.1")
+
+(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,
+: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))
+
+(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)))
+ ;; 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)
+
+(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)."
+ (pcase-let* ((radian (thread-first angle (* float-pi) (/ 180.0)))
+ (`(,width . ,height) size)
+ ;; y is positive, but we are in the bottom-right quadrant
+ (y (- y))
+ ;; Rotate clockwise
+ (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+ (y1 (- (* (cos radian) y) (* (sin radian) x)))
+ ;; Translate image back into bottom-right quadrant
+ (`(,x1 . ,y1)
+ (pcase (truncate (mod angle 360))
+ (90 ; Translate right by height
+ (cons (+ x1 height) y1))
+ (180 ; Translate right by width and down by height
+ (cons (+ x1 width) (- y1 height)))
+ (270 ; Translate down by width
+ (cons x1 (- y1 width)))))
+ ;; Invert y1 to make both x1 and y1 positive
+ (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
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..1e409190865 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,115 @@ image-rotate
(image-rotate -154.5)
(should (equal image '(image :rotation 91.0)))))
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+ "Test that `create-image' correctly adds :map and/or :original-map."
+ (let ((data "foo")
+ (map '(((circle (1 . 1) . 1) a)))
+ (original-map '(((circle (2 . 2) . 2) a)))
+ (original-map-other '(((circle (3 . 3) . 3) a))))
+ ;; Generate :original-map from :map.
+ (let* ((image (create-image data 'svg t :map map :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map)))
+ ;; Generate :map from :original-map.
+ (let* ((image (create-image
+ data 'svg t :original-map original-map :scale 0.5))
+ (got-map (image-property image :map)))
+ (should (equal got-map map)))
+ ;; Use :original-map if both it and :map are specified.
+ (let* ((image (create-image
+ data 'svg t :map map
+ :original-map original-map-other :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map-other)))))
+
+(ert-deftest image--compute-map-and-original-map ()
+ "Test `image--compute-map' and `image--compute-original-map'."
+ (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+ (original-map
+ '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+ ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+ ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+ (scaled-map
+ '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+ ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+ ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+ (flipped-map
+ '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+ ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+ ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+ (rotated-map
+ '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+ ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+ ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+ (scaled-rotated-flipped-map
+ '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+ ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+ ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+ (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+ :scale 2 :rotation 90 :flip t)))
+ ;; Test that `image--compute-original-map' correctly generates
+ ;; original-map when creating an already transformed image.
+ (should (equal (image-property image :original-map)
+ original-map))
+ (setf (image-property image :flip) nil)
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :scale) 2)
+ (should (equal (image--compute-map image)
+ scaled-map))
+ (setf (image-property image :scale) 1)
+ (setf (image-property image :rotation) 90)
+ (should (equal (image--compute-map image)
+ rotated-map))
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :flip) t)
+ (should (equal (image--compute-map image)
+ flipped-map))
+ (setf (image-property image :scale) 2)
+ (setf (image-property image :rotation) 90)
+ (should (equal (image--compute-map image)
+ scaled-rotated-flipped-map))
+
+ ;; Uncomment to test manually by interactively transforming the
+ ;; image and checking the map boundaries by hovering them.
+
+ ;; (with-current-buffer (get-buffer-create "*test image map*")
+ ;; (erase-buffer)
+ ;; (insert-image image)
+ ;; (goto-char (point-min))
+ ;; (pop-to-buffer (current-buffer)))
+ ))
+
+(ert-deftest image-transform-map ()
+ "Test functions related to transforming image maps."
+ (let ((map '(((circle (4 . 3) . 2) "circle")
+ ((rect (3 . 6) 8 . 8) "rect")
+ ((poly . [6 11 7 13 2 14]) "poly")))
+ (width 10)
+ (height 15))
+ (should (equal (image--scale-map (copy-tree map t) 2)
+ '(((circle (8 . 6) . 4) "circle")
+ ((rect (6 . 12) 16 . 16) "rect")
+ ((poly . [12 22 14 26 4 28]) "poly"))))
+ (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+ '(((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))
+ '(((circle (6 . 3) . 2) "circle")
+ ((rect (2 . 6) 7 . 8) "rect")
+ ((poly . [4 11 3 13 8 14]) "poly"))))
+ (let ((copy (copy-tree map t)))
+ (image--scale-map copy 2)
+ ;; 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)))
+ (should (equal copy
+ '(((circle (6 . 8) . 4) "circle")
+ ((rect (12 . 6) 16 . 16) "rect")
+ ((poly . [22 12 26 14 28 4]) "poly")))))))
+
;;; image-tests.el ends here
--
2.41.0
next prev parent reply other threads:[~2024-03-21 6:45 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-03-07 5:37 bug#69602: 29.1; Image :map should adjust with :scale and :rotation Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-07 7:04 ` Eli Zaretskii
2024-03-07 7:14 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-07 7:55 ` Eli Zaretskii
2024-03-07 8:08 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-07 9:27 ` Eli Zaretskii
2024-03-07 13:53 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-08 7:02 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-08 8:31 ` Eli Zaretskii
2024-03-08 8:39 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-08 11:50 ` Eli Zaretskii
2024-03-21 6:45 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2024-03-21 11:59 ` Eli Zaretskii
2024-03-23 0:11 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-23 7:58 ` Eli Zaretskii
2024-03-23 17:41 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-23 17:58 ` Eli Zaretskii
2024-03-23 18:18 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-23 20:32 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-28 10:13 ` Eli Zaretskii
2024-03-08 7:24 ` Eli Zaretskii
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87il1g5b8m.fsf@breatheoutbreathe.in \
--to=bug-gnu-emacs@gnu.org \
--cc=69602@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=joseph@breatheoutbreathe.in \
--cc=juri@linkov.net \
--cc=stephen.berman@gmx.net \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.