@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
@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}.
@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
@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
;; 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"))
"\\'")))))
(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
projects / emacs.git / commitdiff