X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-svg.scm;h=a5a108a964aabad086292aafccffe97fe2ba30a6;hb=e18531db1f79fb685fbd16d6a2a67bf4b6c09915;hp=c916067bdfa38986141752fb193873d6af62e54f;hpb=c28a21a139c65643afed3eab7b329ca7380c131f;p=lilypond.git diff --git a/scm/output-svg.scm b/scm/output-svg.scm index c916067bdf..a5a108a964 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -1,17 +1,20 @@ -;;;; output-svg.scm -- implement Scheme output routines for SVG +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2002--2009 Jan Nieuwenhuizen +;;;; Copyright (C) 2002--2010 Jan Nieuwenhuizen ;;;; Patrick McCarty - -;;;; Recommendations: -;;;; http://www.w3.org/TR/SVG11/ -;;;; http://www.w3.org/TR/SVGTiny12/ -;;;; http://www.w3.org/TR/SVGPrint/ -- page, pageSet in draft - -;;;; TODO: -;;;; * inkscape page/pageSet support +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . (define-module (scm output-svg)) (define this-module (current-module)) @@ -31,14 +34,11 @@ (define (dispatch expr) (let ((keyword (car expr))) - (cond - ((eq? keyword 'some-func) "") - (else - (if (module-defined? this-module keyword) - (apply (eval keyword this-module) (cdr expr)) - (begin - (ly:warning (_ "undefined: ~S") keyword) - "")))))) + (cond ((eq? keyword 'some-func) "") + (else (if (module-defined? this-module keyword) + (apply (eval keyword this-module) (cdr expr)) + (begin (ly:warning (_ "undefined: ~S") keyword) + "")))))) ;; Helper functions (define-public (attributes attributes-alist) @@ -123,12 +123,9 @@ (define alist '()) (define (set-attribute attr val) (set! alist (assoc-set! alist attr val))) - (let* - ((match-1 (regexp-exec pango-description-regexp-comma str)) - (match-2 (regexp-exec pango-description-regexp-nocomma str)) - (match (if match-1 - match-1 - match-2))) + (let* ((match-1 (regexp-exec pango-description-regexp-comma str)) + (match-2 (regexp-exec pango-description-regexp-nocomma str)) + (match (if match-1 match-1 match-2))) (if (regexp-match? match) (begin @@ -200,12 +197,12 @@ ;; (define (glyph-element-regexp name) (make-regexp (string-append ""))) (define (extract-glyph all-glyphs name size . rest) @@ -316,13 +313,13 @@ (define (circle radius thick is-filled) (entity - 'circle "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(fill . ,(if is-filled "currentColor" "none")) - `(stroke . "currentColor") - `(stroke-width . ,thick) - `(r . ,radius))) + 'circle "" + '(stroke-linejoin . "round") + '(stroke-linecap . "round") + `(fill . ,(if is-filled "currentColor" "none")) + `(stroke . "currentColor") + `(stroke-width . ,thick) + `(r . ,radius))) (define (dashed-line thick on off dx dy phase) (draw-line thick 0 0 dx dy @@ -331,26 +328,26 @@ (define (draw-line thick x1 y1 x2 y2 . alist) (apply entity 'line "" (append - `((stroke-linejoin . "round") - (stroke-linecap . "round") - (stroke-width . ,thick) - (stroke . "currentColor") - (x1 . ,x1) - (y1 . ,(- y1)) - (x2 . ,x2) - (y2 . ,(- y2))) - alist))) + `((stroke-linejoin . "round") + (stroke-linecap . "round") + (stroke-width . ,thick) + (stroke . "currentColor") + (x1 . ,x1) + (y1 . ,(- y1)) + (x2 . ,x2) + (y2 . ,(- y2))) + alist))) (define (ellipse x-radius y-radius thick is-filled) (entity - 'ellipse "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(fill . ,(if is-filled "currentColor" "none")) - `(stroke . "currentColor") - `(stroke-width . ,thick) - `(rx . ,x-radius) - `(ry . ,y-radius))) + 'ellipse "" + '(stroke-linejoin . "round") + '(stroke-linecap . "round") + `(fill . ,(if is-filled "currentColor" "none")) + `(stroke . "currentColor") + `(stroke-width . ,thick) + `(rx . ,x-radius) + `(ry . ,y-radius))) (define (embedded-svg string) string) @@ -382,23 +379,23 @@ (define (oval x-radius y-radius thick is-filled) (let ((x-max x-radius) - (x-min (- x-radius)) - (y-max y-radius) - (y-min (- y-radius))) + (x-min (- x-radius)) + (y-max y-radius) + (y-min (- y-radius))) (entity - 'path "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(fill . ,(if is-filled "currentColor" "none")) - `(stroke . "currentColor") - `(stroke-width . ,thick) - `(d . ,(ly:format "M~4f ~4fC~4f ~4f ~4f ~4f ~4f ~4fS~4f ~4f ~4f ~4fz" - x-max 0 - x-max y-max - x-min y-max - x-min 0 - x-max y-min - x-max 0))))) + 'path "" + '(stroke-linejoin . "round") + '(stroke-linecap . "round") + `(fill . ,(if is-filled "currentColor" "none")) + `(stroke . "currentColor") + `(stroke-width . ,thick) + `(d . ,(ly:format "M~4f ~4fC~4f ~4f ~4f ~4f ~4f ~4fS~4f ~4f ~4f ~4fz" + x-max 0 + x-max y-max + x-min y-max + x-min 0 + x-max y-min + x-max 0))))) (define (path thick commands) (define (convert-path-exps exps) @@ -422,8 +419,7 @@ (closepath . z)) ""))) - (cons (format "~a~a" - svg-head (number-list->point args)) + (cons (format "~a~a" svg-head (number-list->point args)) (convert-path-exps (drop rest arity)))) '())) @@ -459,14 +455,14 @@ (define (polygon coords blot-diameter is-filled) (entity - 'polygon "" - '(stroke-linejoin . "round") - '(stroke-linecap . "round") - `(stroke-width . ,blot-diameter) - `(fill . ,(if is-filled "currentColor" "none")) - '(stroke . "currentColor") - `(points . ,(string-join - (map offset->point (ly:list->offsets '() coords)))))) + 'polygon "" + '(stroke-linejoin . "round") + '(stroke-linecap . "round") + `(stroke-width . ,blot-diameter) + `(fill . ,(if is-filled "currentColor" "none")) + '(stroke . "currentColor") + `(points . ,(string-join + (map offset->point (ly:list->offsets '() coords)))))) (define (repeat-slash width slope thickness) (define (euclidean-length x y) @@ -486,21 +482,22 @@ "\n") (define (round-filled-box breapth width depth height blot-diameter) - (entity 'rect "" - ;; The stroke will stick out. To use stroke, - ;; the stroke-width must be subtracted from all other dimensions. - ;;'(stroke-linejoin . "round") - ;;'(stroke-linecap . "round") - ;;`(stroke-width . ,blot) - ;;'(stroke . "red") - ;;'(fill . "orange") - - `(x . ,(- breapth)) - `(y . ,(- height)) - `(width . ,(+ breapth width)) - `(height . ,(+ depth height)) - `(ry . ,(/ blot-diameter 2)) - '(fill . "currentColor"))) + (entity + 'rect "" + ;; The stroke will stick out. To use stroke, + ;; the stroke-width must be subtracted from all other dimensions. + ;;'(stroke-linejoin . "round") + ;;'(stroke-linecap . "round") + ;;`(stroke-width . ,blot) + ;;'(stroke . "red") + ;;'(fill . "orange") + + `(x . ,(- breapth)) + `(y . ,(- height)) + `(width . ,(+ breapth width)) + `(height . ,(+ depth height)) + `(ry . ,(/ blot-diameter 2)) + '(fill . "currentColor"))) (define (setcolor r g b) (format "\n"