Hi Stefan, hi Lukas,

I think it might be reasonable to directly annotate the Slurs instead. This 
allows for nice placement, see the appended example.

Cheers,
Valentin

Am Montag, 30. Mai 2022, 08:17:58 CEST schrieb Stefan E. Mueller:
> Hi Lukas,
> 
> yes, that is what I need, I can take it from there - many thanks for the
> quick response and solution, and the explanations!
> 
>       Stefan
> 
> --
> Stefan E. Mueller
> 
> [email protected]
> 
> On Sun, 29 May 2022, Lukas-Fabian Moser wrote:
> > Hi Stefan,
> > 
> > Am 29.05.22 um 22:42 schrieb Stefan E. Mueller:
> >> I am not sure yet what the difference between a scheme-function and a
> >> music-function is (the second example seems to work whichever definition
> >> is chosen).
> > 
> > A music function must return music, a scheme function can return more
> > general expressions (for instance, a new function or a list of symbols).
> > 
> >> The "-" dash in my case added an (unwanted) accentuation to
> >> the first note, I get the slur with the markup without the accent only if
> >> I remove it (not sure what it is supposed to do - manual says it is a
> >> required
> >> named direction indicator, but in my version 2.22.1 it doesn't work like
> >> that).
> > 
> > Ah, I thought you wanted the accent. :-)
> > 
> > Both the - and ^ symbols have various meanings; it's important to read
> > them
> > in order.
> > 
> > Add articulation with neutral direction/up-facing/down-facing: -!, ^!, _!
> > (here I use ! = staccatissimo as an articulation, but ( = slur, ^ =
> > marcato
> > and - = tenuto are other examples)
> > 
> > If you just want a slur that should have its direction forced upwards,
> > just
> > write ^(
> > 
> >> I thought the function-constructs were merely doing variable
> >> substitutions, but it seems there is more to this. Because now I have the
> >> problem how to describe several hammer-ons in a row with a function, like
> >> this:
> >> 
> >> \new Staff {
> >> e''8^(^\markup {\halign #-1.5 ho} f''8)^\markup {\halign #-1.5 ho} g''\8)
> >> }
> >> 
> >> Ideally, I'd like to be able to write this like
> >> 
> >> e''8 \ho f''8 \ho g''8
> >> 
> >> (with the corresponding closing brackets also provided by the function,
> >> but it may be that this is not possible).
> > 
> > I assume you want another slur to start on the f''? Then maybe something
> > like this:
> > 
> > \version "2.22"
> > 
> > ho =
> > #(define-music-function (spacing music) ((number? -1.5) ly:music?)
> >    #{
> >      <>^(^\markup {\halign #spacing ho}
> >      #music
> >      <>)
> >    #})
> > 
> > \new Staff {
> >   e''8 \ho f''8 \ho g''8 a''
> > }
> > 
> > Lukas

%%% Some vector functions for pairs

% Sum of vectors
#(define (vecsum v1 . rest)
   (if (null? rest)
       v1
       (let ((v2 (apply vecsum rest)))
         (cons (+ (car v1) (car v2))
               (+ (cdr v1) (cdr v2))))))

% Inner product of two vectors
#(define (vecip v1 v2)
   (+ (* (car v1) (car v2))
      (* (cdr v1) (cdr v2))))

% Normal vector
#(define (vecnv v)
   (cons (cdr v) (- (car v))))

% Vector norm
#(define (vecnorm v)
   (sqrt (+ (* (car v) (car v)) (* (cdr v) (cdr v)))))

% Scale vector by scalar
#(define (vecscale s v)
   (cons (* s (car v)) (* s (cdr v))))

% Normalize vector such that ||v|| = 1
#(define (vecnormalize v)
   (vecscale (/ 1 (vecnorm v)) v))

% Calculate length of projection of one vector onto another vector
#(define (vecprojection on v)
   (vecip v (vecnormalize on)))

% Calculate difference of two vectors
#(define (vecdiff v1 v2)
   (vecsum v1 (vecscale -1 v2)))

% Calculate product of matrix (given as pair of row vectors) and vector
#(define (matvecprod m v)
   (cons (vecip (car m) v) (vecip (cdr m) v)))

% Rotation matrix
#(define (matrot phi)
   (cons
    (cons (cos phi) (- (sin phi)))
    (cons (sin phi) (cos phi))))

% Rotate vector by phi
#(define (vecrotate phi v)
   (matvecprod (matrot phi) v))

%%% Resolve a path of symbols from a nested alist
#(define* (nested-assoc-get keys alist #:optional (default #f))
   (if (list? keys)
       (if (null? keys)
           alist
           (let ((res (assoc-get (car keys) alist 'SPECIAL_STATE_NESTED_ASSOC_GET_NOT_FOUND)))
             (if (eq? res 'SPECIAL_STATE_NESTED_ASSOC_GET_NOT_FOUND)
                 default
                 (nested-assoc-get (cdr keys) res default))))
       (assoc-get keys alist default)))

%%% Add some text centered over a slur. The text is centered relative to the slurs base line direction
%%% The text is taken from the grobs 'text property and evaluated using ly:text-interface::print
#(define (slur-with-text details-path)
   (grob-transformer 'stencil
                     (lambda (grob orig)
                       ; Only add text if we do have an actual text set
                       (if (and (markup? (ly:grob-property grob 'text))
                                (not (equal? (ly:grob-property grob 'text) "")))
                           (let* ((details-path (if (list? details-path) details-path
                                                    (list details-path)))
                                  ; Get text stencil and make sure it is left/bottom aligned
                                  (mu (ly:text-interface::print grob))
                                  (mu (ly:stencil-aligned-to mu X -1))
                                  (mu (ly:stencil-aligned-to mu Y -1))
                                  ; get bounding box of text
                                  (width (cdr (ly:stencil-extent mu X)))
                                  (height (cdr (ly:stencil-extent mu Y)))
                                  (diag (vecnorm (cons width height)))
                                  ; get center point of text
                                  (mucenter (vecscale 1/2 (cons width height)))
                                  ; get the control points of the slur
                                  (cpts (ly:grob-property grob 'control-points))
                                  (l (list-ref cpts 0))
                                  (r (list-ref cpts 3))
                                  (ml (list-ref cpts 1))
                                  (mr (list-ref cpts 2))
                                  ; calculate the center point between left and right cp
                                  (c (vecscale 1/2 (vecsum l r)))
                                  ; calculate normal vector to Slur baseline
                                  (n (vecnormalize (vecnv (vecdiff r l))))
                                  ; get rotation offset from details
                                  (rotation (nested-assoc-get (append details-path '(rotation))
                                                              (ly:grob-property grob 'details)
                                                              0))
                                  ; adjust rotation of normal vector
                                  (n (vecrotate rotation n))
                                  ; Calculate extent of text in direction of normal vector
                                  (height-correction (/ 1 (abs (cdr n))))
                                  (corrected-mu-height (* height-correction height))
                                  (width-correction (/ 1 (abs (car n))))
                                  (corrected-mu-width (* width-correction width))
                                  (mu-dist (min corrected-mu-height corrected-mu-width))
                                  ; Calculate the height of the other two CP in terms of the normal vector
                                  (h1 (vecprojection n (vecdiff ml c)))
                                  (h2 (vecprojection n (vecdiff mr c)))
                                  (dir (ly:grob-property grob 'direction))
                                  ; Calculate shift of text. This is the mean of the CP heights plus
                                  ; the extent of the text box in direction of n. As we align the text
                                  ; by it’s central point we only take half of this measure.
                                  ; h1 h2 does alread contain information about the direction,
                                  ; so we do not need to multiply with the direction
                                  (h (/ (+ h1 h2 (* dir (- mu-dist))) 2))
                                  ; final position of the text
                                  (pos (vecsum
                                        (vecscale (+ h (* dir -0.2)) n)
                                        c
                                        (vecscale -1 mucenter)))
                                  ; get potential offset from details
                                  (text-offset-X (nested-assoc-get (append details-path '(X-offset))
                                                                   (ly:grob-property grob 'details)
                                                                   0))
                                  (text-offset-Y (nested-assoc-get (append details-path '(Y-offset))
                                                                   (ly:grob-property grob 'details)
                                                                   0))
                                  (text-offset (cons text-offset-X text-offset-Y))
                                  (pos (vecsum pos text-offset))
                                  (mmu (ly:stencil-translate mu pos)))
                             (ly:stencil-add orig mmu))
                           orig))))

%%% Given a music expression return a list of all notes within
#(define (music-notes music)
   (if (music-is-of-type? music 'note-event)
       (list music)
       (let ((elts (ly:music-property music 'elements))
             (elt (ly:music-property music 'element))
             (res '()))
         (if (not (null? elt))
             (set! res (music-notes elt)))
         (append res (apply append (map music-notes elts))))))

%%% Extract symbol from grob details.prop (prop may be a list of nested keys)
#(define ((calculate-from-details prop default) grob)
   (let* ((det (ly:grob-property grob 'details))
          (default (if (procedure? default) (default grob) default))
          (spec (nested-assoc-get prop det default)))
     spec))

%%% True if (pred x) or if x is "auto"
#(define ((pred-or-auto pred) x) (or (equal? x "auto") (pred x)))

%%% Automatic hammer on / pull off. Direction and text can be provided as optional arguments or via
%%% grob.details.hopo.direction/text
%%% m2 should be a single note for placment reasons. m1 can be a longer music expression
%%% position of the text can be changed by Slur.details.hopo.X/Y-offset as well as
%%% Slur.details.hopo.rotation
hopo = #(define-music-function
        (direction str m1 m2)
        (((pred-or-auto ly:dir?) "auto")
         (markup? "auto")
         ly:music?
         ly:music?)
        ; Automatically determine string if it is "auto"
        (if (equal? str "auto")
            (let ((default ""))
              ; Get starting note of m1 and final note of m2 and determine text by pitch difference
              (let* ((n1 (music-notes m1))
                     (n1 (if (null? n1) n1 (car n1)))
                     (n2 (music-notes m2))
                     (n2 (if (null? n2) n2 (last n2))))
                (if (and (not (null? n1)) (not (null? n2)))
                    (let* ((p1 (ly:music-property n1 'pitch))
                           (p2 (ly:music-property n2 'pitch))
                           (up (ly:pitch<? p1 p2))
                           (down (ly:pitch<? p2 p1)))
                      (if up
                          (set! default "ho")
                          (if down
                              (set! default "po")
                              (set! default ""))))))
              ; If text is specified in details.hopo.text use that one
              (set! str (calculate-from-details '(hopo text) default))))
        ; Automatically determine direction if it is "auto"
        (if (equal? direction "auto")
            (set! direction (calculate-from-details '(hopo direction) ly:slur::calc-direction)))
        #{
          <>
          \tweak
          font-size
          #-2
          \tweak
          text
          #str
          \tweak
          stencil
          #(slur-with-text 'hopo)
          \tweak
          direction
          #direction
          (
          #m1
          <>)
          #m2
        #})

\new Staff {
   %% auto text and direction
   e''4 \hopo f''8 a'' \hopo a'' f'' \hopo "auto" "blu" f'' e''
   e'4 \hopo f'8 a' \hopo a' f' \hopo f' e'
   %% manual direction using arguments to \hopo
   e''4 \hopo #DOWN f''8 a'' \hopo #DOWN a'' f'' \hopo #DOWN f'' e''
   e'8 \hopo #UP f'8 a' \once\override Slur.details.hopo.rotation = #(degrees->radians 25) \hopo #UP a' f' \hopo #UP f' e'

   %% multi notes hopos
   \hopo {d'8 e'} f' \hopo {f'8 e'} d' \hopo {d'8 e'} d'

   %% Overriding direction using details
   \override Slur.details.hopo.direction = #DOWN
   e''4 \hopo f''8 a'' \hopo a'' f'' \hopo f'' e''

   %% Overriding text using details
   \override Slur.details.hopo.text = #"blu"
   e'4 \hopo f'8 a' \hopo a' f' \hopo f' e'

   \revert Slur.details.hopo.text
   \revert Slur.details.hopo.direction

   %% Some extreme positions
   \hopo d'4 f''
   \once\override Slur.details.edge-attraction-factor = #100000000
   \stemDown
   \hopo c,,,,,, c'''''''''
}

Attachment: signature.asc
Description: This is a digitally signed message part.

Reply via email to