[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: SVG in \markup Block?

From: Aaron Hill
Subject: Re: SVG in \markup Block?
Date: Mon, 20 Jan 2020 02:23:51 -0800
User-agent: Roundcube Webmail/1.3.8

Took some time to refactor things and add functionality. I believe I have managed to support all SVG path commands, except for elliptic arcs (A/a).

This utility function is intended to be used with \path in the following manner:

  \markup \path #0.1 \svgPath "M1,2 L-3,4"


- I opted against having the utility function invert the Y coordinates. If you paste a path description from a real SVG file, it will appear upside-down. You can easily \scale #'(1 . -1) to fix that, as shown in the test code at the bottom of the snippet.

- Since LilyPond does not natively support certain path commands, several are being emulated with the ones that do exist. While the visual result will match, the actual SVG output will not. Commands like H/h and V/v are converted into L/l. The tangent-preserving S/s as well as the pseudo-quadratics Q/q and T/t are all converted to C/c.

- Though the snippet below lists version 2.19, this code appears to work fine in 2.18 after adding parser and location to the two scheme functions. As such, this probably could be submitting to the LSR, which I understand has to stay on stable for the time-being.

\version "2.19.83"

#(use-modules (ice-9 regex))

svgPath = #(define-scheme-function
  (str) (string?)
  "Converts an SVG-style command list @var{str} to
the format supported by the @code{\\path} markup command."

  ;; Regular expressions for matching strings that
  ;; resemble SVG-style path commands and numbers.
  (define command-regex (make-regexp "([A-Za-z])([ ,.0-9+-]*)"))
  (define number-regex (make-regexp "[+-]?[0-9]+([.][0-9]+)?"))

  ;; Variables to keep track of path details
  ;; to help with emulating SVG commands.
  (define start-point '())
  (define current-point '(0 . 0))
  (define (set-point pt)
    (if (null? start-point) (set! start-point pt))
    (set! current-point pt))
  (define (back-to-start)
    (set! current-point
      (if (null? start-point) '(0 . 0) start-point)))
  (define (reset-start) (set! start-point '()))
  (define (relative-point pt)
    (cons (+ (car current-point) (car pt))
          (+ (cdr current-point) (cdr pt))))
  (define tangent-vector '())
  (define (set-tangent ctlpt endpt)
    (set! tangent-vector
      (cons (- (car endpt) (car ctlpt))
            (- (cdr endpt) (cdr ctlpt)))))
  (define (reset-tangent) (set! tangent-vector '()))
  (define (apply-tangent pt)
    (if (null? tangent-vector) pt
      (cons (+ (car pt) (car tangent-vector))
            (+ (cdr pt) (cdr tangent-vector)))))

  ;; Primary logic for processing each command.
  (define (handle-command sym args)
    (define (take-args len)
      (if (<= len (length args))
        (take args len)
          "SVG command ~a expects ~a arguments, only ~a provided"
          sym len (length args))))
    (define (coords->points coords)
      (cond ((null? coords) '())
            ((null? (cdr coords))
              (ly:error "Expecting an even number of coordinates."))
            (else (cons
              (cons (first coords) (second coords))
              (coords->points (drop coords 2))))))
    (define (point->coords pt) (list (car pt) (cdr pt)))
    (define (points->coords pts) (apply append (map point->coords pts)))
    (define (take-point) (first (coords->points (take-args 2))))
(define (take-points count) (coords->points (take-args (* count 2))))
    (let ((rel? (memq sym '(m l h v c s q t))))
      (case sym
        ((M m)
           (let ((pt (take-point)))
             (set-point (if rel? (relative-point pt) pt))
             (cons (if rel? 'rmoveto 'moveto) (point->coords pt))))
        ((L l)
           (let ((pt (take-point)))
             (set-point (if rel? (relative-point pt) pt))
             (cons (if rel? 'rlineto 'lineto) (point->coords pt))))
        ((H h V v)
          (let* ((horiz? (memq sym '(H h)))
                 (coord (first (take-args 1)))
                 (pt (if horiz?
                       (cons coord (if rel? 0 (cdr current-point)))
                       (cons (if rel? 0 (car current-point)) coord))))
            (set-point (if rel? (relative-point pt) pt))
            (cons (if rel? 'rlineto 'lineto) (point->coords pt))))
        ((C c S s)
          (let* ((tangent? (memq sym '(S s)))
                 (pts (take-points (if tangent? 2 3))))
            (if tangent? (set! pts
(cons (if rel? tangent-vector (apply-tangent current-point))
            (apply set-tangent (take-right pts 2))
            (set-point (if rel? (relative-point (last pts)) (last pts)))
            (cons (if rel? 'rcurveto 'curveto) (points->coords pts))))
        ((Q q T t)
          (let* ((tangent? (memq sym '(T t)))
                 (pts (take-points (if tangent? 1 2))))
            (if tangent? (set! pts
(cons (if rel? tangent-vector (apply-tangent current-point))
            (set! pts (cons (first pts) pts))
            (apply set-tangent (take-right pts 2))
            (set-point (if rel? (relative-point (last pts)) (last pts)))
            (cons (if rel? 'rcurveto 'curveto) (points->coords pts))))
        ((Z z) (back-to-start) '(closepath))
        (else (ly:error "Unhandled SVG command ~a" sym)))))

  ;; Driver logic for parsing.
  (define (command-match-proc m)
    (let ((sym (string->symbol (match:substring m 1)))
          (args (map (lambda (n) (string->number (match:substring n)))
(list-matches number-regex (match:substring m 2)))))
      (handle-command sym args)))
    (list-matches command-regex str)))

%% Test code
testSvgPath = #(define-scheme-function (str) (string?) #{
  \markup \left-column {
    \line { \bold Input: \wordwrap-string #str }
    \line { \bold Output:
            \wordwrap-string #(format #f "~a" #{ \svgPath #str #}) }
\line { \hspace #2 \vcenter \scale #'(1 . -1) \path #0.4 \svgPath #str }
    \vspace #0.5
  } #})

\paper { line-width = 8\cm }
\testSvgPath "M1 2 L-3 5 H-1 V2 Z"
\testSvgPath "M0,0v1m1,-1v2m1,-2v3"
\testSvgPath "M -1,5 C 0,4 2,1 0,1 S 0,4 1,5"
\testSvgPath "M 2,3 q 0,3 3,0 m -2,0.5 l 2,-0.5 l -0.5,2 z"

-- Aaron Hill

Attachment: svg-path-string.cropped.png
Description: PNG image

reply via email to

[Prev in Thread] Current Thread [Next in Thread]