>From 7a3d9fa5cc08c40696ad65101d62cb4babb4dc76 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Thu, 7 Mar 2024 21:55:00 -0800 Subject: [PATCH] Recalculate :map when image :scale changes Now, when rescaling an image with a :map using `image-increase-size' or `image-decrease-size', the image map scales along with the image. Image map coordinates are integers, so when scaling :map, coordinates must be rounded. To prevent an image from drifting from its map after repeatedly scaling up and down, `create-image' now stores the original :unscaled-map, which is combined with the image's scale after resizing to recalculate :map. * lisp/image.el (create-image): Add :unscaled-map image property (image--delayed-change-size): Fix comment (image--change-size): Also scale image map (image--scale-map): Add function to scale an image map --- lisp/image.el | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/lisp/image.el b/lisp/image.el index 2ebce59a98c..c72332172f0 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -533,6 +533,13 @@ create-image ('t t) ('nil nil) (func (funcall func image))))))) + ;; Add unscaled map. + (when-let ((map (plist-get props :map))) + (setq image (nconc image + (list :unscaled-map + (image--scale-map + (copy-tree map t) + (/ 1.0 (image-property image :scale))))))) image))) (defun image--default-smoothing (image) @@ -1185,7 +1192,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 :scale and :map. 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. @@ -1267,9 +1274,34 @@ image--get-imagemagick-and-warn (defun image--change-size (factor &optional position) (let* ((image (image--get-imagemagick-and-warn position)) (new-image (image--image-without-parameters image)) - (scale (image--current-scaling image new-image))) + (unscaled-map (image-property image :unscaled-map)) + (scale (image--current-scaling image new-image)) + (new-scale (* scale factor))) (setcdr image (cdr new-image)) - (plist-put (cdr image) :scale (* scale factor)))) + (plist-put (cdr image) :scale new-scale) + (when unscaled-map + (setf (image-property image :map) + (image--scale-map (copy-tree unscaled-map t) new-scale))))) + +(defun image--scale-map (map factor) + "Scale MAP by FACTOR, destructively modifying it." + (unless (= 1 factor) + (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map) + (pcase-exhaustive type + ('rect + (setf (caar coords) (round (* (caar coords) factor))) + (setf (cdar coords) (round (* (cdar coords) factor))) + (setf (cadr coords) (round (* (cadr coords) factor))) + (setf (cddr coords) (round (* (cddr coords) factor)))) + ('circle + (setf (caar coords) (round (* (caar coords) factor))) + (setf (cdar coords) (round (* (cdar coords) factor))) + (setf (cdr coords) (round (* (cdr coords) factor)))) + ('poly + (dotimes (i (length coords)) + (aset coords i + (round (* (aref coords i) factor)))))))) + map) (defun image--image-without-parameters (image) (cons (pop image) -- 2.41.0