Am Mo., 22. Juni 2020 um 11:46 Uhr schrieb Urs Liska <li...@openlilylib.org>:
>
> I really don't seem to find useful search terms :-(
>
> I'm trying to achieve horizontal lines "extending" the note head to
> indicate its duration. The attachement is done by abusing \glissando.
> I'd be (mostly) happy with the appearance, but glissandi work only in
> place where a tie is. When there's a different note or a rest after the
> original note it doesn't.
>
> What would be a term for this notation element, and is there a ready-
> made solution, e.g. in the LSR?
>
> Thanks
> Urs

Hi Urs,

how about attached?
There are some features I needed for typesetting some avantgarde
piece, not sure whether they are of use for your case, though.
There are two functions defined durLine and durationLine, both have
pros and cons ...

Cheers,
  Harm
%%%% written for 2.19.65

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% Flat Glissando (as a duration-line with optional hooks at the end)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% Reads from Glissando.details:
%%%%   duration-line-thickness [defaults to 3.4]
%%%%   tip-height [defaults to (* staff-space 2/3)]
%%%%   tip-thickness [defaults to `duration-line-thickness']
%%%%   equal-chord-glissando-start-end [defaults to '(#t . #t)]

%% used for `duration-line':
#(define (get-grob-most-left-relative-coordinate ref-point)
  (lambda (grob)
    (if (ly:grob? grob)
        (cond
          ((eq? (grob::name grob) 'NoteColumn)
             (let* ((note-heads-array (ly:grob-object grob 'note-heads))
                    (note-heads-grobs
                      (if (ly:grob-array? note-heads-array)
                          (ly:grob-array->list note-heads-array)
                          '()))
                    (note-heads-refpoints
                      (map
                        (lambda (nh)
                          (ly:grob-relative-coordinate nh ref-point X))
                        note-heads-grobs))
                    (sorted-note-heads-refpoints (sort note-heads-refpoints <)))
              (if (not (null? sorted-note-heads-refpoints))
                  (car sorted-note-heads-refpoints))))
           ((eq? (grob::name grob) 'AccidentalPlacement)
              (let* ((acc-list (ly:grob-object grob 'accidental-grobs))
                     (acc-refpoints
                       (map
                         (lambda (acc)
                           (ly:grob-relative-coordinate (cadr acc) ref-point X))
                         acc-list))
                     (sorted-acc-refpoints (sort acc-refpoints <)))
               (if (not (null? sorted-acc-refpoints))
                   (car sorted-acc-refpoints))))
           (else
             (if (ly:grob? grob)
                 (ly:grob-relative-coordinate grob ref-point X))))
        '())))

#(define same-gliss-start-end
  ;; Looks at details.equal-chord-glissando-start-end whether all glissandi
  ;; between chords should start at the same X-coordinate, same for
  ;; glissando-endings
  ;; 'equal-chord-glissando-start-end?' takes a pair of booleans indicating it.
  (lambda (grob)
    (let* ((left-bound (ly:spanner-bound grob LEFT))
           (parent-nc (ly:grob-parent left-bound X))
           (details (ly:grob-property grob 'details))
           (equal-chord-glissando-start-end
             (assoc-get 'equal-chord-glissando-start-end details '(#t . #t)))
           (vertical-axis-group-elts
             (ly:grob-object (ly:grob-parent grob Y) 'elements))
           ;; Filter VerticalAxisGroup-elements for Glissandi, restricted to
           ;; those starting at the NoteHeads from same NoteColumn.
           ;; Return their 'X-value for start/end
           (relevant-gliss-Xs
             (if (ly:grob-array? vertical-axis-group-elts)
                 (filter-map
                   (lambda (elt)
                     (and
                       (grob::has-interface elt 'glissando-interface)
                       (equal?
                         (ly:grob-parent (ly:spanner-bound elt LEFT) X)
                         parent-nc)
                       (cons
                         (assoc-get 'X
                                    (ly:grob-property elt 'left-bound-info))
                         (assoc-get 'X
                                    (ly:grob-property elt 'right-bound-info)))))
                   (ly:grob-array->list vertical-axis-group-elts))
                 '())))
      ;; Depending on `equal-chord-glissando-start-end':
      ;; Get the most left 'X for the resulting 'X-value of the end.
      ;; Get the most right 'X for the resulting 'X-value of the start.
      ;; Override left/right-bound-info with those values.
      (if (car equal-chord-glissando-start-end)
          (ly:grob-set-nested-property! grob '(left-bound-info X)
            (apply max (map car relevant-gliss-Xs))))
      (if (cdr equal-chord-glissando-start-end)
          (ly:grob-set-nested-property! grob '(right-bound-info X)
            (apply min (map cdr relevant-gliss-Xs)))))))

#(define* (duration-line #:optional (tip 'none) (equal-start? #f))
   (lambda (grob)
     (let* ((staff-space (ly:staff-symbol-staff-space grob))
            (line-thick (ly:staff-symbol-line-thickness grob))
            (refp (ly:grob-system grob))
            (orig (ly:grob-original grob))
            (siblings (if (ly:grob? orig)
                          (ly:spanner-broken-into orig) '()))
            (note-head?
              (lambda (x)
                (and (ly:grob? x)
                     (grob::has-interface x 'note-head-interface))))
            (details (ly:grob-property grob 'details))
            (duration-line-thick
              (assoc-get
                'duration-line-thickness
                details
                ;; 3.4 is my fall-back choice
                3.4))
            (tip-height
              (assoc-get
                'tip-height
                details
                (* staff-space 2/3)))
            (tip-thick
              (assoc-get
                'tip-thickness
                details
                duration-line-thick))
            (blot-diameter
              (ly:output-def-lookup (ly:grob-layout grob) 'blot-diameter))
       ;;;; left NoteColumn
            (left-Y (assoc-get 'Y (ly:grob-property grob 'left-bound-info)))
            (left-bound (ly:spanner-bound grob LEFT))
            (left-note-column
              (if (note-head? left-bound)
                  (ly:grob-parent left-bound X)
                  left-bound))
            (left-note-col-X-ext
              (ly:grob-extent left-note-column left-note-column X))
            (left-note-column-coord
              (ly:grob-relative-coordinate left-note-column refp X))
       ;;;; DotColumn of left NoteColumn
            (dot-column-left (ly:note-column-dot-column left-note-column))
            (dot-column-left-X-extent
              (if (ly:grob? dot-column-left)
                  (ly:grob-extent dot-column-left dot-column-left X)
                  '(0 . 0)))
       ;;;; right NoteColumn
            (right-bound (ly:spanner-bound grob RIGHT))
            (right-bound-info (ly:grob-property grob 'right-bound-info))
            (right-note-column (ly:grob-parent right-bound X))
            (most-left-note-head-coord
             ((get-grob-most-left-relative-coordinate refp) right-note-column))
       ;;;; AccidentalPlacement of right NoteColumn
            (acc-placement (ly:note-column-accidentals right-note-column))
            (most-left-note-acc-coord
             ((get-grob-most-left-relative-coordinate refp) acc-placement))
       ;;;; Arpeggio of right NoteColumn
            (conditional-elements
              (ly:grob-object right-note-column 'conditional-elements))
            (cond-elts-list
              (if (ly:grob-array? conditional-elements)
                  (ly:grob-array->list conditional-elements)
                  '()))
            (arpeggio-ls
              (filter
                (lambda (g)
                  (grob::has-interface g 'arpeggio-interface))
                cond-elts-list))
            (arpeggio-coord
              (if (and (pair? arpeggio-ls) (ly:grob? (car arpeggio-ls)))
                  (ly:grob-relative-coordinate (car arpeggio-ls) refp X)))
       ;;;; calculate most right left-bound coord
            (most-right-left-bound-coord
              (+ left-note-column-coord
                 (cdr left-note-col-X-ext)
                 (cdr dot-column-left-X-extent)))
       ;;;; catch most left right-bound coord
            (right-bound-coords-lst
              (list
                arpeggio-coord
                most-left-note-acc-coord
                most-left-note-head-coord))
            (cleared-right-bound-coords-lst
                (sort
                  (remove (lambda (x) (not (number? x))) right-bound-coords-lst)
                  <)))

    ;; create a flat glissando
    (ly:grob-set-nested-property! grob '(right-bound-info Y) left-Y)

    ;; Let all glissandi start at the same vertical position
    (if (and (note-head? left-bound) equal-start?)
        (ly:grob-set-nested-property!
          grob
          '(left-bound-info X)
          most-right-left-bound-coord))

    ;; Let all glissandi end at the same vertical position
    (if (note-head? right-bound)
        (ly:grob-set-nested-property!
          grob
          '(right-bound-info X)
          (car cleared-right-bound-coords-lst)))

    ;; print new stencil
    (let* ((stencil (ly:line-spanner::print grob))
           (stencil-x-ext
             (if (ly:stencil? stencil)
                 (ly:stencil-extent stencil X)
                 '(0 . 0)))
           (thick-ext
             (interval-widen
               (cons left-Y left-Y)
               (* line-thick (/ duration-line-thick 2))))
           (tip-thick-ext
             (interval-widen
               (cons left-Y left-Y)
               (* line-thick (/ tip-thick 2))))
           (new-stencil
              (ly:round-filled-box
                stencil-x-ext
                thick-ext
                blot-diameter)))
       ;; If optional tip is set 'tip or 'tip-down print a hook, but only for
       ;; last part of a broken glissando
       (if (and (member tip '(tip tip-down))
                (or
                   (and
                        (pair? siblings)
                        (equal? grob (last siblings)))
                   (not (pair? siblings))))
           (let* ((tip-thick (interval-length thick-ext))
                  (half-actual-dur-line-thick
                    (/ (* line-thick duration-line-thick) 2))
                  (tip-stil
                    (ly:stencil-translate-axis
                      (ly:round-filled-box
                        tip-thick-ext
                        (cons 0 (+ tip-height half-actual-dur-line-thick))
                        blot-diameter)
                      (if (eq? tip 'tip)
                          (- left-Y half-actual-dur-line-thick)
                          (- left-Y tip-height))
                      Y)))
             (ly:stencil-combine-at-edge
               new-stencil
               X
               RIGHT
               ;(stencil-with-color tip-stil red)
               tip-stil
               (- (- (cdr tip-thick-ext) (car tip-thick-ext)))))
           new-stencil)))))

%% For now we let the functions default-arguments (parser location) in.
%% No need for them in 2.19., though.

%% NB The call for `durationLine' may be preceeded with \once
durationLine =
#(define-music-function (parser location tip equal-start? left-right-padding)
   ((symbol? 'none) (boolean? #t) pair?)
#{
  \override Glissando.stencil = #(duration-line tip equal-start?)
  \override Glissando.bound-details.left.padding = #(car left-right-padding)
  \override Glissando.bound-details.right.padding = #(cdr left-right-padding)
#})

at =
#(define-music-function (parser location time event music)
  (ly:duration? ly:music? ly:music?)
"Place @var{event} at a relative duration @var{time} in relation
to @var{music}."
  #{ \context Bottom << { \skip $time <>$event } $music >> #})

%%
%% Limitation of `durLine':
%%   *  `mus' can't end exactly at end of a line
%%   *  _\once_ overriding Glissando.minimum-length takes no effect
%%      One needs to do the full \override-\revert-pair
durLine =
#(define-music-function (parser location tip left-right-padding mus)
  ((symbol? 'none)(pair? '(-0.5 . 0)) ly:music?)
  (let* ((mus-copy (ly:music-deep-copy mus))
         (notes (extract-typed-music mus-copy 'note-event))
         (mus-to-insert
           (cond ((music-is-of-type? mus-copy 'event-chord)
                   (make-event-chord
                     (map
                       (lambda (n)
                         (ly:music-set-property! n 'articulations '())
                         n)
                       notes)))
                 ((music-is-of-type? mus-copy 'note-event)
                   (ly:music-set-property! mus-copy 'articulations '())
                   mus-copy)
                 (else mus-copy)))
         (dur (ly:music-property (last notes) 'duration #f)))
    (if (ly:duration? dur)
        #{
          \at $dur
              \grace {
                \once \omit ParenthesesItem
                \once \omit AccidentalCautionary
                \override NoteHead.stencil = #point-stencil
                \override NoteHead.no-ledgers = ##t
                \override Accidental.stencil = ##f
                \override Flag.stencil = ##f
                \override Dots.stencil = ##f
                \override Stem.stencil = ##f
                $mus-to-insert
                \revert NoteHead.stencil
                \revert NoteHead.no-ledgers
                \revert Accidental.stencil
                \revert Flag.stencil
                \revert Dots.stencil
                \revert Stem.stencil
              }
          {
            \once \override Score.GraceSpacing.spacing-increment = 0
            \once \override Glissando.breakable = ##t
            \once \override Glissando.bound-details.left.padding =
              #(car left-right-padding)
            \once \override Glissando.bound-details.right.padding =
              #(cdr left-right-padding)
            \once \override Glissando.after-line-breaking =
              #same-gliss-start-end
            \once \override Glissando.stencil =
              #(duration-line tip #f)
            <>\glissando
            $(ly:music-deep-copy mus)
          }
        #}
        (ly:music-deep-copy mus))))


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

\version "2.19.65"

\layout {
  \override Glissando.details.tip-height = 0.6667
  \override Glissando.details.duration-line-thickness = 3.4
  \override Glissando.details.tip-thickness = 3.4
  \override Glissando.color = #red
  \override Glissando.layer = 300
}

{
  \durationLine #'(-0.5 . 0.6)
  <c' d'>1\glissando
  s1
  <e' f'>\arpeggio

  \durationLine #'tip #'(-0.5 . 0.6)
  <c' d'>1\glissando
  s1
  <e' f'>

  \durationLine #'tip ##f #'(-0.5 . 0.6)
  <c' d'>1\glissando
  s1
  <e' f'>

  \once \durationLine #'tip-down #'(-0.5 . 0.6)
  <c' d'>1\glissando
  s1
  <e' f'>

  \durationLine #'(-0.5 . 0.6)
  <c' d'>1\glissando
  s1
  <e' f'>
}

\layout {
  \context {
    \Score
    \override NonMusicalPaperColumn.line-break-permission = ##f
  }
  \context {
    \Voice
    \remove "Forbid_line_break_engraver"
  }
}

{
  \durLine
  <c' d'>4*11 r4

  \durLine #'tip
  <c' d'>4*11 r4

  <>^"\\durLine #'tip #4"
  \durLine #'tip #'(-0.5 . 4)
  <c' d'>4*11 r4

  \durLine #'tip-down
  <c' d'>4*11 r4

  \durLine
  <c' d'>4*11 r4
}

Reply via email to