From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Joseph Turner via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#69602: 29.1; Image :map should adjust with :scale and :rotation Date: Sat, 23 Mar 2024 10:41:59 -0700 Message-ID: <87v85concp.fsf@breatheoutbreathe.in> References: <87msramv72.fsf@breatheoutbreathe.in> <86jzmejzfd.fsf@gnu.org> <87a5namqyz.fsf@breatheoutbreathe.in> <86cys63281.fsf@gnu.org> <87wmqelakx.fsf@breatheoutbreathe.in> <86bk7q2xye.fsf@gnu.org> <871q8lk2o7.fsf@breatheoutbreathe.in> <87o7bpi4c1.fsf@breatheoutbreathe.in> <867cid15wv.fsf@gnu.org> <87bk7phzdz.fsf@breatheoutbreathe.in> <8634t10woh.fsf@gnu.org> <87il1g5b8m.fsf@breatheoutbreathe.in> <86y1ab23sw.fsf@gnu.org> <877cht94sb.fsf@breatheoutbreathe.in> <86cyrlz8ec.fsf@gnu.org> Reply-To: Joseph Turner Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5719"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Mar 23 18:55:40 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ro5ak-0001F1-Vb for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 23 Mar 2024 18:55:39 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ro5aV-00052h-Pu; Sat, 23 Mar 2024 13:55:23 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ro5aT-00052U-3S for bug-gnu-emacs@gnu.org; Sat, 23 Mar 2024 13:55:21 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ro5aS-00023K-RV for bug-gnu-emacs@gnu.org; Sat, 23 Mar 2024 13:55:20 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ro5b7-00041S-MK for bug-gnu-emacs@gnu.org; Sat, 23 Mar 2024 13:56:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Joseph Turner Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 23 Mar 2024 17:56:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69602 X-GNU-PR-Package: emacs Original-Received: via spool by 69602-submit@debbugs.gnu.org id=B69602.171121652015346 (code B ref 69602); Sat, 23 Mar 2024 17:56:01 +0000 Original-Received: (at 69602) by debbugs.gnu.org; 23 Mar 2024 17:55:20 +0000 Original-Received: from localhost ([127.0.0.1]:43745 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ro5aQ-0003zP-HO for submit@debbugs.gnu.org; Sat, 23 Mar 2024 13:55:20 -0400 Original-Received: from out-174.mta0.migadu.com ([91.218.175.174]:23029) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ro5QP-0003S3-Q9 for 69602@debbugs.gnu.org; Sat, 23 Mar 2024 13:44:59 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=breatheoutbreathe.in; s=key1; t=1711215820; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=ijxpk/MwE1yi2uDHQ9lpwLshSND9S2xZ7eb/i3SzhiU=; b=ByItrmZPdY+6ROo+UvJTKqv9VDY3zFIOUiUVmq0gQiU9zciNVfnaseyJpDOI1ENFz9kZX3 fMnzu6SzhKA4h9WJGpGO/qmRz8k3AbZBMPEtVv7+JO9v3iCYxKswNlZ93vd8Z0KQgvlNyJ 7jJ0OtLkFWbuOHe0M6JgQrGp3RI/C/c= X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. In-reply-to: <86cyrlz8ec.fsf@gnu.org> X-Migadu-Flow: FLOW_OUT X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:281992 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Eli Zaretskii writes: >> From: Joseph Turner >> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net >> Date: Fri, 22 Mar 2024 17:11:17 -0700 >> >> > Thanks. The tests you added have some problems: >> > >> > . you use thread-first, but don't require subr-x when compiling >> >> I removed thread-first. >> >> > . the tests fail when run in batch mode >> >> I added (skip-unless (display-images-p)) to the two problematic tests, >> and it solved the issue on my machine. > > Solves it here as well. > >> > . when invoked interactively in a GUI session, one test fails: >> > >> > F image--compute-map-and-original-map >> > Test =E2=80=98image--compute-map=E2=80=99 and =E2=80=98image--compute= -original-map=E2=80=99. >> > (ert-test-failed >> > ((should (equal (image--compute-map image) flipped-map)) :form >> > (equal >> > (((circle ... . 24) "a" (help-echo "A")) >> > ((rect ... 162 . 149) "b" (help-echo "B")) >> > ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C"))) >> > (((circle ... . 24) "a" (help-echo "A")) >> > ((rect ... 161 . 149) "b" (help-echo "B")) >> > ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C")))) >> > :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...)))))) >> > >> > It looks like some pixels do not match exactly? Perhaps some >> > tolerances need to be allowed? >> >> Interesting - does the result of `image-size` vary per machine? > > I guess so. The transformations are AFAIK done in floating-point > arithmetics, so some minor inaccuracies are possible. > >> In any case, I added `image-tests--map-equal' to compare image maps with >> some tolerance. Do the tests pass on your machine now? > > Yes, they do now, thanks. However, there's a warning when compiling > the tests: > > In image-tests--map-equal: > lisp/image-tests.el:192:17: Warning: Unused lexical variable `i' > > Can you fix this, please? Oops! I just re-read the dotimes docstring to discover that the RESULT arg is deprecated. Fixed. Thank you! Joseph --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch Content-Transfer-Encoding: quoted-printable >From 0b6f90a1ba757426ff429693914828ce0d93d839 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Thu, 7 Mar 2024 21:55:00 -0800 Subject: [PATCH] Recompute :map when image :scale, :rotation, or :flip chan= ges 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-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. --- doc/lispref/display.texi | 24 +++++ etc/NEWS | 12 +++ lisp/image.el | 221 ++++++++++++++++++++++++++++++++++++--- test/lisp/image-tests.el | 144 +++++++++++++++++++++++++ 4 files changed, 389 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 =20 @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) =20 +** 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 =20 *** New user option 'image-dired-thumb-naming'. diff --git a/lisp/image.el b/lisp/image.el index 2ebce59a98c..c5082c78b75 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))) =20 (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))))) =20 (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")) =20 @@ -1325,23 +1354,191 @@ image-save (read-file-name "Write image to file: "))))) =20 (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))))) =20 (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))))) =20 (define-obsolete-function-alias 'image-refresh #'image-flush "29.1") =20 +;;; 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 (=3D 90 rotation) (=3D 270 rotation)) + ;; If rotated =C2=B190=C2=B0, swap width and heigh= t. + (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 (=3D 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 (=3D 0 (% i 2)) + (pcase-let ((`(,x . ,y) + (image--rotate-coord + (aref coords i) (aref coords (1+ i)) rotation s= ize))) + (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 (=3D 0 (% i 2)) + (aset coords i (- (car size) (aref coords i))))))))) + map) + (provide 'image) =20 ;;; 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 (image-rotate -154.5) (should (equal image '(image :rotation 91.0))))) =20 +;;;; 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 (>=3D 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 "ABC") + (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 16= 0 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 9= 8 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-e= cho "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 29= 2 86 308 74 320]) "c" (help-echo "C")))) + (image (create-image svg-string 'svg t :map scaled-rotated-flippe= d-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 . ,hei= ght)) + '(((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 --=20 2.41.0 --=-=-=--