From: Lars Ingebrigtsen Date: Wed, 31 Jul 2019 20:29:29 +0000 (+0200) Subject: Revert "Revert "Add support for paths to svg.el"" X-Git-Tag: emacs-27.0.90~1789 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5f78e81af0c2648391f26602189c565627e08218;p=emacs.git Revert "Revert "Add support for paths to svg.el"" This reverts commit 0a2461be9edb218bf9ca56156d8966a2421f13a7. Copyright paperwork is now in place, so the patch mistakenly applied can now be re-applied. --- diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 42f838bcdbf..7c27b3897b2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5608,6 +5608,9 @@ The identified of the shape. @item :gradient If given, this should be the identifier of a previously defined gradient object. + +@item :clip-path +Identifier of a clip path. @end table @defun svg-rectangle svg x y width height &rest args @@ -5655,6 +5658,29 @@ that describe the outer circumference of the polygon. @end lisp @end defun +@defun svg-path svg commands &rest args +Add the outline of a shape to @var{svg} according to @var{commands}, +see @ref{SVG Path Commands}. + +Coordinates by default are absolute. To use coordinates relative to +the last position, or -- initially -- to the origin, set the attribute +@var{:relative} to @code{t}. This attribute can be specified for the +function or for individual commands. If specified for the function, +then all commands use relative coordinates by default. To make an +individual command use absolute coordinates, set @var{:relative} to +@code{nil}. + +@lisp +(svg-path svg + '((moveto ((100 . 100))) + (lineto ((200 . 0) (0 . 200) (-200 . 0))) + (lineto ((100 . 100)) :relative nil)) + :stroke-color "blue" + :fill-color "lightblue" + :relative t) +@end lisp +@end defun + @defun svg-text svg text &rest args Add the specified @var{text} to @var{svg}. @@ -5686,6 +5712,30 @@ string containing the image data as raw bytes. @var{image-type} should be a @end lisp @end defun +@defun svg-clip-path svg &rest args +Add a clipping path to @var{svg}. If applied to a shape via the +@var{:clip-path} property, parts of that shape which lie outside of +the clipping path are not drawn. + +@lisp +(let ((clip-path (svg-clip-path svg :id "foo"))) + (svg-circle clip-path 200 200 175)) +(svg-rectangle svg 50 50 300 300 + :fill-color "red" + :clip-path "url(#foo)") +@end lisp +@end defun + +@defun svg-node svg tag &rest args +Add the custom node @var{tag} to @var{svg}. + +@lisp +(svg-node svg + 'rect + :width 300 :height 200 :x 50 :y 100 :fill-color "green") +@end lisp +@end defun + @defun svg-remove svg id Remove the element with identifier @code{id} from the @code{svg}. @end defun @@ -5708,6 +5758,193 @@ circle: @end lisp +@node SVG Path Commands +@subsubsection SVG Path Commands + +@deffn Command moveto points +Move the pen to the first point in @var{points}. Additional points +are connected with lines. @var{points} is a list of X/Y coordinate +pairs. Subsequent @command{moveto} commands represent the start of a +new @dfn{subpath}. + +@lisp +(svg-path svg '((moveto ((200 . 100) (100 . 200) (0 . 100)))) + :fill "white" :stroke "black") +@end lisp +@end deffn + +@deffn Command closepath +End the current subpath by connecting it back to its initial point. A +line is drawn along the connection. + +@lisp +(svg-path svg '((moveto ((200 . 100) (100 . 200) (0 . 100))) + (closepath) + (moveto ((75 . 125) (100 . 150) (125 . 125))) + (closepath)) + :fill "red" :stroke "black") +@end lisp +@end deffn + +@deffn Command lineto points +Draw a line from the current point to the first element in +@var{points}, a list of X/Y position pairs. If more than one point is +specified, draw a polyline. +@lisp +(svg-path svg '((moveto ((200 . 100))) + (lineto ((100 . 200) (0 . 100)))) + :fill "yellow" :stroke "red") +@end lisp +@end deffn + +@deffn Command horizontal-lineto x-coordinates +Draw a horizontal line from the current point to the first element in +@var{x-coordinates}. Specifying multiple coordinates is possible, +although usually this doesn’t make sense. + +@lisp +(svg-path svg '((moveto ((100 . 200))) + (horizontal-lineto (300))) + :stroke "green") +@end lisp +@end deffn + +@deffn Command vertical-lineto y-coordinates +Draw vertical lines. + +@lisp +(svg-path svg '((moveto ((200 . 100))) + (vertical-lineto (300))) + :stroke "green") +@end lisp +@end deffn + +@deffn Command curveto coordinate-sets +Using the first element in @var{coordinate-sets}, draw a cubic Bézier +curve from the current point. If there are multiple coordinate sets, +draw a polybézier. Each coordinate set is a list of the form +@code{(@var{x1} @var{y1} @var{x2} @var{y2} @var{x} @var{y})}, where +@w{(@var{x}, @var{y})} is the curve’s end point. @w{(@var{x1}, +@var{y1})} and @w{(@var{x2}, @var{y2})} are control points at the +beginning and at the end, respectively. + +@lisp +(svg-path svg '((moveto ((100 . 100))) + (curveto ((200 100 100 200 200 200) + (300 200 0 100 100 100)))) + :fill "transparent" :stroke "red") +@end lisp +@end deffn + +@deffn Command smooth-curveto coordinate-sets +Using the first element in @var{coordinate-sets}, draw a cubic Bézier +curve from the current point. If there are multiple coordinate sets, +draw a polybézier. Each coordinate set is a list of the form +@code{(@var{x2} @var{y2} @var{x} @var{y})}, where @w{(@var{x}, +@var{y})} is the curve’s end point and @w{(@var{x2}, @var{y2})} is the +corresponding control point. The first control point is the +reflection of the second control point of the previous command +relative to the current point, if that command was @command{curveto} +or @command{smooth-curveto}. Otherwise the first control point +coincides with the current point. + +@lisp +(svg-path svg '((moveto ((100 . 100))) + (curveto ((200 100 100 200 200 200))) + (smooth-curveto ((0 100 100 100)))) + :fill "transparent" :stroke "blue") +@end lisp +@end deffn + +@deffn Command quadratic-bezier-curveto coordinate-sets +Using the first element in @var{coordinate-sets}, draw a quadratic +Bézier curve from the current point. If there are multiple coordinate +sets, draw a polybézier. Each coordinate set is a list of the form +@code{(@var{x1} @var{y1} @var{x} @var{y})}, where @w{(@var{x}, +@var{y})} is the curve’s end point and @w{(@var{x1}, @var{y1})} is the +control point. + +@lisp +(svg-path svg '((moveto ((200 . 100))) + (quadratic-bezier-curveto ((300 100 300 200))) + (quadratic-bezier-curveto ((300 300 200 300))) + (quadratic-bezier-curveto ((100 300 100 200))) + (quadratic-bezier-curveto ((100 100 200 100)))) + :fill "transparent" :stroke "pink") +@end lisp +@end deffn + +@deffn Command smooth-quadratic-bezier-curveto coordinate-sets +Using the first element in @var{coordinate-sets}, draw a quadratic +Bézier curve from the current point. If there are multiple coordinate +sets, draw a polybézier. Each coordinate set is a list of the form +@code{(@var{x} @var{y})}, where @w{(@var{x}, @var{y})} is the curve’s +end point. The control point is the reflection of the control point +of the previous command relative to the current point, if that command +was @command{quadratic-bezier-curveto} or +@command{smooth-quadratic-bezier-curveto}. Otherwise the control +point coincides with the current point. + +@lisp +(svg-path svg '((moveto ((200 . 100))) + (quadratic-bezier-curveto ((300 100 300 200))) + (smooth-quadratic-bezier-curveto ((200 300))) + (smooth-quadratic-bezier-curveto ((100 200))) + (smooth-quadratic-bezier-curveto ((200 100)))) + :fill "transparent" :stroke "lightblue") +@end lisp +@end deffn + +@deffn Command elliptical-arc coordinate-sets +Using the first element in @var{coordinate-sets}, draw an elliptical +arc from the current point. If there are multiple coordinate sets, +draw a sequence of elliptical arcs. Each coordinate set is a list of +the form @code{(@var{rx} @var{ry} @var{x} @var{y})}, where +@w{(@var{x}, @var{y})} is the end point of the ellipse, and +@w{(@var{rx}, @var{ry})} are its radii. Attributes may be appended to +the list: + +@table @code +@item :x-axis-rotation +The angle in degrees by which the x-axis of the ellipse is rotated +relative to the x-axis of the current coordinate system. + +@item :large-arc +If set to @code{t}, draw an arc sweep greater than or equal to 180 +degrees. Otherwise, draw an arc sweep smaller than or equal to 180 +degrees. + +@item :sweep +If set to @code{t}, draw an arc in @dfn{positive angle direction}. +Otherwise, draw it in @dfn{negative angle direction}. +@end table + +@lisp +(svg-path svg '((moveto ((200 . 250))) + (elliptical-arc ((75 75 200 350)))) + :fill "transparent" :stroke "red") +(svg-path svg '((moveto ((200 . 250))) + (elliptical-arc ((75 75 200 350 :large-arc t)))) + :fill "transparent" :stroke "green") +(svg-path svg '((moveto ((200 . 250))) + (elliptical-arc ((75 75 200 350 :sweep t)))) + :fill "transparent" :stroke "blue") +(svg-path svg '((moveto ((200 . 250))) + (elliptical-arc ((75 75 200 350 :large-arc t + :sweep t)))) + :fill "transparent" :stroke "gray") +(svg-path svg '((moveto ((160 . 100))) + (elliptical-arc ((40 100 80 0))) + (elliptical-arc ((40 100 -40 -70 + :x-axis-rotation -120))) + (elliptical-arc ((40 100 -40 70 + :x-axis-rotation -240)))) + :stroke "pink" :fill "lightblue" + :relative t) +@end lisp +@end deffn + + @node Other Image Types @subsection Other Image Types @cindex PBM diff --git a/lisp/svg.el b/lisp/svg.el index 86b56a03d56..2ab56d3960d 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Felix E. Klee ;; Keywords: image ;; Version: 1.0 ;; Package-Requires: ((emacs "25")) @@ -324,6 +325,153 @@ If the SVG is later changed, the image will also be updated." "\\'"))))) (when node (dom-remove-node svg node)))) +;; Function body copied from `org-plist-delete' in Emacs 26.1. +(defun svg--plist-delete (plist property) + "Delete PROPERTY from PLIST. +This is in contrast to merely setting it to 0." + (let (p) + (while plist + (if (not (eq property (car plist))) + (setq p (plist-put p (car plist) (nth 1 plist)))) + (setq plist (cddr plist))) + p)) + +(defun svg--path-command-symbol (command-symbol command-args) + (let ((char (symbol-name command-symbol)) + (relative (if (plist-member command-args :relative) + (plist-get command-args :relative) + (plist-get command-args :default-relative)))) + (intern (if relative (downcase char) (upcase char))))) + +(defun svg--elliptical-arc-coordinates + (rx ry x y &rest args) + (list + rx ry + (or (plist-get args :x-axis-rotation) 0) + (if (plist-get args :large-arc) 1 0) + (if (plist-get args :sweep) 1 0) + x y)) + +(defun svg--elliptical-arc-command (coordinates-list &rest args) + (cons + (svg--path-command-symbol 'a args) + (apply 'append + (mapcar + (lambda (coordinates) + (apply 'svg--elliptical-arc-coordinates + coordinates)) + coordinates-list)))) + +(defun svg--moveto-command (coordinates-list &rest args) + (cons + (svg--path-command-symbol 'm args) + (apply 'append + (mapcar + (lambda (coordinates) + (list (car coordinates) (cdr coordinates))) + coordinates-list)))) + +(defun svg--closepath-command (&rest args) + (list (svg--path-command-symbol 'z args))) + +(defun svg--lineto-command (coordinates-list &rest args) + (cons + (svg--path-command-symbol 'l args) + (apply 'append + (mapcar + (lambda (coordinates) + (list (car coordinates) (cdr coordinates))) + coordinates-list)))) + +(defun svg--horizontal-lineto-command (coordinate-list &rest args) + (cons + (svg--path-command-symbol 'h args) + coordinate-list)) + +(defun svg--vertical-lineto-command (coordinate-list &rest args) + (cons + (svg--path-command-symbol 'v args) + coordinate-list)) + +(defun svg--curveto-command (coordinates-list &rest args) + (cons + (svg--path-command-symbol 'c args) + (apply 'append coordinates-list))) + +(defun svg--smooth-curveto-command (coordinates-list &rest args) + (cons + (svg--path-command-symbol 's args) + (apply 'append coordinates-list))) + +(defun svg--quadratic-bezier-curveto-command (coordinates-list + &rest args) + (cons + (svg--path-command-symbol 'q args) + (apply 'append coordinates-list))) + +(defun svg--smooth-quadratic-bezier-curveto-command (coordinates-list + &rest args) + (cons + (svg--path-command-symbol 't args) + (apply 'append coordinates-list))) + +(defun svg--eval-path-command (command default-relative) + (cl-letf + (((symbol-function 'moveto) #'svg--moveto-command) + ((symbol-function 'closepath) #'svg--closepath-command) + ((symbol-function 'lineto) #'svg--lineto-command) + ((symbol-function 'horizontal-lineto) + #'svg--horizontal-lineto-command) + ((symbol-function 'vertical-lineto) + #'svg--vertical-lineto-command) + ((symbol-function 'curveto) #'svg--curveto-command) + ((symbol-function 'smooth-curveto) + #'svg--smooth-curveto-command) + ((symbol-function 'quadratic-bezier-curveto) + #'svg--quadratic-bezier-curveto-command) + ((symbol-function 'smooth-quadratic-bezier-curveto) + #'svg--smooth-quadratic-bezier-curveto-command) + ((symbol-function 'elliptical-arc) + #'svg--elliptical-arc-command) + (extended-command (append command (list :default-relative + default-relative)))) + (mapconcat 'prin1-to-string (apply extended-command) " "))) + +(defun svg-path (svg commands &rest args) + "Add the outline of a shape to SVG according to COMMANDS. +Coordinates by default are absolute. ARGS is a plist of +modifiers. If :relative is t, then coordinates are relative to +the last position, or -- initially -- to the origin." + (let* ((default-relative (plist-get args :relative)) + (stripped-args (svg--plist-delete args :relative)) + (d (mapconcat 'identity + (mapcar + (lambda (command) + (svg--eval-path-command command + default-relative)) + commands) " "))) + (svg--append + svg + (dom-node 'path + `((d . ,d) + ,@(svg--arguments svg stripped-args)))))) + +(defun svg-clip-path (svg &rest args) + "Add a clipping path to SVG, where ARGS is a plist of modifiers. +If applied to a shape via the :clip-path property, parts of that +shape which lie outside of the clipping path are not drawn." + (let ((new-dom-node (dom-node 'clipPath + `(,@(svg--arguments svg args))))) + (svg--append svg new-dom-node) + new-dom-node)) + +(defun svg-node (svg tag &rest args) + "Add the custom node TAG to SVG." + (let ((new-dom-node (dom-node tag + `(,@(svg--arguments svg args))))) + (svg--append svg new-dom-node) + new-dom-node)) + (provide 'svg) ;;; svg.el ends here