mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Revert "Revert "Add support for paths to svg.el""

Browse Source 
This reverts commit 0a2461be9e.

Copyright paperwork is now in place, so the patch mistakenly applied
can now be re-applied.
This commit is contained in:
Lars Ingebrigtsen 2019-07-31 22:29:29 +02:00
parent ee7baca4fa
commit 5f78e81af0
2 changed files with 385 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

237
doc/lispref/display.texi
View File

@ -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

148
lisp/svg.el
View File

@ -3,6 +3,7 @@
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Felix E. Klee <felix.klee@inka.de>
;; 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