aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoseph Turner2024-03-07 21:55:00 -0800
committerEli Zaretskii2024-03-23 19:54:53 +0200
commit79c758187cef7fc1f93fd525b9d81be81ee2b2cc (patch)
tree99534fe047ef9221b5b1aeb366f346b5ddd5dc90
parent4b0f5cdb01fbd05c8184a89fa8543eb5600fb4f8 (diff)
downloademacs-79c758187cef7fc1f93fd525b9d81be81ee2b2cc.tar.gz
emacs-79c758187cef7fc1f93fd525b9d81be81ee2b2cc.zip
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}
6056when creating the image, or use the result of 6056when creating the image, or use the result of
6057@code{image-compute-scaling-factor} to compute the elements of the 6057@code{image-compute-scaling-factor} to compute the elements of the
6058map. 6058map.
6059
6060When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
6061changed, @code{:map} will be recomputed based on the value of
6062@code{:original-map} and the values of those transformation.
6063
6064@item :original-map @var{original-map}
6065@cindex original image map
6066This specifies the untransformed image map which will be used to
6067recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
6068or @code{:flip} is changed.
6069
6070If @code{:original-map} is not specified when creating an image with
6071@code{create-image}, it will be computed based on the supplied
6072@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
6073@code{:flip} which are non-nil.
6074
6075Conversely, if @code{:original-map} is specified but @code{:map} is not,
6076@code{:map} will be computed based on @code{:original-map},
6077@code{:scale}, @code{:rotation}, and @code{:flip}.
6078
6079@defopt image-recompute-map-p
6080Set this user option to nil to prevent Emacs from automatically
6081recomputing an image @code{:map} based on its @code{:original-map}.
6082@end defopt
6059@end table 6083@end table
6060 6084
6061@defun image-mask-p spec &optional frame 6085@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:
1368 (notifications-notify 1368 (notifications-notify
1369 :title "I am playing music" :app-icon 'multimedia-player) 1369 :title "I am playing music" :app-icon 'multimedia-player)
1370 1370
1371** Image
1372
1373+++
1374*** Image :map property is now recomputed when image is transformed.
1375Now images with clickable maps work as expected after you run commands
1376such as `image-increase-size', `image-decrease-size', `image-rotate',
1377`image-flip-horizontally', and `image-flip-vertically'.
1378
1379+++
1380*** New user option 'image-recompute-map-p'
1381Set this option to nil to prevent Emacs from recomputing image maps.
1382
1371** Image Dired 1383** Image Dired
1372 1384
1373*** New user option 'image-dired-thumb-naming'. 1385*** 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'."
560 ('t t) 560 ('t t)
561 ('nil nil) 561 ('nil nil)
562 (func (funcall func image))))))) 562 (func (funcall func image)))))))
563 ;; Add original map from map.
564 (when (and (plist-get props :map)
565 (not (plist-get props :original-map)))
566 (setq image (nconc image (list :original-map
567 (image--compute-original-map image)))))
568 ;; Add map from original map.
569 (when (and (plist-get props :original-map)
570 (not (plist-get props :map)))
571 (setq image (nconc image (list :map
572 (image--compute-map image)))))
563 image))) 573 image)))
564 574
565(defun image--default-smoothing (image) 575(defun image--default-smoothing (image)
@@ -1208,7 +1218,10 @@ has no effect."
1208If N is 3, then the image size will be increased by 30%. More 1218If N is 3, then the image size will be increased by 30%. More
1209generally, the image size is multiplied by 1 plus N divided by 10. 1219generally, the image size is multiplied by 1 plus N divided by 10.
1210N defaults to 2, which increases the image size by 20%. 1220N defaults to 2, which increases the image size by 20%.
1211POSITION can be a buffer position or a marker, and defaults to point." 1221POSITION can be a buffer position or a marker, and defaults to point.
1222
1223When user option `image-recompute-map-p' is non-nil, the image's `:map'
1224is recomputed to fit the newly transformed image."
1212 (interactive "P") 1225 (interactive "P")
1213 (image--delayed-change-size (if n 1226 (image--delayed-change-size (if n
1214 (1+ (/ (prefix-numeric-value n) 10.0)) 1227 (1+ (/ (prefix-numeric-value n) 10.0))
@@ -1220,7 +1233,7 @@ POSITION can be a buffer position or a marker, and defaults to point."
1220(defun image--delayed-change-size (size position) 1233(defun image--delayed-change-size (size position)
1221 ;; Wait for a bit of idle-time before actually performing the change, 1234 ;; Wait for a bit of idle-time before actually performing the change,
1222 ;; so as to batch together sequences of closely consecutive size changes. 1235 ;; so as to batch together sequences of closely consecutive size changes.
1223 ;; `image--change-size' just changes one value in a plist. The actual 1236 ;; `image--change-size' just changes two values in a plist. The actual
1224 ;; image resizing happens later during redisplay. So if those 1237 ;; image resizing happens later during redisplay. So if those
1225 ;; consecutive calls happen without any redisplay between them, 1238 ;; consecutive calls happen without any redisplay between them,
1226 ;; the costly operation of image resizing should happen only once. 1239 ;; 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."
1231If N is 3, then the image size will be decreased by 30%. More 1244If N is 3, then the image size will be decreased by 30%. More
1232generally, the image size is multiplied by 1 minus N divided by 10. 1245generally, the image size is multiplied by 1 minus N divided by 10.
1233N defaults to 2, which decreases the image size by 20%. 1246N defaults to 2, which decreases the image size by 20%.
1234POSITION can be a buffer position or a marker, and defaults to point." 1247POSITION can be a buffer position or a marker, and defaults to point.
1248
1249When user option `image-recompute-map-p' is non-nil, the image's `:map'
1250is recomputed to fit the newly transformed image."
1235 (interactive "P") 1251 (interactive "P")
1236 (image--delayed-change-size (if n 1252 (image--delayed-change-size (if n
1237 (- 1 (/ (prefix-numeric-value n) 10.0)) 1253 (- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1243,7 +1259,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
1243(defun image-mouse-increase-size (&optional event) 1259(defun image-mouse-increase-size (&optional event)
1244 "Increase the image size using the mouse-gesture EVENT. 1260 "Increase the image size using the mouse-gesture EVENT.
1245This increases the size of the image at the position specified by 1261This increases the size of the image at the position specified by
1246EVENT, if any, by the default factor used by `image-increase-size'." 1262EVENT, if any, by the default factor used by `image-increase-size'.
1263
1264When user option `image-recompute-map-p' is non-nil, the image's `:map'
1265is recomputed to fit the newly transformed image."
1247 (interactive "e") 1266 (interactive "e")
1248 (when (listp event) 1267 (when (listp event)
1249 (save-window-excursion 1268 (save-window-excursion
@@ -1253,7 +1272,10 @@ EVENT, if any, by the default factor used by `image-increase-size'."
1253(defun image-mouse-decrease-size (&optional event) 1272(defun image-mouse-decrease-size (&optional event)
1254 "Decrease the image size using the mouse-gesture EVENT. 1273 "Decrease the image size using the mouse-gesture EVENT.
1255This decreases the size of the image at the position specified by 1274This decreases the size of the image at the position specified by
1256EVENT, if any, by the default factor used by `image-decrease-size'." 1275EVENT, if any, by the default factor used by `image-decrease-size'.
1276
1277When user option `image-recompute-map-p' is non-nil, the image's `:map'
1278is recomputed to fit the newly transformed image."
1257 (interactive "e") 1279 (interactive "e")
1258 (when (listp event) 1280 (when (listp event)
1259 (save-window-excursion 1281 (save-window-excursion
@@ -1304,7 +1326,9 @@ POSITION can be a buffer position or a marker, and defaults to point."
1304 (new-image (image--image-without-parameters image)) 1326 (new-image (image--image-without-parameters image))
1305 (scale (image--current-scaling image new-image))) 1327 (scale (image--current-scaling image new-image)))
1306 (setcdr image (cdr new-image)) 1328 (setcdr image (cdr new-image))
1307 (plist-put (cdr image) :scale (* scale factor)))) 1329 (plist-put (cdr image) :scale (* scale factor))
1330 (when (and (image-property image :original-map) image-recompute-map-p)
1331 (setf (image-property image :map) (image--compute-map image)))))
1308 1332
1309(defun image--image-without-parameters (image) 1333(defun image--image-without-parameters (image)
1310 (cons (pop image) 1334 (cons (pop image)
@@ -1331,7 +1355,10 @@ POSITION can be a buffer position or a marker, and defaults to point."
1331If nil, ANGLE defaults to 90. Interactively, rotate the image 90 1355If nil, ANGLE defaults to 90. Interactively, rotate the image 90
1332degrees clockwise with no prefix argument, and counter-clockwise 1356degrees clockwise with no prefix argument, and counter-clockwise
1333with a prefix argument. Note that most image types support 1357with a prefix argument. Note that most image types support
1334rotations by only multiples of 90 degrees." 1358rotations by only multiples of 90 degrees.
1359
1360When user option `image-recompute-map-p' is non-nil, the image's `:map'
1361is recomputed to fit the newly transformed image."
1335 (interactive (and current-prefix-arg '(-90))) 1362 (interactive (and current-prefix-arg '(-90)))
1336 (let ((image (image--get-imagemagick-and-warn))) 1363 (let ((image (image--get-imagemagick-and-warn)))
1337 (setf (image-property image :rotation) 1364 (setf (image-property image :rotation)
@@ -1339,7 +1366,9 @@ rotations by only multiples of 90 degrees."
1339 (or angle 90)) 1366 (or angle 90))
1340 ;; We don't want to exceed 360 degrees rotation, 1367 ;; We don't want to exceed 360 degrees rotation,
1341 ;; because it's not seen as valid in Exif data. 1368 ;; because it's not seen as valid in Exif data.
1342 360)))) 1369 360)))
1370 (when (and (image-property image :original-map) image-recompute-map-p)
1371 (setf (image-property image :map) (image--compute-map image))))
1343 (set-transient-map image--repeat-map nil nil 1372 (set-transient-map image--repeat-map nil nil
1344 "Use %k for further adjustments")) 1373 "Use %k for further adjustments"))
1345 1374
@@ -1360,23 +1389,191 @@ changing the displayed image size does not affect the saved image."
1360 (read-file-name "Write image to file: "))))) 1389 (read-file-name "Write image to file: ")))))
1361 1390
1362(defun image-flip-horizontally () 1391(defun image-flip-horizontally ()
1363 "Horizontally flip the image under point." 1392 "Horizontally flip the image under point.
1393
1394When user option `image-recompute-map-p' is non-nil, the image's `:map'
1395is recomputed to fit the newly transformed image."
1364 (interactive) 1396 (interactive)
1365 (let ((image (image--get-image))) 1397 (let ((image (image--get-image)))
1366 (image-flush image) 1398 (image-flush image)
1367 (setf (image-property image :flip) 1399 (setf (image-property image :flip)
1368 (not (image-property image :flip))))) 1400 (not (image-property image :flip)))
1401 (when (and (image-property image :original-map) image-recompute-map-p)
1402 (setf (image-property image :map) (image--compute-map image)))))
1369 1403
1370(defun image-flip-vertically () 1404(defun image-flip-vertically ()
1371 "Vertically flip the image under point." 1405 "Vertically flip the image under point.
1406
1407When user option `image-recompute-map-p' is non-nil, the image's `:map'
1408is recomputed to fit the newly transformed image."
1372 (interactive) 1409 (interactive)
1373 (let ((image (image--get-image))) 1410 (let ((image (image--get-image)))
1374 (image-rotate 180) 1411 (image-rotate 180)
1375 (setf (image-property image :flip) 1412 (setf (image-property image :flip)
1376 (not (image-property image :flip))))) 1413 (not (image-property image :flip)))
1414 (when (and (image-property image :original-map) image-recompute-map-p)
1415 (setf (image-property image :map) (image--compute-map image)))))
1377 1416
1378(define-obsolete-function-alias 'image-refresh #'image-flush "29.1") 1417(define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
1379 1418
1419;;; Map transformation
1420
1421(defcustom image-recompute-map-p t
1422 "Recompute image map when scaling, rotating, or flipping an image."
1423 :type 'boolean
1424 :version "30.1")
1425
1426(defun image--compute-map (image)
1427 "Compute map for IMAGE suitable to be used as its :map property.
1428Return a copy of :original-image transformed based on IMAGE's :scale,
1429:rotation, and :flip. When IMAGE's :original-map is nil, return nil.
1430When :rotation is not a multiple of 90, return copy of :original-map."
1431 (pcase-let* ((original-map (image-property image :original-map))
1432 (map (copy-tree original-map t))
1433 (scale (or (image-property image :scale) 1))
1434 (rotation (or (image-property image :rotation) 0))
1435 (flip (image-property image :flip))
1436 ((and size `(,width . ,height)) (image-size image t)))
1437 (when (and ; Handle only 90-degree rotations
1438 (zerop (mod rotation 1))
1439 (zerop (% (truncate rotation) 90)))
1440 ;; SIZE fits MAP after transformations. Scale MAP before
1441 ;; flip and rotate operations, since both need MAP to fit SIZE.
1442 (image--scale-map map scale)
1443 ;; In rendered images, rotation is always applied before flip.
1444 (image--rotate-map
1445 map rotation (if (or (= 90 rotation) (= 270 rotation))
1446 ;; If rotated ±90°, swap width and height.
1447 (cons height width)
1448 size))
1449 ;; After rotation, there's no need to swap width and height.
1450 (image--flip-map map flip size))
1451 map))
1452
1453(defun image--compute-original-map (image)
1454 "Return original map for IMAGE.
1455If IMAGE lacks :map property, return nil.
1456When :rotation is not a multiple of 90, return copy of :map."
1457 (when (image-property image :map)
1458 (let* ((image-copy (copy-tree image t))
1459 (map (image-property image-copy :map))
1460 (scale (or (image-property image-copy :scale) 1))
1461 (rotation (or (image-property image-copy :rotation) 0))
1462 (flip (image-property image-copy :flip))
1463 (size (image-size image-copy t)))
1464 (when (and ; Handle only 90-degree rotations
1465 (zerop (mod rotation 1))
1466 (zerop (% (truncate rotation) 90)))
1467 ;; In rendered images, rotation is always applied before flip.
1468 ;; To undo the transformation, flip before rotating.
1469 ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
1470 ;; Therefore, scale MAP after flip and rotate operations, since
1471 ;; both need MAP to fit SIZE.
1472 (image--flip-map map flip size)
1473 (image--rotate-map map (- rotation) size)
1474 (image--scale-map map (/ 1.0 scale)))
1475 map)))
1476
1477(defun image--scale-map (map scale)
1478 "Scale MAP according to SCALE.
1479Destructively modifies and returns MAP."
1480 (unless (= 1 scale)
1481 (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
1482 (pcase-exhaustive type
1483 ('rect
1484 (setf (caar coords) (round (* (caar coords) scale)))
1485 (setf (cdar coords) (round (* (cdar coords) scale)))
1486 (setf (cadr coords) (round (* (cadr coords) scale)))
1487 (setf (cddr coords) (round (* (cddr coords) scale))))
1488 ('circle
1489 (setf (caar coords) (round (* (caar coords) scale)))
1490 (setf (cdar coords) (round (* (cdar coords) scale)))
1491 (setcdr coords (round (* (cdr coords) scale))))
1492 ('poly
1493 (dotimes (i (length coords))
1494 (aset coords i
1495 (round (* (aref coords i) scale))))))))
1496 map)
1497
1498(defun image--rotate-map (map rotation size)
1499 "Rotate MAP according to ROTATION and SIZE.
1500Destructively modifies and returns MAP."
1501 (unless (zerop rotation)
1502 (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
1503 (pcase-exhaustive type
1504 ('rect
1505 (let ( x0 y0 ; New upper left corner
1506 x1 y1) ; New bottom right corner
1507 (pcase (truncate (mod rotation 360)) ; Set new corners to...
1508 (90 ; ...old bottom left and upper right
1509 (setq x0 (caar coords) y0 (cddr coords)
1510 x1 (cadr coords) y1 (cdar coords)))
1511 (180 ; ...old bottom right and upper left
1512 (setq x0 (cadr coords) y0 (cddr coords)
1513 x1 (caar coords) y1 (cdar coords)))
1514 (270 ; ...old upper right and bottom left
1515 (setq x0 (cadr coords) y0 (cdar coords)
1516 x1 (caar coords) y1 (cddr coords))))
1517 (setcar coords (image--rotate-coord x0 y0 rotation size))
1518 (setcdr coords (image--rotate-coord x1 y1 rotation size))))
1519 ('circle
1520 (setcar coords (image--rotate-coord
1521 (caar coords) (cdar coords) rotation size)))
1522 ('poly
1523 (dotimes (i (length coords))
1524 (when (= 0 (% i 2))
1525 (pcase-let ((`(,x . ,y)
1526 (image--rotate-coord
1527 (aref coords i) (aref coords (1+ i)) rotation size)))
1528 (aset coords i x)
1529 (aset coords (1+ i) y))))))))
1530 map)
1531
1532(defun image--rotate-coord (x y angle size)
1533 "Rotate coordinates X and Y by ANGLE in image of SIZE.
1534ANGLE must be a multiple of 90. Returns a cons cell of rounded
1535coordinates (X1 Y1)."
1536 (pcase-let* ((radian (* (/ angle 180.0) float-pi))
1537 (`(,width . ,height) size)
1538 ;; y is positive, but we are in the bottom-right quadrant
1539 (y (- y))
1540 ;; Rotate clockwise
1541 (x1 (+ (* (sin radian) y) (* (cos radian) x)))
1542 (y1 (- (* (cos radian) y) (* (sin radian) x)))
1543 ;; Translate image back into bottom-right quadrant
1544 (`(,x1 . ,y1)
1545 (pcase (truncate (mod angle 360))
1546 (90 ; Translate right by height
1547 (cons (+ x1 height) y1))
1548 (180 ; Translate right by width and down by height
1549 (cons (+ x1 width) (- y1 height)))
1550 (270 ; Translate down by width
1551 (cons x1 (- y1 width)))))
1552 ;; Invert y1 to make both x1 and y1 positive
1553 (y1 (- y1)))
1554 (cons (round x1) (round y1))))
1555
1556(defun image--flip-map (map flip size)
1557 "Horizontally flip MAP according to FLIP and SIZE.
1558Destructively modifies and returns MAP."
1559 (when flip
1560 (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
1561 (pcase-exhaustive type
1562 ('rect
1563 (let ((x0 (- (car size) (cadr coords)))
1564 (y0 (cdar coords))
1565 (x1 (- (car size) (caar coords)))
1566 (y1 (cddr coords)))
1567 (setcar coords (cons x0 y0))
1568 (setcdr coords (cons x1 y1))))
1569 ('circle
1570 (setf (caar coords) (- (car size) (caar coords))))
1571 ('poly
1572 (dotimes (i (length coords))
1573 (when (= 0 (% i 2))
1574 (aset coords i (- (car size) (aref coords i)))))))))
1575 map)
1576
1380(provide 'image) 1577(provide 'image)
1381 1578
1382;;; image.el ends here 1579;;; 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 @@
153 (image-rotate -154.5) 153 (image-rotate -154.5)
154 (should (equal image '(image :rotation 91.0))))) 154 (should (equal image '(image :rotation 91.0)))))
155 155
156;;;; Transforming maps
157
158(ert-deftest image-create-image-with-map ()
159 "Test that `create-image' correctly adds :map and/or :original-map."
160 (skip-unless (display-images-p))
161 (let ((data "foo")
162 (map '(((circle (1 . 1) . 1) a)))
163 (original-map '(((circle (2 . 2) . 2) a)))
164 (original-map-other '(((circle (3 . 3) . 3) a))))
165 ;; Generate :original-map from :map.
166 (let* ((image (create-image data 'svg t :map map :scale 0.5))
167 (got-original-map (image-property image :original-map)))
168 (should (equal got-original-map original-map)))
169 ;; Generate :map from :original-map.
170 (let* ((image (create-image
171 data 'svg t :original-map original-map :scale 0.5))
172 (got-map (image-property image :map)))
173 (should (equal got-map map)))
174 ;; Use :original-map if both it and :map are specified.
175 (let* ((image (create-image
176 data 'svg t :map map
177 :original-map original-map-other :scale 0.5))
178 (got-original-map (image-property image :original-map)))
179 (should (equal got-original-map original-map-other)))))
180
181(defun image-tests--map-equal (a b &optional tolerance)
182 "Return t if maps A and B have the same coordinates within TOLERANCE.
183Since image sizes calculations vary on different machines, this function
184allows for each image map coordinate in A to be within TOLERANCE to the
185corresponding coordinate in B. When nil, TOLERANCE defaults to 5."
186 (unless tolerance (setq tolerance 5))
187 (catch 'different
188 (cl-labels ((check-tolerance
189 (coord-a coord-b)
190 (unless (>= tolerance (abs (- coord-a coord-b)))
191 (throw 'different nil))))
192 (dotimes (i (length a))
193 (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
194 (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
195 (unless (eq type-a type-b)
196 (throw 'different nil))
197 (pcase-exhaustive type-a
198 ('rect
199 (check-tolerance (caar coords-a) (caar coords-b))
200 (check-tolerance (cdar coords-a) (cdar coords-b))
201 (check-tolerance (cadr coords-a) (cadr coords-b))
202 (check-tolerance (cddr coords-a) (cddr coords-b)))
203 ('circle
204 (check-tolerance (caar coords-a) (caar coords-b))
205 (check-tolerance (cdar coords-a) (cdar coords-b))
206 (check-tolerance (cdar coords-a) (cdar coords-b)))
207 ('poly
208 (dotimes (i (length coords-a))
209 (check-tolerance (aref coords-a i) (aref coords-b i))))))))
210 t))
211
212(ert-deftest image--compute-map-and-original-map ()
213 "Test `image--compute-map' and `image--compute-original-map'."
214 (skip-unless (display-images-p))
215 (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>")
216 (original-map
217 '(((circle (41 . 29) . 24) "a" (help-echo "A"))
218 ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
219 ((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"))))
220 (scaled-map
221 '(((circle (82 . 58) . 48) "a" (help-echo "A"))
222 ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
223 ((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"))))
224 (flipped-map
225 '(((circle (125 . 29) . 24) "a" (help-echo "A"))
226 ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
227 ((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"))))
228 (rotated-map
229 '(((circle (126 . 41) . 24) "a" (help-echo "A"))
230 ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
231 ((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"))))
232 (scaled-rotated-flipped-map
233 '(((circle (58 . 82) . 48) "a" (help-echo "A"))
234 ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
235 ((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"))))
236 (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
237 :scale 2 :rotation 90 :flip t)))
238 ;; Test that `image--compute-original-map' correctly generates
239 ;; original-map when creating an already transformed image.
240 (should (image-tests--map-equal (image-property image :original-map)
241 original-map))
242 (setf (image-property image :flip) nil)
243 (setf (image-property image :rotation) 0)
244 (setf (image-property image :scale) 2)
245 (should (image-tests--map-equal (image--compute-map image)
246 scaled-map))
247 (setf (image-property image :scale) 1)
248 (setf (image-property image :rotation) 90)
249 (should (image-tests--map-equal (image--compute-map image)
250 rotated-map))
251 (setf (image-property image :rotation) 0)
252 (setf (image-property image :flip) t)
253 (should (image-tests--map-equal (image--compute-map image)
254 flipped-map))
255 (setf (image-property image :scale) 2)
256 (setf (image-property image :rotation) 90)
257 (should (image-tests--map-equal (image--compute-map image)
258 scaled-rotated-flipped-map))
259
260 ;; Uncomment to test manually by interactively transforming the
261 ;; image and checking the map boundaries by hovering them.
262
263 ;; (with-current-buffer (get-buffer-create "*test image map*")
264 ;; (erase-buffer)
265 ;; (insert-image image)
266 ;; (goto-char (point-min))
267 ;; (pop-to-buffer (current-buffer)))
268 ))
269
270(ert-deftest image-transform-map ()
271 "Test functions related to transforming image maps."
272 (let ((map '(((circle (4 . 3) . 2) "circle")
273 ((rect (3 . 6) 8 . 8) "rect")
274 ((poly . [6 11 7 13 2 14]) "poly")))
275 (width 10)
276 (height 15))
277 (should (equal (image--scale-map (copy-tree map t) 2)
278 '(((circle (8 . 6) . 4) "circle")
279 ((rect (6 . 12) 16 . 16) "rect")
280 ((poly . [12 22 14 26 4 28]) "poly"))))
281 (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
282 '(((circle (12 . 4) . 2) "circle")
283 ((rect (7 . 3) 9 . 8) "rect")
284 ((poly . [4 6 2 7 1 2]) "poly"))))
285 (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
286 '(((circle (6 . 3) . 2) "circle")
287 ((rect (2 . 6) 7 . 8) "rect")
288 ((poly . [4 11 3 13 8 14]) "poly"))))
289 (let ((copy (copy-tree map t)))
290 (image--scale-map copy 2)
291 ;; Scale size because the map has been scaled.
292 (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
293 ;; Swap width and height because the map has been flipped.
294 (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
295 (should (equal copy
296 '(((circle (6 . 8) . 4) "circle")
297 ((rect (12 . 6) 16 . 16) "rect")
298 ((poly . [22 12 26 14 28 4]) "poly")))))))
299
156;;; image-tests.el ends here 300;;; image-tests.el ends here