[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"
Notes:
- 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)
(ly:error
"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)))
(reset-start)
(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))
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))))
((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))
pts)))
(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)))
(map-in-order
command-match-proc
(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
svg-path-string.cropped.png
Description: PNG image