--- /dev/null
+\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
+}
--- /dev/null
+\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
+}
@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))
(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))))
(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)))
(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)
((= 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))
projects / lilypond.git / commitdiff