From 0a2461be9edb218bf9ca56156d8966a2421f13a7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 16 Jul 2019 15:44:58 +0200 Subject: [PATCH] Revert "Add support for paths to svg.el" This reverts commit d6bc55ae2dc98c83e58a28e380ce4bcf2ed00bb3. Paperwork not ready for Felix Klee; will reapply once that's in place. --- doc/lispref/display.texi | 237 --------------------------------------- lisp/svg.el | 148 ------------------------ 2 files changed, 385 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ecaf2e054e0..a38569f7263 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5587,9 +5587,6 @@ 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 @@ -5637,29 +5634,6 @@ 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}. @@ -5691,30 +5665,6 @@ 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 @@ -5737,193 +5687,6 @@ 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 2ab56d3960d..86b56a03d56 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Felix E. Klee ;; Keywords: image ;; Version: 1.0 ;; Package-Requires: ((emacs "25")) @@ -325,153 +324,6 @@ 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 -- 2.39.2