* scm/output-svg.scm (path): support for path primitive.
2006-07-19 Han-Wen Nienhuys <hanwen@lilypond.org>
2006-07-19 Han-Wen Nienhuys <hanwen@lilypond.org>
+ * scm/output-lib.scm (fall::print): use new order.
+
+ * scm/output-ps.scm (path): reorder arguments.
+
+ * scm/output-svg.scm (path): support for path primitive.
+
* input/regression/bend-after.ly: new file.
* Documentation/user/GNUmakefile ($(outdir)/%.pdf): foolproof
* input/regression/bend-after.ly: new file.
* Documentation/user/GNUmakefile ($(outdir)/%.pdf): foolproof
(define (path thickness exps)
(define (path thickness exps)
- (define (path-exps->ps-path-exps exps)
+ (define (convert-path-exps exps)
(if (pair? exps)
(let*
((head (car exps))
(if (pair? exps)
(let*
((head (car exps))
(cons (format "~a ~a "
(string-join (map (lambda (x) (format "~a " x)) args) " ")
head)
(cons (format "~a ~a "
(string-join (map (lambda (x) (format "~a " x)) args) " ")
head)
- (path-exps->ps-path-exps (drop rest arity))))
+ (convert-path-exps (drop rest arity))))
'()))
(format
"1 setlinecap ~a setlinewidth\n~a stroke"
thickness
'()))
(format
"1 setlinecap ~a setlinewidth\n~a stroke"
thickness
- (string-join (path-exps->ps-path-exps exps) " ")))
+ (string-join (convert-path-exps exps) " ")))
(guile)
(ice-9 regex)
(lily)
(guile)
(ice-9 regex)
(lily)
(define (offset->point o)
(format #f " ~S,~S" (car o) (- (cdr o))))
(define (offset->point o)
(format #f " ~S,~S" (car o) (- (cdr o))))
+(define (number-list->point lst)
+ (define (helper lst)
+ (if (null? lst)
+ '()
+ (cons (format "~S,~S" (car lst) (cadr lst))
+ (helper (cddr lst)))))
+
+ (string-join (helper lst) " "))
+
+
(define (svg-bezier lst close)
(let* ((c0 (car (list-tail lst 3)))
(c123 (list-head lst 3)))
(define (svg-bezier lst close)
(let* ((c0 (car (list-tail lst 3)))
(c123 (list-head lst 3)))
)))
(define (path thick commands)
)))
(define (path thick commands)
- (define (ps-path-entries->svg-path entries)
-
+ (define (convert-path-exps exps)
+ (if (pair? exps)
+ (let*
+ ((head (car exps))
+ (rest (cdr exps))
+ (arity
+ (cond
+ ((memq head '(rmoveto rlineto lineto moveto)) 2)
+ ((memq head '(rcurveto curveto)) 6)
+ (else 1)))
+ (args (take rest arity))
+ (svg-head (assoc-get head '((rmoveto . m)
+ (rcurveto . c)
+ (curveto . C)
+ (moveto . M)
+ (lineto . L)
+ (rlineto . l))
+ ""))
+ )
+
+ (cons (format "~a~a "
+ svg-head (number-list->point args)
+ )
+ (convert-path-exps (drop rest arity))))
+ '()))
(entity 'path ""
`(stroke-width . ,thick)
'(stroke-linejoin . "round")
'(stroke-linecap . "round")
'(stroke . "currentColor")
(entity 'path ""
`(stroke-width . ,thick)
'(stroke-linejoin . "round")
'(stroke-linecap . "round")
'(stroke . "currentColor")
- '(fill . "currentColor")
-
+ '(fill . "none")
+ `(d . ,(string-join (convert-path-exps commands) " "))))
(define (char font i)
(dispatch
`(fontify ,font ,(entity 'tspan (char->entity (integer->char i))))))
(define (char font i)
(dispatch
`(fontify ,font ,(entity 'tspan (char->entity (integer->char i))))))