Re: Metronome mark stem length

[Thomas Morley]

2017-04-16 15:00 GMT+02:00 Thomas Morley <address@hidden>:
> 2017-04-16 12:59 GMT+02:00 Robert Murdoch <address@hidden>:
>> When I adjust my score's size with #(layout-set-staff-size N) and the score
>> has a tempo with a metronome mark, the metronome mark's stem gets longer if
>> the size is smaller, and shorter if the size is larger. There should be
>> examples attached at sizes 20 and 12 to show you.
>
> Confirmed.

> Lemme have a closer look at that note-by-number-markup.



It's now
https://sourceforge.net/p/testlilyissues/issues/5122/
with patch.

If you can't wait for next release, try:

#(define (sign x)
  (if (= x 0)
      0
      (if (< x 0) -1 1)))

#(define-markup-command (note-by-number layout props log dot-count dir)
  (number? number? number?)
  #:category music
  #:properties ((font-size 0)
                (flag-style '())
                (style '()))
  "
@cindex notes within text by log and dot-count

Construct a note symbol, with stem and flag.  By using fractional values for
@var{dir}, longer or shorter stems can be obtained.
Supports all note-head-styles.  Ancient note-head-styles will get
mensural-style-flags.  @code{flag-style} may be overridden independently.
Supported flag-styles are @code{default}, @code{old-straight-flag},
@code{modern-straight-flag}, @code{flat-flag}, @code{mensural} and
@code{neomensural}.  The latter two flag-styles will both result in
mensural-flags.  Both are supplied for convenience.

@lilypond[verbatim,quote]
\\markup {
  \\note-by-number #3 #0 #DOWN
  \\hspace #2
  \\note-by-number #1 #2 #0.8
}
@end lilypond"
  (define (get-glyph-name-candidates dir log style)
    (map (lambda (dir-name)
           (format #f "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))))

  (define (buildflags flag-stencil remain curr-stencil spacing)
    ;; Function to recursively create a stencil with @code{remain} flags
    ;; from the single-flag stencil @code{curr-stencil}, which is already
    ;; translated to the position of the previous flag position.
    ;;
    ;; Copy and paste from /scm/flag-styles.scm
    (if (> remain 0)
        (let* ((translated-stencil
                (ly:stencil-translate-axis curr-stencil spacing Y))
               (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
          (buildflags new-stencil (- remain 1) translated-stencil spacing))
        flag-stencil))

  (define (straight-flag-mrkp flag-thickness flag-spacing
                              upflag-angle upflag-length
                              downflag-angle downflag-length
                              dir)
    ;; Create a stencil for a straight flag.  @var{flag-thickness} and
    ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
    ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and
    ;; @var{downflag-length} are given in staff spaces.
    ;;
    ;; All lengths are scaled according to the font size of the note.
    ;;
    ;; From /scm/flag-styles.scm, modified to fit here.

    (let* ((stem-up (> dir 0))
           ;; scale with the note size
           (factor (magstep font-size))
           (stem-thickness (* factor 0.1))
           (line-thickness (ly:output-def-lookup layout 'line-thickness))
           (half-stem-thickness (/ (* stem-thickness line-thickness) 2))
           (raw-length (if stem-up upflag-length downflag-length))
           (angle (if stem-up upflag-angle downflag-angle))
           (flag-length (+ (* raw-length factor) half-stem-thickness))
           (flag-end (polar->rectangular flag-length angle))
           (thickness (* flag-thickness factor))
           (thickness-offset (cons 0 (* -1 thickness dir)))
           (spacing (* -1 flag-spacing factor dir))
           (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
           (raw-points
             (list
               '(0 . 0)
               flag-end
               (offset-add flag-end thickness-offset)
               thickness-offset))
           (points (map (lambda (coord) (offset-add coord start)) raw-points))
           (stencil (ly:round-filled-polygon points half-stem-thickness))
           ;; Log for 1/8 is 3, so we need to subtract 3
           (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
      flag-stencil))

  (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)
                                                 (font-name . #f))
                                               props)))
         ;; default for text-font-size is 11
         ;; hence we use (/ text-font-size 11) later, to ensure proper scaling
         ;; of stem-length and thickness
         (text-font-size (ly:output-def-lookup layout 'text-font-size))
         (size-factor (magstep font-size))
         (blot (ly:output-def-lookup layout 'blot-diameter))
         (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))
         (ancient-flags?
           (member style
                   '(mensural neomensural petrucci semipetrucci blackpetrucci)))
         (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
         (stem-length (* size-factor (max 3 (- log 1))))
         ;; With ancient-flags we want a tighter stem
         (stem-thickness
           (* size-factor (/ text-font-size 11) (if ancient-flags? 0.1 0.13)))
         (stemy (* dir (/ text-font-size 11) stem-length))
         (attach-off (cons (interval-index
                            (ly:stencil-extent head-glyph X)
                            (* (sign dir) (car attach-indices)))
                           ;; fixme, this is inconsistent between X & Y.
                           (* (sign dir)
                              (interval-index
                               (ly:stencil-extent head-glyph Y)
                               (cdr attach-indices)))))
         ;; For a tighter stem (with ancient-flags) the stem-width has to be
         ;; adjusted.
         (stem-X-corr
           (if (or ancient-flags?
                   (member flag-style '(mensural neomensural)))
                   (* 0.5 dir stem-thickness) 0))
         (stem-glyph (and (> log 0)
                          (ly:round-filled-box
                           (ordered-cons (+ stem-X-corr (car attach-off))
                                         (+ stem-X-corr (car attach-off)
                                            (* (- (sign dir)) stem-thickness)))
                           (cons (min stemy (cdr attach-off))
                                 (max stemy (cdr attach-off)))
                           (/ stem-thickness 3))))
         (dot (ly:font-get-glyph font "dots.dot"))
         (dotwid (interval-length (ly:stencil-extent dot X)))
         (dots (and (> dot-count 0)
                    (apply ly:stencil-add
                           (map (lambda (x)
                                  (ly:stencil-translate-axis
                                   dot (* 2 x dotwid) X))
                                (iota dot-count)))))
         ;; Straight-flags. Values taken from /scm/flag-style.scm
         (modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir))
         (old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir))
         (flat-flag (straight-flag-mrkp 0.55 1.0 0 1.0 0 1.0 dir))
         ;; Calculate a corrective to avoid a gap between
         ;; straight-flags and the stem.
         (flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag)
                                    (eq? flag-style 'old-straight-flag)
                                    (eq? flag-style 'flat-flag))
                                (/ blot 10 (* -1 dir))
                                0))
         (flaggl (and (> log 2)
                      (ly:stencil-translate
                       (cond ((eq? flag-style 'modern-straight-flag)
                              modern-straight-flag)
                             ((eq? flag-style 'old-straight-flag)
                              old-straight-flag)
                             ((eq? flag-style 'flat-flag)
                              flat-flag)
                             (else
                              (ly:font-get-glyph font
                                (format #f
                                        (if (or (member flag-style
                                                        '(mensural neomensural))
                                                (and ancient-flags?
                                                     (null? flag-style)))
                                            "flags.mensural~a2~a"
                                            "flags.~a~a")
                                        (if (> dir 0) "u" "d")
                                        log))))
                       (cons (+ (car attach-off)
                                ;; For tighter stems (with ancient-flags) the
                                ;; flag has to be adjusted different.
                                (if (and (not ancient-flags?) (< dir 0))
                                    stem-thickness
                                    0))
                             (+ stemy flag-style-Y-corr))))))
    ;; 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.
    ;; Not with ancient flags or straight-flags.
    (if (and dots (> dir 0) (> log 2)
             (or (eq? flag-style 'default) (null? flag-style))
             (not ancient-flags?)
             (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)))
    (if (ly:stencil? stem-glyph)
        (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
        (set! stem-glyph head-glyph))
    (if (ly:stencil? dots)
        (set! stem-glyph
              (ly:stencil-add
               (ly:stencil-translate-axis
                dots
                (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
                X)
               stem-glyph)))
    stem-glyph))

#(define-public (format-metronome-markup event context)
   (let ((hide-note (ly:context-property context 'tempoHideNote #f))
         (text (ly:event-property event 'text))
         (dur (ly:event-property event 'tempo-unit))
         (count (ly:event-property event 'metronome-count)))
   (metronome-markup text dur count hide-note)))

#(define (metronome-markup text dur count hide-note)
  (let* ((note-mark
            (if (and (not hide-note) (ly:duration? dur))
                (make-smaller-markup
                  (make-note-by-number-markup
                    (ly:duration-log dur)
                    (ly:duration-dot-count dur)
                    UP))
                #f))
         (count-markup (cond ((number? count)
                              (if (> count 0)
                                  (make-simple-markup
                                          (number->string count))
                                  #f))
                             ((pair? count)
                              (make-concat-markup
                               (list
                                (make-simple-markup
                                        (number->string (car count)))
                                (make-simple-markup " ")
                                (make-simple-markup "–")
                                (make-simple-markup " ")
                                (make-simple-markup
                                        (number->string (cdr count))))))
                             (else #f)))
         (note-markup (if (and (not hide-note) count-markup)
                          (make-concat-markup
                           (list
                            (make-general-align-markup Y DOWN note-mark)
                            (make-simple-markup " ")
                            (make-simple-markup "=")
                            (make-simple-markup " ")
                            count-markup))
                          #f))
         (text-markup (if (not (null? text))
                          (make-bold-markup text)
                          #f)))
    (if text-markup
        (if (and note-markup (not hide-note))
            (make-line-markup (list text-markup
                                    (make-concat-markup
                                     (list (make-simple-markup "(")
                                           note-markup
                                           (make-simple-markup ")")))))
            (make-line-markup (list text-markup)))
        (if note-markup
            (make-line-markup (list note-markup))
            (make-null-markup)))))

\layout {
  \context {
    \Score
    metronomeMarkFormatter = #format-metronome-markup
  }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

\version "2.19.56"

mus =
\new Staff {
  \tempo 8=120
  c'2_\markup
        \line {
            \fontsize #-6 \note-by-number #3 #0 #UP
            \fontsize #-4 \note-by-number #3 #0 #UP
            \fontsize #-2 \note-by-number #3 #0 #UP
            \fontsize #0 \note-by-number #3 #0 #UP
            \fontsize #2 \note-by-number #3 #0 #UP
            \fontsize #4 \note-by-number #3 #0 #UP
            \fontsize #6 \note-by-number #3 #0 #UP
        }
}

\score {
  \mus
  \layout { #(layout-set-staff-size 10) }
}

\score {
  \mus
  \layout { #(layout-set-staff-size 20) }
}

\score {
  \mus
  \layout { #(layout-set-staff-size 40) }
}


HTH,
  Harm