Re: Define new articulation with markup or path (instead of glyph)

[Thomas Morley]

Hi Urs,

sorry for the late reply.
Right now I've a cold (not working in my regular job), so I've more
time to look into lilypond-tasks.
While waiting for a guile-complie to finish...

Am So., 30. Sep. 2018 um 12:01 Uhr schrieb Urs Liska <address@hidden>:

> Creating a new articulation (or overwriting the definition of an existing 
> one) seems tempting using something like
>
>     #(append! default-script-alist
>        (list
>         `("scriptDownbow"
>            . ((script-stencil . (feta . ("dfermata" . "ufermata")))
>               ; any other properties
>               (toward-stem-shift-in-column . 0.0)
>               (padding . 1)
>               (avoid-slur . around)
>               (direction . ,UP)
>               ))
>         ))
>
>     % create postfix commands to use the articulations
>     downbow = #(make-articulation "scriptDownbow")
>
> This successfully makes \downbow use the fermata instead of the regular 
> glyph. However, it seems there's no way to make that use a markup or a path 
> instead of an Emmentaler glyph (if this old information 
> (https://www.mail-archive.com/address@hidden/msg64645.html) still holds true).

Still true.
As long as you try to fill "script-stencil" you are limited to the
script-glyphs Emmentaler provides.
But there is no need to go for script-stencil, you may let it unset
and define only stencil, perhaps with different result for up/down.
See below.

[...]
> So, is there any reasonable way to create something (function, articulation, 
> dynamics) with the following characteristics:
>
> can be written like articulations/dynamics (i.e. with or without postfix 
> operator)
> can be forced to a common vertical baseline with other elements
> pushes notecolumns to obtain the necessary space (like \textLengthOn does for 
> markup)
>
> ?
>
> Any advice would be appreciated!
> Urs

In the code below two new articulations are defined: path and polygon.
The polygon-definition is after a idea by Torsten, I even extended it
a bit. Probably too complicated for a simple
proof-of-concept-example...

Nevertheless here all the code:

\version "2.19.82"

%% Not sure if needed, though, better be paranoid and work on a copy of
%% default-script-alist to avoid possible bleed-over.
#(define my-script-alist default-script-alist)

#(define my-polygon-stil
  ;; After an idea by Torsten
  ;; different stencils are returned relying on 'direction
  (lambda (grob)
    (let* ((th 0.1)
           (dir (ly:grob-property grob 'direction))
           (nmbr
             (if (positive? dir)
                 6
                 3))
           ;; Value @code{6} returns a hexagon, try others.
           (alpha-step (/ (* 2 PI) nmbr))
           (alpha-start (/ alpha-step 2))
           (radius 0.7)
           (polypoints-list
             (let loop ((alpha alpha-start))
               (if (> alpha (* 2 PI))
                   '()
                   (cons (* (abs radius) (sin alpha))
                         (cons (- 0 (* (abs radius) (cos alpha)))
                               (loop (+ alpha alpha-step)))))))
           (polypoints-pairs
             (let lp ((ppts polypoints-list))
               (if (or (null? ppts) (odd? (length polypoints-list)))
                   '()
                   (cons (cons (list-ref ppts 0) (list-ref ppts 1))
                         (lp (drop ppts 2))))))
           (x-ext
             (cons
               (reduce min +inf.0 (map car polypoints-pairs))
               (reduce max -inf.0 (map car polypoints-pairs))))
           (y-ext
             (cons
               (reduce min +inf.0 (map cdr polypoints-pairs))
               (reduce max -inf.0 (map cdr polypoints-pairs)))))

    (ly:make-stencil
      `(polygon ',polypoints-list  ,th #f)
      x-ext
      y-ext))))

#(define my-path-stil
  (lambda (grob)
    (let* ((dir (ly:grob-property grob 'direction)))
    (grob-interpret-markup grob
      #{
            \markup
              \path
              #0.17
              #`((moveto 0 0)
                (lineto ,(if (> dir 0) 0 0.75) 0.75))
      #}))))


#(define my-polygon-list
  `("polygon"
    . (
       (avoid-slur . inside)
       (padding . 0.50)
       (stencil . ,my-polygon-stil)
       (side-relative-direction . ,DOWN))))

#(define my-path-list
  `("path"
    . (
       (avoid-slur . inside)
       (padding . 0.50)
       (stencil . ,my-path-stil)
       (side-relative-direction . ,DOWN))))

%% A macro setting the lists from above in the copy of `default-script-alist´
%% For now, every new script has to be inserted in a single run.
%% TODO
%% Probably better to do simpler list processing with append, cons etc
#(define-macro (set-my-script-alist! ls-1 ls-2)
"Creates a new key-value-pair, taken from ls-2, in ls-1"
 `(set! ,ls-1
    (if (and (pair? ,ls-2) (pair? (cadr ,ls-2)))
        (assoc-set! ,ls-1 (car ,ls-2) (cdr ,ls-2))
        (begin
          (ly:warning (_"Unsuitable list\n\t~a \n\tdetected, ignoring. ") ,ls-2)
          ,ls-1))))

#(set-my-script-alist! my-script-alist my-polygon-list)
#(set-my-script-alist! my-script-alist my-path-list)


%% To use the new scripts call them in \layout
\layout {
  \context {
    \Score
    scriptDefinitions = #my-script-alist
  }
}

polygon = #(make-articulation "polygon")
path = #(make-articulation "path")

%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% EXAMPLES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% simple

{ c'4\staccato c'\path c'\polygon }

%% fancy

#(define (make-script x)
  (make-music 'ArticulationEvent
              'articulation-type x))

#(define (add-script m x)
 (cond ((eqv? (ly:music-property m 'name) 'EventChord)
        (set! (ly:music-property m 'elements)
              (append  (ly:music-property m 'elements)
                       (list (make-script x)))))
       ((eqv? (ly:music-property m 'name) 'NoteEvent)
          (set! (ly:music-property m 'articulations)
             (append  (ly:music-property m 'articulations)
                      (list (make-script x)))))
       (else #f))
 m)

addArt =
#(define-music-function (parser location type music) (string? ly:music?)
  (music-map (lambda (m) (add-script m type)) music))

mus = {
  c'8( d') e'( f') g'( a') b'( c'')
  d''( e'') f''( g'') a''( a'') r4
}

staffMus = {
  \voiceOne
  \mus
  \voiceTwo
  \mus
}

\score {
  <<
    \new Staff \addArt "staccato" \staffMus
    \new Staff \addArt "polygon" \staffMus
    \new Staff \addArt "path" \staffMus
  >>
  \layout {
    \context {
      \Voice
       \override Script.avoid-slur = #'inside
       \override Script.toward-stem-shift = 1.0
       \override Script.toward-stem-shift-in-column = 0.0
    }
  }
}

HTH,
  Harm