1 ;;;; framework-svg.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2005 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 basename book scopes fields)
16 (let* ((filename (format "~a.svg" basename))
17 (outputter (ly:make-paper-outputter filename
19 (paper (ly:paper-book-paper book))
20 (pages (ly:paper-book-pages book))
21 (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
22 (page-number (1- (ly:output-def-lookup paper 'firstpagenumber)))
23 (page-count (length pages))
24 (hsize (ly:output-def-lookup paper 'hsize))
25 (vsize (ly:output-def-lookup paper 'vsize))
26 (page-width (inexact->exact (ceiling (* output-scale hsize))))
27 (page-height (inexact->exact (ceiling (* output-scale vsize))))
28 (page-set? (or (> page-count 1) landscape?)))
30 (ly:outputter-dump-string
33 '(xmlns . "http://www.w3.org/2000/svg")
35 `(width . ,(format #f "~smm" page-width))
36 `(height . ,(format #f "~smm" page-height))))
38 (ly:outputter-dump-string outputter (dump-fonts outputter paper))
39 (ly:outputter-dump-string
42 ;; FIXME: only use pages if there are more than one, pageSet is
43 ;; not supported by all SVG applications yet.
44 (if page-set? (eo 'pageSet) "")
49 (set! page-number (1+ page-number))
50 (dump-page outputter page page-number page-count landscape? page-set?))
53 (if page-set? (eo 'pageSet) "")
54 (ly:outputter-dump-string
58 (if page-set? (ec 'pageSet) "")
61 (define (dump-page outputter page page-number page-count landscape? page-set?)
62 (ly:outputter-dump-string
63 outputter (comment (format #f "Page: ~S/~S" page-number page-count)))
64 (if (or landscape? page-set?)
65 (ly:outputter-dump-string
67 (if landscape? (eo 'page '(page-orientation . "270")) (eo 'page))))
68 (ly:outputter-dump-string outputter (string-append (eo 'g)))
69 (ly:outputter-dump-stencil outputter page)
70 (ly:outputter-dump-string outputter (string-append (ec 'g)))
71 (if (or landscape? page-set?)
72 (ly:outputter-dump-string outputter (ec 'page))))
74 (define (embed-font string)
75 (let ((start (string-contains string "<defs>"))
76 (end (string-contains string "</defs>")))
77 (substring string (+ start 7) (- end 1))))
79 (define (dump-fonts outputter paper)
80 (let* ((fonts (ly:paper-fonts paper))
81 (font-names (uniq-list (sort
83 (map ly:font-file-name fonts)) string<?)))
86 (let ((file-name (ly:find-file (string-append x ".svg"))))
87 (if file-name (embed-font (cached-file-contents file-name))
88 (begin (ly:warn "cannot find SVG font ~S" x) ""))))
89 (filter string? font-names))))
90 (entity 'defs (string-join svgs "\n"))))