From: Han-Wen Nienhuys Date: Fri, 11 Mar 2005 01:46:57 +0000 (+0000) Subject: * scm/framework-svg.scm (output-framework): put scaling in X-Git-Tag: release/2.5.15~4 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=5265f59b4ee56d8c11a431791c9e2d02b428e0f7;p=lilypond.git * scm/framework-svg.scm (output-framework): put scaling in document header. Apply scaling only once. * scm/lily-library.scm (modified-font-metric-font-scaling): rename from font-size. * lily/paper-outputter-scheme.cc (LY_DEFINE): ly:outputter-output-scheme, new function. * scm/output-svg.scm (pango-description-to-svg-font): new function --- diff --git a/ChangeLog b/ChangeLog index fca6805dcc..dc49baf0ad 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2005-03-11 Han-Wen Nienhuys + + * scm/framework-svg.scm (output-framework): put scaling in + document header. Apply scaling only once. + + * scm/lily-library.scm (modified-font-metric-font-scaling): rename + from font-size. + + * lily/paper-outputter-scheme.cc (LY_DEFINE): + ly:outputter-output-scheme, new function. + + * scm/output-svg.scm (pango-description-to-svg-font): new function + 2005-03-10 Han-Wen Nienhuys * Documentation/user/GNUmakefile (deep-symlinks): remove outimages diff --git a/input/typography-demo.ly b/input/typography-demo.ly index 7738b7d078..1ac8e069f8 100644 --- a/input/typography-demo.ly +++ b/input/typography-demo.ly @@ -96,7 +96,7 @@ pianoRH = \relative c''' \repeat volta 2\new Voice { pianoLH = \relative c'' \repeat volta 2\new Voice { #(set-accidental-style 'modern) \voiceTwo - g16(_\p fis a g fis g + g16( fis a g fis g f e d c b diff --git a/lily/beam.cc b/lily/beam.cc index dbe22733de..9eac207bb4 100644 --- a/lily/beam.cc +++ b/lily/beam.cc @@ -176,9 +176,9 @@ Beam::before_line_breaking (SCM smob) We want a maximal number of shared beams, but if there is choice, we take the one that is closest to the end of the stem. This is for situations like - x - | - | + x + | + | |===| |= | @@ -585,6 +585,13 @@ Beam::set_stem_directions (Grob *me, Direction d) anything else is possible here, since we don't know funky-beaming settings, or X-distances (slopes!) People that want sloped knee-beams, should set the directions manually. + + + TODO: + + this routine should take into account the stemlength scoring + of a possible knee/nonknee beam. + */ void Beam::consider_auto_knees (Grob *me) @@ -603,36 +610,36 @@ Beam::consider_auto_knees (Grob *me) Grob *common = common_refpoint_of_array (stems, me, Y_AXIS); Real staff_space = Staff_symbol_referencer::staff_space (me); - Array head_positions_array; + Array head_extents_array; for (int i = 0; i < stems.size (); i++) { Grob *stem = stems[i]; if (Stem::is_invisible (stem)) continue; - Interval head_positions = Stem::head_positions (stem); - if (!head_positions.is_empty ()) + Interval head_extents = Stem::head_positions (stem); + if (!head_extents.is_empty ()) { - head_positions[LEFT] += -1; - head_positions[RIGHT] += 1; - head_positions *= staff_space * 0.5; + head_extents[LEFT] += -1; + head_extents[RIGHT] += 1; + head_extents *= staff_space * 0.5; /* We could subtract beam Y position, but this routine only sets stem directions, a constant shift does not have an influence. */ - head_positions += stem->relative_coordinate (common, Y_AXIS); + head_extents += stem->relative_coordinate (common, Y_AXIS); if (to_dir (stem->get_property ("direction"))) { Direction stemdir = to_dir (stem->get_property ("direction")); - head_positions[-stemdir] = -stemdir * infinity_f; + head_extents[-stemdir] = -stemdir * infinity_f; } } - head_positions_array.push (head_positions); + head_extents_array.push (head_extents); - gaps.remove_interval (head_positions); + gaps.remove_interval (head_extents); } Interval max_gap; @@ -671,15 +678,15 @@ Beam::consider_auto_knees (Grob *me) if (Stem::is_invisible (stem)) continue; - Interval head_positions = head_positions_array[j++]; + Interval head_extents = head_extents_array[j++]; - Direction d = (head_positions.center () < max_gap.center ()) ? + Direction d = (head_extents.center () < max_gap.center ()) ? UP : DOWN; stem->set_property ("direction", scm_int2num (d)); - head_positions.intersect (max_gap); - assert (head_positions.is_empty () || head_positions.length () < 1e-6); + head_extents.intersect (max_gap); + assert (head_extents.is_empty () || head_extents.length () < 1e-6); } } } diff --git a/lily/paper-outputter-scheme.cc b/lily/paper-outputter-scheme.cc index c0208297a8..453a524f22 100644 --- a/lily/paper-outputter-scheme.cc +++ b/lily/paper-outputter-scheme.cc @@ -78,3 +78,16 @@ LY_DEFINE (ly_outputter_close, "ly:outputter-close", po->close (); return SCM_UNSPECIFIED; } + + +LY_DEFINE (ly_outputter_output_scheme, "ly:outputter-output-scheme", + 2, 0, 0, (SCM outputter, SCM expr), + "Eval @var{expr} in module of @var{outputter}.") +{ + Paper_outputter *po = unsmob_outputter (outputter); + SCM_ASSERT_TYPE (po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + + po->output_scheme (expr); + + return SCM_UNSPECIFIED; +} diff --git a/lily/parse-scm.cc b/lily/parse-scm.cc index 78a3c52865..b5dee5edf0 100644 --- a/lily/parse-scm.cc +++ b/lily/parse-scm.cc @@ -46,7 +46,9 @@ internal_ly_parse_scm (Parse_start *ps) answer = scm_eval (form, module); } else - answer = scm_primitive_eval (form); + { + answer = scm_primitive_eval (form); + } } /* Reset read_buf for scm_ftell. diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm index 038873fc7a..2cea3735a0 100644 --- a/scm/framework-svg.scm +++ b/scm/framework-svg.scm @@ -6,17 +6,30 @@ (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 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)) + +(if #t + (begin + (debug-enable 'debug) + (debug-enable 'backtrace) + (read-enable 'positions))) (define-public (output-framework basename book scopes fields) (let* ((filename (format "~a.svg" basename)) (outputter (ly:make-paper-outputter filename (ly:output-backend))) - (paper (ly:paper-book-paper book)) + (dump (lambda (str) (display str (ly:outputter-port outputter)))) + (paper (ly:paper-book-paper book)) + (unit-length (ly:output-def-lookup paper 'outputscale)) + (output-scale (* lily-unit->mm-factor + unit-length)) (pages (ly:paper-book-pages book)) (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)) (page-number (1- (ly:output-def-lookup paper 'firstpagenumber))) @@ -26,50 +39,53 @@ (page-width (inexact->exact (ceiling (* output-scale hsize)))) (page-height (inexact->exact (ceiling (* output-scale vsize)))) (page-set? (or (> page-count 1) landscape?))) + + (ly:outputter-output-scheme outputter + `(set! lily-unit-length ,unit-length)) + (dump (eo 'svg + '(xmlns . "http://www.w3.org/2000/svg") + '(version . "1.2") + + ;; Argggghhhh: SVG takes the px <-> mm mapping from the windowing system + `(width . ,(format #f "~s" page-width)) + `(height . ,(format #f "~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?)) + pages) + + (if page-set? (eo 'pageSet) "") + (dump + (string-append + (ec 'g) + (if page-set? (ec 'pageSet) "") + (ec 'svg))))) (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 #f "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 "")) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 18fb45ff5c..601cdb35fe 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -307,12 +307,16 @@ possibly turned off." (define-public (!= lst r) (not (= lst r))) -(define-public scale-to-unit +(define-public lily-unit->bigpoint-factor (cond ((equal? (ly:unit) "mm") (/ 72.0 25.4)) ((equal? (ly:unit) "pt") (/ 72.0 72.27)) (else (error "unknown unit" (ly:unit))))) + +(define-public lily-unit->mm-factor + (* 25.4 (/ lily-unit->bigpoint-factor 72))) + ;;; FONT may be font smob, or pango font string... (define-public (font-name-style font) ;; FIXME: ughr, (ly:font-name) sometimes also has Style appended. @@ -327,7 +331,7 @@ possibly turned off." name-style (append name-style '("Regular")))))) -(define-public (font-size font) +(define-public (modified-font-metric-font-scaling font) (let* ((designsize (ly:font-design-size font)) (magnification (* (ly:font-magnification font))) (scaling (* magnification designsize))) diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 83ce839bae..f1a5dc5688 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -151,7 +151,7 @@ lilypond -fgnome input/simple-song.ly (* 1.85 (if (string? font) 12 - (* output-scale (font-size font))))) + (* output-scale (modified-font-metric-font-scaling font))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Wrappers from guile-gnome TLA diff --git a/scm/output-sketch.scm b/scm/output-sketch.scm index e785ae8680..f136f8a721 100644 --- a/scm/output-sketch.scm +++ b/scm/output-sketch.scm @@ -106,12 +106,6 @@ ;;(define output-scale 2.83464566929134) -(define scale-to-unit - (cond - ((equal? (ly:unit) "mm") (/ 72.0 25.4)) - ((equal? (ly:unit) "pt") (/ 72.0 72.27)) - (else (error "unknown unit" (ly:unit))) - )) (define (mul-scale x) (* scale-to-unit output-scale x)) diff --git a/scm/output-svg.scm b/scm/output-svg.scm index 6df234922d..f7931ecbc8 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -27,9 +27,13 @@ (lily) (srfi srfi-13)) -;; GLobals -;; FIXME: 2? -(define output-scale (* 2 scale-to-unit)) + +(if #t + (begin + (debug-enable 'debug) + (debug-enable 'backtrace) + (read-enable 'positions))) +(define lily-unit-length 1.75) (define (dispatch expr) (let ((keyword (car expr))) @@ -91,24 +95,51 @@ (apply string-append (map (lambda (x) (char->entity x)) (string->list string)))) +(define pango-description-regexp + (make-regexp "^([^,]+)+, ?([-a-zA-Z_]*) ([0-9.]+)$")) + +(define (pango-description-to-svg-font str) + (let* + ((size 4.0) + (family "Helvetica") + (style #f) + (match (regexp-exec pango-description-regexp str))) + + (if (regexp-match? match) + (begin + (set! family (match:substring match 1)) + (if (< 0 (string-length (match:substring match 2))) + (set! style (match:substring match 2))) + (set! size + (string->number (match:substring match 3)))) + + (display (format "Cannot decypher Pango description: ~a\n" str))) + + (set! style + (if (string? style) + (format "font-style:~a;" style) + "")) + + (format "font-family:~a;~afont-size:~a;text-anchor:west" + family + style + (/ size lily-unit-length)) + )) + ;;; FONT may be font smob, or pango font string (define (svg-font font) - (let ((name-style (if (string? font) - (list font "Regular") - (font-name-style font))) - (size (svg-font-size font)) + (if (string? font) + (pango-description-to-svg-font font) + (let ((name-style (font-name-style font)) + (size (modified-font-metric-font-scaling font)) (anchor "west")) - (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;" - (car name-style) (cadr name-style) size anchor))) -;;; FONT may be font smob, or pango font string -(define (svg-font-size font) - (if (string? font) - 12 - (* output-scale (font-size font)))) + (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;" + (car name-style) (cadr name-style) + size anchor)))) (define (fontify font expr) - (entity 'text expr (cons 'style (svg-font font)))) + (entity 'text expr (cons 'style (svg-font font)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; stencil outputters @@ -140,10 +171,8 @@ `(width . ,width) `(height . ,(+ thick (* (abs z) (/ thick 2)))) `(rx . ,(/ blot-diameter 2)) - `(transform . ,(string-append - (format #f "matrix (1, ~f, 0, 1, 0, 0)" (- z)) - (format #f " scale (~f, ~f)" - output-scale output-scale)))))) + `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)" (- z)) + )))) (define (beam width slope thick blot-diameter) (let* ((b blot-diameter) @@ -162,8 +191,7 @@ (cons (+ w (/ b 2)) (+ h (/ t 2))) (cons (+ w (/ b 2)) (+ h (- (/ t 2)))) (cons (/ b 2) (- (/ t 2))))))) - `(transform - . ,(format #f "scale (~f, -~f)" output-scale output-scale))))) + ))) (define (path-beam width slope thick blot-diameter) (let* ((b blot-diameter) @@ -182,8 +210,7 @@ 0 (- t) (- w) h 0 t)) - `(transform - . ,(format #f "scale (~f, ~f)" output-scale output-scale))))) + ))) (define (bezier-sandwich lst thick) (let* ((first (list-tail lst 4)) @@ -197,8 +224,7 @@ '(fill . "black") `(d . ,(string-append (svg-bezier first #f) (svg-bezier second first-c0))) - `(transform - . ,(format #f "scale (~f, -~f)" output-scale output-scale))))) + ))) (define (char font i) (dispatch @@ -221,8 +247,7 @@ `(y1 . ,y1) `(x2 . ,x2) `(y2 . ,y2) - `(transform - . ,(format #f "scale (~f, -~f)" output-scale output-scale)))) + )) ;; WTF is this in every backend? (define (horizontal-line x1 x2 th) @@ -243,8 +268,8 @@ ;;(dispatch expr) expr `(transform . ,(format #f "translate (~f, ~f)" - (* output-scale x) - (- (* output-scale y)))))) + x + (- y))))) (define (polygon coords blot-diameter) (entity 'polygon "" @@ -255,8 +280,7 @@ ;;'(fill . "black") `(points . ,(string-join (map offset->point (ly:list->offsets '() coords)))) - `(transform - . ,(format #f "scale (~f, -~f)" output-scale output-scale)))) + )) (define (round-filled-box breapth width depth height blot-diameter) (entity 'rect "" @@ -273,8 +297,7 @@ `(width . ,(+ breapth width)) `(height . ,(+ depth height)) `(ry . ,(/ blot-diameter 2)) - `(transform - . ,(format #f "scale (~f, ~f)" output-scale output-scale)))) + )) (define (text font string) (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))