1 ;;;; framework-svg.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
7 (define-module (scm framework-svg))
9 (use-modules (guile) (lily) (scm output-svg))
10 (use-modules (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (ice-9 regex))
12 ;; FIXME: 0.62 to get paper size right
13 (define output-scale (* 0.62 scale-to-unit))
15 (define-public (output-framework outputter book scopes fields basename)
16 (let* ((paper (ly:paper-book-paper book))
17 (pages (ly:paper-book-pages book))
18 (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
19 (page-number (1- (ly:output-def-lookup paper 'firstpagenumber)))
20 (page-count (length pages))
21 (hsize (ly:output-def-lookup paper 'hsize))
22 (vsize (ly:output-def-lookup paper 'vsize))
23 (page-width (inexact->exact (ceiling (* output-scale hsize))))
24 (page-height (inexact->exact (ceiling (* output-scale vsize))))
25 (page-set? (> page-count 1)))
27 (ly:outputter-dump-string
30 '(xmlns . "http://www.w3.org/2000/svg")
32 `(width . ,(format #f "~smm" page-width))
33 `(height . ,(format #f "~smm" page-height))))
35 (ly:outputter-dump-string outputter (dump-fonts outputter paper))
36 (ly:outputter-dump-string
39 ;; FIXME: only use pages if there are more than one, pageSet is
40 ;; not supported by all SVG applications yet.
41 (if page-set? (eo 'pageSet) "")
46 (set! page-number (1+ page-number))
47 (dump-page outputter page page-number page-count landscape? page-set?))
50 (if page-set? (eo 'pageSet) "")
51 (ly:outputter-dump-string
55 (if page-set? (ec 'pageSet) "")
58 (define (dump-page outputter page page-number page-count landscape? page-set?)
60 (ly:outputter-dump-string
61 outputter (comment (format #f "Page: ~S/~S" page-number page-count)))
62 (if page-set? (ly:outputter-dump-string outputter (eo 'page)))
63 (ly:outputter-dump-string outputter (string-append (eo 'g)))
64 (ly:outputter-dump-stencil outputter page)
65 (ly:outputter-dump-string outputter (string-append (ec 'g)))
66 (if page-set? (ly:outputter-dump-string outputter (ec 'page))))
68 (define (embed-font string)
69 (let ((start (string-contains string "<defs>"))
70 (end (string-contains string "</defs>")))
71 (substring string (+ start 7) (- end 1))))
73 (define (dump-fonts outputter paper)
74 (let* ((fonts (ly:paper-fonts paper))
75 (font-names (uniq-list (sort (map ly:font-file-name fonts) string<?)))
78 (let ((file-name (ly:find-file (string-append x ".svg"))))
79 (if file-name (embed-font (ly:gulp-file file-name))
80 (begin (ly:warn "cannot find SVG font ~S" x) ""))))
81 (filter string? font-names))))
82 (entity 'defs (string-join svgs "\n"))))