X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-svg.scm;h=9b74aef9fe1cd32f03fd288e90eb12be7517077d;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=259fde045f6c5b12adc59fecd634bb5d5478093b;hpb=13c22c4ce1b3ba54b1d0ff0f49cf2e246151d1ba;p=lilypond.git diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm index 259fde045f..9b74aef9fe 100644 --- a/scm/framework-svg.scm +++ b/scm/framework-svg.scm @@ -1,72 +1,94 @@ -;;;; framework-svg.scm -- +;; +;; framework-svg.scm -- structure for SVG output ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004 Jan Nieuwenhuizen +;;;; (c) 2004--2008 Jan Nieuwenhuizen (define-module (scm framework-svg)) -(use-modules (guile) (lily) (scm output-svg)) -(use-modules (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (ice-9 regex)) +(use-modules (guile) + (lily) + (scm page) + (scm output-svg)) -;; FIXME: 0.62 to get paper size right -(define output-scale (* 0.62 scale-to-unit)) +(use-modules (srfi srfi-1) + (srfi srfi-2) + (srfi srfi-13) + (ice-9 regex)) -(define-public (output-framework outputter book scopes fields basename) - (let* ((paper (ly:paper-book-paper book)) - (pages (ly:paper-book-pages book)) +(define format ergonomic-simple-format) + +(define-public (output-framework basename book scopes fields) + (let* ((filename (format "~a.svg" basename)) + (outputter (ly:make-paper-outputter (open-file filename "wb") + (ly:get-option 'backend))) + (dump (lambda (str) (display str (ly:outputter-port outputter)))) + (paper (ly:paper-book-paper book)) + (unit-length (ly:output-def-lookup paper 'output-scale)) + (output-scale (* lily-unit->mm-factor + unit-length)) + (page-stencils (map page-stencil (ly:paper-book-pages book))) (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)) - (page-number (1- (ly:output-def-lookup paper 'firstpagenumber))) - (page-count (length pages)) - (hsize (ly:output-def-lookup paper 'hsize)) - (vsize (ly:output-def-lookup paper 'vsize)) - (page-width (inexact->exact (ceiling (* output-scale hsize)))) - (page-height (inexact->exact (ceiling (* output-scale vsize)))) + (page-number (1- (ly:output-def-lookup paper 'first-page-number))) + (page-count (length page-stencils)) + (paper-width (ly:output-def-lookup paper 'paper-width)) + (paper-height (ly:output-def-lookup paper 'paper-height)) + (page-width (inexact->exact (ceiling (* output-scale paper-width)))) + (page-height (inexact->exact (ceiling (* output-scale paper-height)))) (page-set? (or (> page-count 1) landscape?))) + + (ly:outputter-output-scheme outputter + `(begin (set! lily-unit-length ,unit-length) "")) + (dump (eo 'svg + '(xmlns . "http://www.w3.org/2000/svg") + '(xmlns:xlink . "http://www.w3.org/1999/xlink") + '(version . "1.2") + + ;; Argggghhhh: SVG takes the px <-> mm mapping from the windowing system + `(width . ,(format "~s" page-width)) + `(height . ,(format "~s" page-height)))) - (ly:outputter-dump-string - outputter - (eo 'svg - '(xmlns . "http://www.w3.org/2000/svg") - '(version . "1.2") - `(width . ,(format #f "~smm" page-width)) - `(height . ,(format #f "~smm" page-height)))) - - (ly:outputter-dump-string outputter (dump-fonts outputter paper)) - (ly:outputter-dump-string - outputter - (string-append - ;; FIXME: only use pages if there are more than one, pageSet is - ;; not supported by all SVG applications yet. - (if page-set? (eo 'pageSet) "") - (eo 'g))) - - (for-each - (lambda (page) - (set! page-number (1+ page-number)) - (dump-page outputter page page-number page-count landscape? page-set?)) - pages) - - (if page-set? (eo 'pageSet) "") - (ly:outputter-dump-string - outputter - (string-append - (ec 'g) - (if page-set? (ec 'pageSet) "") - (ec 'svg))))) + (dump (dump-fonts outputter paper)) + (dump + (string-append + ;; FIXME: only use pages if there are more than one, pageSet is + ;; not supported by all SVG applications yet. + (if page-set? (eo 'pageSet) "") + (eo 'g `(transform . ,(format "scale(~a, ~a) " + output-scale output-scale))))) + + (for-each + (lambda (page) + (set! page-number (1+ page-number)) + (dump-page outputter page page-number page-count landscape? page-set?)) + page-stencils) + + (if page-set? (eo 'pageSet) "") + (dump + (string-append + (ec 'g) + (if page-set? (ec 'pageSet) "") + (ec 'svg))) + + (ly:outputter-close outputter) + )) (define (dump-page outputter page page-number page-count landscape? page-set?) - (ly:outputter-dump-string - outputter (comment (format #f "Page: ~S/~S" page-number page-count))) + (define (dump str) (display str (ly:outputter-port outputter))) + + (dump (comment (format "Page: ~S/~S" page-number page-count))) (if (or landscape? page-set?) - (ly:outputter-dump-string - outputter - (if landscape? (eo 'page '(page-orientation . "270")) (eo 'page)))) - (ly:outputter-dump-string outputter (string-append (eo 'g))) + (dump + (if landscape? + (eo 'page '(page-orientation . "270")) + (eo 'page)))) + + (dump (string-append (eo 'g ))) (ly:outputter-dump-stencil outputter page) - (ly:outputter-dump-string outputter (string-append (ec 'g))) + (dump (string-append (ec 'g))) (if (or landscape? page-set?) - (ly:outputter-dump-string outputter (ec 'page)))) + (dump (ec 'page)))) (define (embed-font string) (let ((start (string-contains string "")) @@ -75,12 +97,14 @@ (define (dump-fonts outputter paper) (let* ((fonts (ly:paper-fonts paper)) - (font-names (uniq-list (sort (map ly:font-file-name fonts) string