From dc7eea3721fa3204afab8fdf2e8754493e0c7e04 Mon Sep 17 00:00:00 2001 From: Neil Puttock Date: Sun, 20 Dec 2009 18:17:50 +0000 Subject: [PATCH] Fix #628 and allow \note(-by-number) to work with all head styles. * move glyph-selection code from note-head::calc-glyph-name into separate function so it can be accessed by \note and \note-by-number * in \note-by-number, check validity of glyph-name, returning default head style if string is empty --- input/regression/markup-note-grob-style.ly | 20 ++++++ input/regression/markup-note-styles.ly | 38 ++++++++++ scm/define-markup-commands.scm | 62 +++++++++++------ scm/output-lib.scm | 80 ++++++++++++---------- 4 files changed, 141 insertions(+), 59 deletions(-) create mode 100644 input/regression/markup-note-grob-style.ly create mode 100644 input/regression/markup-note-styles.ly diff --git a/input/regression/markup-note-grob-style.ly b/input/regression/markup-note-grob-style.ly new file mode 100644 index 0000000000..e3db018053 --- /dev/null +++ b/input/regression/markup-note-grob-style.ly @@ -0,0 +1,20 @@ +\version "2.13.10" + +\header { + texidoc = "The @code{'style} property from grobs such as +@code{TimeSignature} and @code{TextSpanner} does not affect +the default note head style for @code{\\note} and +@code{\\note-by-number}." +} + +\relative c' { + \override Staff.TimeSignature #'stencil = + #(lambda (grob) + (grob-interpret-markup grob + (markup #:override '(baseline-skip . 0) + #:column (#:number "2" #:note "2" DOWN)))) + \override TextSpanner #'(bound-details left text) = + \markup { \note #"16" #UP } + c1\startTextSpan + c1\stopTextSpan +} diff --git a/input/regression/markup-note-styles.ly b/input/regression/markup-note-styles.ly new file mode 100644 index 0000000000..ac72064434 --- /dev/null +++ b/input/regression/markup-note-styles.ly @@ -0,0 +1,38 @@ +\version "2.13.10" + +\header { + texidoc = "@code{\\note-by-number} and @code{\\note} support +all note head styles." +} + +#(define-markup-command (show-note-styles layout props) () + (interpret-markup layout props + (make-column-markup + (map + (lambda (style) + (make-line-markup + (list + (make-pad-to-box-markup '(0 . 20) '(0 . 0) + (symbol->string style)) + (make-override-markup + (cons 'line-width 60) + (make-override-markup + (cons 'style style) + (make-fill-line-markup + (map + (lambda (dur-log) + (make-note-by-number-markup + dur-log 0 UP)) + '(-3 -2 -1 0 1 2)))))))) + '(default altdefault + baroque neomensural + mensural petrucci + harmonic harmonic-black + harmonic-mixed diamond + cross xcircle + triangle slash))))) + +\markup { + \override #'(baseline-skip . 6) + \show-note-styles +} diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index a1da7ed698..690eef1078 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -2813,25 +2813,36 @@ Construct a note symbol, with stem. By using fractional values for @end lilypond" (define (get-glyph-name-candidates dir log style) (map (lambda (dir-name) - (format "noteheads.~a~a~a" dir-name (min log 2) - (if (and (symbol? style) - (not (equal? 'default style))) - (symbol->string style) - ""))) + (format "noteheads.~a~a" dir-name + (if (and (symbol? style) + (not (equal? 'default style))) + (select-head-glyph style (min log 2)) + (min log 2)))) (list (if (= dir UP) "u" "d") "s"))) (define (get-glyph-name font cands) (if (null? cands) - "" - (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) - (get-glyph-name font (cdr cands)) - (car cands)))) + "" + (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) + (get-glyph-name font (cdr cands)) + (car cands)))) - (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props))) + (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) + props))) (size-factor (magstep font-size)) - (stem-length (* size-factor (max 3 (- log 1)))) - (head-glyph-name (get-glyph-name font (get-glyph-name-candidates (sign dir) log style))) + (stem-length (* size-factor (max 3 (- log 1)))) + (head-glyph-name + (let ((result (get-glyph-name font (get-glyph-name-candidates + (sign dir) log style)))) + (if (string-null? result) + ;; If no glyph name can be found, select default heads. Though + ;; this usually means an unsupported style has been chosen, it + ;; also prevents unrelated 'style settings from other grobs + ;; (e.g., TextSpanner and TimeSignature) leaking into markup. + (get-glyph-name font (get-glyph-name-candidates + (sign dir) log 'default)) + result))) (head-glyph (ly:font-get-glyph font head-glyph-name)) (attach-indices (ly:note-head::stem-attachment font head-glyph-name)) (stem-thickness (* size-factor 0.13)) @@ -2839,14 +2850,15 @@ Construct a note symbol, with stem. By using fractional values for (attach-off (cons (interval-index (ly:stencil-extent head-glyph X) (* (sign dir) (car attach-indices))) - (* (sign dir) ; fixme, this is inconsistent between X & Y. + (* (sign dir) ; fixme, this is inconsistent between X & Y. (interval-index (ly:stencil-extent head-glyph Y) (cdr attach-indices))))) (stem-glyph (and (> log 0) (ly:round-filled-box (ordered-cons (car attach-off) - (+ (car attach-off) (* (- (sign dir)) stem-thickness))) + (+ (car attach-off) + (* (- (sign dir)) stem-thickness))) (cons (min stemy (cdr attach-off)) (max stemy (cdr attach-off))) (/ stem-thickness 3)))) @@ -2865,11 +2877,15 @@ Construct a note symbol, with stem. By using fractional values for (string-append "flags." (if (> dir 0) "u" "d") (number->string log))) - (cons (+ (car attach-off) (if (< dir 0) stem-thickness 0)) stemy))))) - - ; If there is a flag on an upstem and the stem is short, move the dots to avoid the flag. - ; 16th notes get a special case because their flags hang lower than any other flags. - (if (and dots (> dir 0) (> log 2) (or (< dir 1.15) (and (= log 4) (< dir 1.3)))) + (cons (+ (car attach-off) (if (< dir 0) + stem-thickness 0)) + stemy))))) + + ;; If there is a flag on an upstem and the stem is short, move the dots + ;; to avoid the flag. 16th notes get a special case because their flags + ;; hang lower than any other flags. + (if (and dots (> dir 0) (> log 2) + (or (< dir 1.15) (and (= log 4) (< dir 1.3)))) (set! dots (ly:stencil-translate-axis dots 0.5 X))) (if flaggl (set! stem-glyph (ly:stencil-add flaggl stem-glyph))) @@ -2891,10 +2907,12 @@ Construct a note symbol, with stem. By using fractional values for (lambda (z) (inexact->exact (/ (log z) divisor))))) (define (parse-simple-duration duration-string) - "Parse the `duration-string', e.g. ''4..'' or ''breve.'', and return a (log dots) list." - (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") duration-string))) + "Parse the `duration-string', e.g. ''4..'' or ''breve.'', +and return a (log dots) list." + (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)") + duration-string))) (if (and match (string=? duration-string (match:substring match 0))) - (let ((len (match:substring match 1)) + (let ((len (match:substring match 1)) (dots (match:substring match 2))) (list (cond ((string=? len "breve") -1) ((string=? len "longa") -2) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index f210bb6dc6..8c34f01371 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -87,47 +87,53 @@ ((= log -1) 1) (else 0)))) -;; silly, use alist? +;; Kept separate from note-head::calc-glyph-name to allow use by +;; markup commands \note and \note-by-number +(define-public (select-head-glyph style log) + "Select a note head glyph string based on note head style @var{style} +and duration-log @var{log}." + (case style + ;; "default" style is directly handled in note-head.cc as a + ;; special case (HW says, mainly for performance reasons). + ;; Therefore, style "default" does not appear in this case + ;; statement. -- jr + ((xcircle) "2xcircle") + ((harmonic) "0harmonic") + ((harmonic-black) "2harmonic") + ((harmonic-mixed) (if (<= log 1) "0harmonic" + "2harmonic")) + ((baroque) + ;; Oops, I actually would not call this "baroque", but, for + ;; backwards compatibility to 1.4, this is supposed to take + ;; brevis, longa and maxima from the neo-mensural font and all + ;; other note heads from the default font. -- jr + (if (< log 0) + (string-append (number->string log) "neomensural") + (number->string log))) + ((altdefault) + ;; Like default, but brevis is drawn with double vertical lines + (if (= log -1) + (string-append (number->string log) "double") + (number->string log))) + ((mensural) + (string-append (number->string log) (symbol->string style))) + ((petrucci) + (if (< log 0) + (string-append (number->string log) "mensural") + (string-append (number->string log) (symbol->string style)))) + ((neomensural) + (string-append (number->string log) (symbol->string style))) + (else + (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) + (symbol->string style) + (string-append (number->string (max 0 log)) + (symbol->string style)))))) + (define-public (note-head::calc-glyph-name grob) (let ((style (ly:grob-property grob 'style)) (log (min 2 (ly:grob-property grob 'duration-log)))) - (case style - ;; "default" style is directly handled in note-head.cc as a - ;; special case (HW says, mainly for performance reasons). - ;; Therefore, style "default" does not appear in this case - ;; statement. -- jr - ((xcircle) "2xcircle") - ((harmonic) "0harmonic") - ((harmonic-black) "2harmonic") - ((harmonic-mixed) (if (<= log 1) "0harmonic" - "2harmonic")) - ((baroque) - ;; Oops, I actually would not call this "baroque", but, for - ;; backwards compatibility to 1.4, this is supposed to take - ;; brevis, longa and maxima from the neo-mensural font and all - ;; other note heads from the default font. -- jr - (if (< log 0) - (string-append (number->string log) "neomensural") - (number->string log))) - ((altdefault) - ;; Like default, but brevis is drawn with double vertical lines - (if (= log -1) - (string-append (number->string log) "double") - (number->string log))) - ((mensural) - (string-append (number->string log) (symbol->string style))) - ((petrucci) - (if (< log 0) - (string-append (number->string log) "mensural") - (string-append (number->string log) (symbol->string style)))) - ((neomensural) - (string-append (number->string log) (symbol->string style))) - (else - (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) - (symbol->string style) - (string-append (number->string (max 0 log)) - (symbol->string style))))))) + (select-head-glyph style log))) (define-public (note-head::brew-ez-stencil grob) (let* ((log (ly:grob-property grob 'duration-log)) -- 2.39.5