summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoseph Turner <joseph@breatheoutbreathe.in>2024-03-07 21:55:00 -0800
committerEli Zaretskii <eliz@gnu.org>2024-03-23 19:54:53 +0200
commit79c758187cef7fc1f93fd525b9d81be81ee2b2cc (patch)
tree99534fe047ef9221b5b1aeb366f346b5ddd5dc90
parent4b0f5cdb01fbd05c8184a89fa8543eb5600fb4f8 (diff)
downloademacs-79c758187cef7fc1f93fd525b9d81be81ee2b2cc.tar.gz
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-original-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 docstrings. * 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-tests--map-equal): Add equality predicate to compare image maps. (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. (Bug#69602)
-rw-r--r--doc/lispref/display.texi24
-rw-r--r--etc/NEWS12
-rw-r--r--lisp/image.el221
-rw-r--r--test/lisp/image-tests.el144
4 files changed, 389 insertions, 12 deletions
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index beca470d68a..b497967c445 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6056,6 +6056,30 @@ to make things match up, you should either specify @code{:scale 1.0}
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 c6b654a9d3b..19588fe8eeb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1368,6 +1368,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 c13fea6c45c..55340ea03dc 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -560,6 +560,16 @@ Images should not be larger than specified by `max-image-size'."
('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)
@@ -1208,7 +1218,10 @@ has no effect."
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))
@@ -1220,7 +1233,7 @@ POSITION can be a buffer position or a marker, and defaults to point."
(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.
@@ -1231,7 +1244,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
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))
@@ -1243,7 +1259,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
(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
@@ -1253,7 +1272,10 @@ EVENT, if any, by the default factor used by `image-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
@@ -1304,7 +1326,9 @@ POSITION can be a buffer position or a marker, and defaults to point."
(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)
@@ -1331,7 +1355,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
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)
@@ -1339,7 +1366,9 @@ rotations by only multiples of 90 degrees."
(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"))
@@ -1360,23 +1389,191 @@ changing the displayed image size does not affect the saved image."
(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 (* (/ angle 180.0) float-pi))
+ (`(,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..6a5f03e38a0 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,148 @@
(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."
+ (skip-unless (display-images-p))
+ (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)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+ "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B. When nil, TOLERANCE defaults to 5."
+ (unless tolerance (setq tolerance 5))
+ (catch 'different
+ (cl-labels ((check-tolerance
+ (coord-a coord-b)
+ (unless (>= tolerance (abs (- coord-a coord-b)))
+ (throw 'different nil))))
+ (dotimes (i (length a))
+ (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+ (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+ (unless (eq type-a type-b)
+ (throw 'different nil))
+ (pcase-exhaustive type-a
+ ('rect
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cadr coords-a) (cadr coords-b))
+ (check-tolerance (cddr coords-a) (cddr coords-b)))
+ ('circle
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b)))
+ ('poly
+ (dotimes (i (length coords-a))
+ (check-tolerance (aref coords-a i) (aref coords-b i))))))))
+ t))
+
+(ert-deftest image--compute-map-and-original-map ()
+ "Test `image--compute-map' and `image--compute-original-map'."
+ (skip-unless (display-images-p))
+ (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 (image-tests--map-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 (image-tests--map-equal (image--compute-map image)
+ scaled-map))
+ (setf (image-property image :scale) 1)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-equal (image--compute-map image)
+ rotated-map))
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :flip) t)
+ (should (image-tests--map-equal (image--compute-map image)
+ flipped-map))
+ (setf (image-property image :scale) 2)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-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