From: David Ponce via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: 69992@debbugs.gnu.org
Subject: bug#69992: Minor improvement to image map transformation logic
Date: Wed, 27 Mar 2024 12:16:11 +0100 [thread overview]
Message-ID: <55864577-3819-46e0-857a-cc0d0145bc2f@orange.fr> (raw)
In-Reply-To: <87o7b3m8ee.fsf@ushin.org>
[-- Attachment #1: Type: text/plain, Size: 539 bytes --]
Many thanks for this feature, which is particularly useful to
automatically recalculate the map of computed images like SVG.
To make the code faster, by avoiding multiple scans of the map for
copy and parsing, I propose the following patch which factors most of
the code into the functions `image--compute-map' and `image--compute
-original-map'. I have done some tests on my side which are
conclusive.
Furthermore, I wonder if the term :base-map would not be more
descriptive than :original-map?
Thanks again for this valuable feature!
[-- Attachment #2: image.el.patch --]
[-- Type: text/x-patch, Size: 13373 bytes --]
diff --git a/lisp/image.el b/lisp/image.el
index 55340ea03dc..2e3928478ca 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1427,107 +1427,170 @@ image--compute-map
"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))
+When there is no transformation, return :original-map."
+ (when-let ((omap (image-property image :original-map)))
+ (let* ((scale (let ((s (image--current-scaling
+ image
+ (image--image-without-parameters image))))
+ (unless (= s 1) s)))
+ (rotate (let ((d (image-property image :rotation)))
+ ;; Handle only 90-degree rotations
+ (and d (= 0 (mod d 1)) (= 0 (% d 90))
+ (truncate (mod d 360)))))
+ (flip (image-property image :flip))
+ (map omap)
+ size flip-w)
+ (when (or scale rotate flip)
+ (setq map nil
+ size (image-size image t)
+ flip-w (car size))
+ (if (memql rotate '(90 270))
+ ;; If rotated ±90°, swap width and height.
+ (setq size (cons (cdr size) (car size))))
+ ;; SIZE fits MAP after transformations. Scale MAP before flip
+ ;; and rotate operations, since both need MAP to fit SIZE.
+ (pcase-dolist (`(,area ,id ,plist) omap)
+ (pcase-exhaustive area
+ ;; Rectangle hot spot.
+ (`(rect . ((,x0 . ,y0) . (,x1 . ,y1)))
+ (if scale
+ (setq x0 (round (* x0 scale)) y0 (round (* y0 scale))
+ x1 (round (* x1 scale)) y1 (round (* y1 scale))))
+ (if rotate
+ (let ((p0 (image--rotate-coord x0 y0 rotate size))
+ (p1 (image--rotate-coord x1 y1 rotate size)))
+ (setq x0 (car p0) y0 (cdr p0)
+ x1 (car p1) y1 (cdr p1))))
+ (if flip
+ (let ((xa x0) (xb x1))
+ (setq x0 (- flip-w xb)
+ x1 (- flip-w xa))))
+ ;; Normalize rect coords to be top/left bottom/right.
+ (if (> x0 x1)
+ (let ((rw (abs (- x0 x1))))
+ (setq x0 (- x0 rw) x1 (+ x1 rw))))
+ (if (> y0 y1)
+ (let ((rh (abs (- y0 y1))))
+ (setq y0 (- y0 rh) y1 (+ y1 rh))))
+ (push `((rect . ((,x0 . ,y0) . (,x1 . ,y1))) ,id ,plist)
+ map))
+ ;; Circle hot spot.
+ (`(circle . ((,x0 . ,y0) . ,r))
+ (if scale
+ (setq x0 (round (* x0 scale)) y0 (round (* y0 scale))
+ r (round (* r scale))))
+ (if rotate
+ (let ((p0 (image--rotate-coord x0 y0 rotate size)))
+ (setq x0 (car p0) y0 (cdr p0))))
+ (if flip
+ (setq x0 (- flip-w x0)))
+ (push `((circle . ((,x0 . ,y0) . ,r)) ,id ,plist) map))
+ ;; Poly hot spot.
+ (`(poly . ,coords)
+ (setq coords (copy-sequence coords))
+ (let ((i 0) (n (1- (length coords))))
+ (while (< i n)
+ (let* ((j (1+ i))
+ (x (aref coords i))
+ (y (aref coords j)))
+ (if scale
+ (setq x (round (* x scale))
+ y (round (* y scale))))
+ (if rotate
+ (let ((p (image--rotate-coord x y rotate size)))
+ (setq x (car p) y (cdr p))))
+ (if flip
+ (setq x (- flip-w x)))
+ (aset coords i x)
+ (aset coords j y))
+ (setq i (+ i 2))))
+ (push `((poly . ,coords) ,id ,plist) map))
+ )))
+ 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)))
+When there is no transformation, return :map."
+ (when-let ((map (image-property image :map)))
+ (let* ((scale (let ((s (image--current-scaling
+ image
+ (image--image-without-parameters image))))
+ (unless (= s 1) s)))
+ (rotate (let ((d (image-property image :rotation)))
+ ;; Handle only 90-degree rotations
+ (and d (= 0 (mod d 1)) (= 0 (% d 90))
+ (truncate (mod (- d) 360)))))
+ (flip (image-property image :flip))
+ (omap map)
+ size flip-w)
+ (when (or scale rotate flip)
+ (setq omap nil
+ size (image-size image t)
+ flip-w (car size))
;; 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)
+ ;; 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.
+ (pcase-dolist (`(,area ,id ,plist) map)
+ (pcase-exhaustive area
+ ;; Rectangle hot spot.
+ (`(rect . ((,x0 . ,y0) . (,x1 . ,y1)))
+ (if flip
+ (let ((xa x0) (xb x1))
+ (setq x0 (- flip-w xb)
+ x1 (- flip-w xa))))
+ (if rotate
+ (let ((p0 (image--rotate-coord x0 y0 rotate size))
+ (p1 (image--rotate-coord x1 y1 rotate size)))
+ (setq x0 (car p0) y0 (cdr p0)
+ x1 (car p1) y1 (cdr p1))))
+ (if scale
+ (setq x0 (round (/ x0 scale)) y0 (round (/ y0 scale))
+ x1 (round (/ x1 scale)) y1 (round (/ y1 scale))))
+ ;; Normalize rect coords to be top/left bottom/right.
+ (if (> x0 x1)
+ (let ((rw (abs (- x0 x1))))
+ (setq x0 (- x0 rw) x1 (+ x1 rw))))
+ (if (> y0 y1)
+ (let ((rh (abs (- y0 y1))))
+ (setq y0 (- y0 rh) y1 (+ y1 rh))))
+ (push `((rect . ((,x0 . ,y0) . (,x1 . ,y1))) ,id ,plist)
+ omap))
+ ;; Circle hot spot.
+ (`(circle . ((,x0 . ,y0) . ,r))
+ (if flip
+ (setq x0 (- flip-w x0)))
+ (if rotate
+ (let ((p0 (image--rotate-coord x0 y0 rotate size)))
+ (setq x0 (car p0) y0 (cdr p0))))
+ (if scale
+ (setq x0 (round (/ x0 scale)) y0 (round (/ y0 scale))
+ r (round (/ r scale))))
+ (push `((circle . ((,x0 . ,y0) . ,r)) ,id ,plist) omap))
+ ;; Poly hot spot.
+ (`(poly . ,coords)
+ (setq coords (copy-sequence coords))
+ (let ((i 0) (n (1- (length coords))))
+ (while (< i n)
+ (let* ((j (1+ i))
+ (x (aref coords i))
+ (y (aref coords j)))
+ (if flip
+ (setq x (- flip-w x)))
+ (if rotate
+ (let ((p (image--rotate-coord x y rotate size)))
+ (setq x (car p) y (cdr p))))
+ (if scale
+ (setq x (round (/ x scale))
+ y (round (/ y scale))))
+ (aset coords i x)
+ (aset coords j y))
+ (setq i (+ i 2))))
+ (push `((poly . ,coords) ,id ,plist) omap))
+ )))
+ omap)))
(defun image--rotate-coord (x y angle size)
"Rotate coordinates X and Y by ANGLE in image of SIZE.
@@ -1553,27 +1616,6 @@ image--rotate-coord
(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
next prev parent reply other threads:[~2024-03-27 11:16 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-03-25 1:00 bug#69992: Minor improvement to image map transformation logic Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-27 11:16 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2024-03-27 12:50 ` Eli Zaretskii
2024-03-27 14:21 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-27 22:17 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-27 23:53 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-28 22:22 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-29 10:19 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30 8:10 ` Eli Zaretskii
2024-03-30 8:55 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30 12:59 ` David Ponce via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30 13:37 ` Eli Zaretskii
2024-03-30 19:07 ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=55864577-3819-46e0-857a-cc0d0145bc2f@orange.fr \
--to=bug-gnu-emacs@gnu.org \
--cc=69992@debbugs.gnu.org \
--cc=da_vid@orange.fr \
/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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).