;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2002--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2002--2006 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; http://www.w3.org/TR/SVG11
;;;; http://www.w3.org/TR/SVG12/ -- page, pageSet in draft
(guile)
(ice-9 regex)
(lily)
+ (srfi srfi-1)
(srfi srfi-13))
(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)))
(map (lambda (x) (char->entity x)) (string->list string))))
(define pango-description-regexp-comma
- (make-regexp "^([^,]+), ?([-a-zA-Z_]*) ([0-9.]+)$"))
+ (make-regexp "([^,]+), ?([-a-zA-Z_]*) ([0-9.]+)$"))
(define pango-description-regexp-nocomma
- (make-regexp "^([^ ]+) ([-a-zA-Z_]*) ?([0-9.]+)$"))
+ (make-regexp "([^ ]+) ([-a-zA-Z_]*) ?([0-9.]+)$"))
(define (pango-description-to-svg-font str)
(let*
(entity 'path ""
'(stroke-linejoin . "round")
'(stroke-linecap . "round")
- `(stroke-width . ,thick)
'(stroke . "currentColor")
'(fill . "currentColor")
+ `(stroke-width . ,thick)
`(d . ,(string-append (svg-bezier first #f)
(svg-bezier second first-c0)))
)))
+(define (path thick commands)
+ (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")
+ '(fill . "none")
+ `(d . ,(string-join (convert-path-exps commands) " "))))
+
(define (char font i)
(dispatch
`(fontify ,font ,(entity 'tspan (char->entity (integer->char i))))))
(y2 . ,(- y2)))
alist)))
-(define (dashed-line thick on off dx dy)
+(define (dashed-line thick on off dx dy phase)
(draw-line thick 0 0 dx dy `(style . ,(format "stroke-dasharray:~a,~a;" on off))))
(define (named-glyph font name)
(define (placebox x y expr)
(entity 'g
-
- ;; FIXME -- JCN
- ;;(dispatch expr)
expr
- `(transform . ,(format #f "translate (~f, ~f)"
+ ;; FIXME: Not using GNU coding standards [translate ()] here
+ ;; to work around a bug in Microsoft Internet Explorer 6.0
+ `(transform . ,(format #f "translate(~f, ~f)"
x (- y)))))
(define (polygon coords blot-diameter is-filled)
(map offset->point (ly:list->offsets '() coords))))
))
+;; rotate around given point
+(define (setrotation ang x y)
+ (format "<g transform=\"rotate(~a,~a,~a)\">"
+ (number->string (* -1 ang))
+ (number->string x)
+ (number->string (* -1 y))))
+
+(define (resetrotation ang x y)
+ "</g>")
+
(define (round-filled-box breapth width depth height blot-diameter)
(entity 'rect ""
;; The stroke will stick out. To use stroke,
(define (text font string)
(dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
-(define (utf8-string pango-font-description string)
+(define (utf-8-string pango-font-description string)
(dispatch `(fontify ,pango-font-description ,(entity 'tspan string))))