Thank you, Valentin. I stumbled upon this snipped a while before, and it’s 
really useful for shaping more complex slurs. Still, it’s not what I’m after, 
I’m trying to experiment, if Lilypond can find some of the more complex slur 
shapes. But for this, I have to work around the limitation that lilypond’s 
spanner-design imposes on slurs.

I’m planning to do some documentation on how you can actually use this for 
nice slurs, but for now I’ve created an example demonstrating why this does 
matter. Please take a look at the last page, it’s a comparisation of the 
shapeII-placed example from your linked post and an automatically placed one 
with two little overrides. This page demonstrates that good manual placement 
requires lots of knowledge and work, and should therefore be avoided if 
possible. If you print it out, you will see that the manually placed slurs 
actually have too uneven and too much distance from the note heads, thereby 
distracting from the actual music.

Best regards,
Valentin

Am Samstag, 16. März 2019, 20:20:15 CET schrieb Valentin Villenave:

> Another possibility would be to use polar coordinates, as Janek and
> David N. tried to do a while back:
> https://lists.gnu.org/archive/html/lilypond-user/2013-11/msg00832.html
> (That code compiles very well with 2.18, but some tweaks are needed
> for 2.19 and 2.21. It may also have some duplicate functions wrt
> polar->rectangular.)
> 
> I can’t remember that part of their code having ever been merged
> upstream, but this could provide you with an interesting starting
> point to actually get it included in LilyPond.
> 
> Cheers,
> V.
\version "2.18"

\include "shapeII-definition.ily"



\paper {
  ragged-right = ##t
  indent = 0
  top-markup-spacing #'basic-distance = #5
}

\header {
  title = "Shaping slurs: The penalty approach"
  author = "Valentin Petzel"
}
\markup \vspace #1
\markup {\italic "All examples and snippets are taken from this post:"}
\markup { \typewriter "https://lists.gnu.org/archive/html/lilypond-user/2013-11/msg00832.html"; }
\markup \vspace #1

\markup {
  \column {
  \justify {
    A slur is, from a mathematical point of view naught but a planar curve,
    that is, a function from an Interval into the plane, i.e.
    some function γ(t)=(x(t), y(t)), where the parameter t comes from an interval.
    By reparametrisation we can assume this interval to be [0, 1].
    Now, a computer cannot handle arbitrary curves just like that, that’s why we use
    very specific functions for the coordinates x and y, that is to say, polynomials
    of limited degree n (usually n = 3 for slurs).
  }
  \vspace #0.5
  \justify {
    A polynomial of degree n can be expressed as a combination of 1=X^0, X^1, ..., X^n. The
    problem with using this so called basis is that one can hardly predict the outcome of this
    combination a0 + a1·X^1 + ... + an·X^n by just looking at the coefficients a0, ..., an.
  }
  \vspace #0.5
  \justify {
    This is the reason we use so called \italic "Bézier curves" instead. This means that we
    use a different basis for our polynomials. Instead of monoms 1, X^1, ..., X^n one uses the so
    called \italic "Bernstein polynomials" of degree n. These are n+1 polynomials that form a basis,
    so we can express any polynomial of degree n as a combination of these basis polynomials.
  }
  \vspace #0.5
  \justify {
    The Bernstein polynomials B0, ..., Bn have interesting properties
    (as can be see on this image https://commons.wikimedia.org/wiki/File:Bernstein_Polynomials.svg)
    on the Interval [0, 1]: The outer polynomials B0 and Bn are 1 on one side and 0 on the other, while
    the other polynomials B1, ..., B[n-1] are 0 on both edges and have their mass concentrated on
    different parts of the interval. This means, that B0 and B1 are directly specifying the
    starting and the ending value of the polynomial, while the other polynomials will specify the
    extent on different parts of the interval.
  }
  \vspace #0.5
  \justify {
    If γ(t)=(x(t), y(t)), and both x and y are polynomials of degree n, that are parametrised as a
    combination of the Bernstein polynomials of degree b, this gives us an interesting geometric
    property:
  }
  \vspace #0.5
  \justify {
    If y = y0·B0 + ... + yn·Bn and x = x0·B0 + ... + xn·Bn, then the so called control points (x0, y0), ..., (xn, yn) 
    form a polygon, that somehow outlines the curve γ. This makes drawing Bézier curves on graphical
    systems very intuitive (and it’s basically what you get, when drawing slurs in graphical
    notation programs).
  }
  \vspace #0.8
  \justify {
    What Lilypond attempts to do is to find these control points automatically for an optimal slur. This
    is done in a typical approach: For a given curve, we calculate penalty points for everything that is
    bad about this curve, and thus get a general badness value of it. Then we try to find a curve that
    somewhat minimizes this badness. This is an optimisation problem, that usually takes some effort to
    solve, therefore we need an algorithm, that yields a sufficiently good solution in acceptable time.
    And we need a good choice of penalties, so that the calculated badness somehow reflects the actual
    badness of the slur. And this is hard, and depends strongly on the situation.
  }
  \vspace #0.8
  \justify {
    Lilypond uses parametrised penalty functions with a set of standard parameters that work in
    the most common situations, but might mess up in less common situations. See here an example
    by Janek Warchoł and David Nalesnik taken from aforementioned post:
  }
  \vspace #0.8
  }
}

SUp = \change Staff = "up"
SDn = \change Staff = "down"


\new PianoStaff <<
  \new Staff = up \relative d {
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\markup \column {
  \justify {
    As you can see, in this example the slurs minimizing the calculated badness are not in fact
    good solutions from the point of visual badness. The standard approach to solving these
    problems is manually overriding the slurs control points. Thus we might get a better slur, but we
    loose flexibility and might not be able to acheive an optimal slur.
  }
}

\pageBreak

\markup \column {
  \justify {
    Thus, Janek Warchoł and David Nalesnik created a command, that changes control points basically
    by offsetting them, retaining some aspects of automatic placement, potentially gaining robustness
    to layout changes, while also providing heavily increased control over the slur appearance.
    Here you can see their manually corrected version of the example score:
  }
  \vspace #0.5
}


\new PianoStaff <<
  \new Staff = up \relative d {
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \shapeII #'((h)(p 55 0.5)(p 50 0.2)(h 0 1.5)) Slur

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\markup \column {
  \justify {
    This slur placement is obviously much better than the automatic placement, but it would require some
    additional work, to refine these rough placement into an optimal shape.
  }
  \vspace #0.9
  \justify {
    I want to explain a totally different, but potentially more intuitive way of improving
    the output. Instead of overriding the control points themselves, one can override the
    parameter to the penalty functionals, so we can taylor Lilypond’s sense of badness to
    the situation. Lilypond does offer access to these parameter as part of the \typewriter Slur.detail
    property. The most important ones probably are:
  }
  \vspace #0.5
   \justify {\typewriter head-encompass-penalty (1000) The penalty for a slur colliding with a note head} \vspace #0.3
   \justify {\typewriter stem-encompass-penalty (30) Penalty for a slur colliding with a stem} \vspace #0.3
   \justify {\typewriter edge-attraction-factor (4) Penalty for distance between start and end points to attachment points} \vspace #0.3
   \justify {\typewriter max-slope (1.1) Specifies the maximal slope allowed} \vspace #0.3
   \justify {\typewriter max-slope-factor (10) Multiplier for the penalty applied if the slope is larger than \typewriter max-slope} \vspace #0.3
   \justify {\typewriter free-head-distance (0.3) The minimal distance between heads and the slur} \vspace #0.3
   \justify {\typewriter free-slur-distance (0.8) The minimal distance between adjacent slurs} \vspace #0.3
   \justify {\typewriter gap-to-staffline-inside (0.2) The minimal distance between the extremal point of the slur (where slur and stafflines are parallel)
     and stafflines inside the curve} \vspace #0.3
   \justify {\typewriter gap-to-staffline-outside (0.1) The same for stafflines outside the curve} \vspace #0.3
   \justify {\typewriter extra-object-collision-penalty (50) penalty for collision with extra objects like articulation marks} \vspace #0.3
   \justify {\typewriter accidental-collision (3) Factor for penalty for collisions with accidentals} \vspace #0.3
   \justify {\typewriter extra-encompass-free-distance (0.3) minimal distance to all kinds of stuff around the slur} \vspace #0.3
   \justify {\typewriter head-slur-distance-max-ratio (3) The maximal allowed ratio between distances between heads and slur (trying to have slur somewhat equally close to all heads)} \vspace #0.3
   \justify {\typewriter head-slur-distance-factor (10) Factor for penalty if the ratio is to high} \vspace #0.3
   \justify {\typewriter absolute-closeness-measure (0.3) penalty for high total distance to heads} \vspace #0.3
   \justify {\typewriter edge-slope-exponent (1.7) factor for penalty for big slopes near the edge points} \vspace #0.3
   \vspace #0.5
}
\markup {For a complete list see:}\markup \typewriter "http://lilypond.org/doc/v2.19/Documentation/internals/slur_002dinterface";

\markup\vspace #0.5

\markup "Now, let’s apply this to the example:"

\new PianoStaff <<
  \new Staff = up \relative d {
    
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\pageBreak 

\markup\justify {The most obvious problem is, that the distance between the edge points and the
                 slur is too small. So let’s increase the edge-attraction-factor:}
\markup \typewriter "\override Slur.details.edge-attraction-factor = #6"

\new PianoStaff <<
  \new Staff = up \relative d {
    \override Slur.details.edge-attraction-factor = #6
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\markup \justify {For reasons of legibility we might want to increase the distance to the note heads:}
\markup \typewriter "\override Slur.details.free-head-distance = #1.2"

\new PianoStaff <<
  \new Staff = up \relative d {
    \override Slur.details.edge-attraction-factor = #6
    \override Slur.details.free-head-distance = #1.2
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\markup\justify {
  As you can see, we managed to get beautyful slurs, just by intuitively overriding two simple properties. 
}
\pageBreak
\markup "For comparisation:"
\markup "Unmodified:"
\new PianoStaff <<
  \new Staff = up \relative d {
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>
\markup "Manually shaped:"
\new PianoStaff <<
  \new Staff = up \relative d {
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \shapeII #'((h)(p 55 0.5)(p 50 0.2)(h 0 1.5)) Slur

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>
\markup "Overridden penalty for edge distance:"
\new PianoStaff <<
  \new Staff = up \relative d {
    \override Slur.details.edge-attraction-factor = #6
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>

\markup "+Overriden slur distance"

\new PianoStaff <<
  \new Staff = up \relative d {
    \override Slur.details.edge-attraction-factor = #6
    \override Slur.details.free-head-distance = #1.2
    \clef G
    \key e \major
    \time 3/16

    \voiceTwo
    \slurUp

    \SDn \times 2/3 { b32( g' b }
    \SUp \times 2/3 { d g e' }
    \times 2/3 { d b g') }
    |
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
    |
    \newSpacingSection
    \override Score.SpacingSpanner #'common-shortest-duration =
    #(ly:make-moment 1 70)
    \SDn \times 2/3 { b,,,32( g' b }
    \SUp \times 2/3 { dis g e' }
    \times 2/3 { d b g') }
  }
  \new Staff = down {
    \clef F
    \key e \major
    \time 3/16

    s16*9
  }
>>
\version "2.17.29"
% Prior to 2.17.29, \shapeII ... Slur (i.e. the non-tweak syntax)
% will probably affect only the first slur in each example.

\header {
  snippet-title = "Improved \shape"
  snippet-author = "Janek Warchoł, David Nalesnik"
}

% This is a duplication of code introduced for \offset.
% TODO: make that function (in scm/music-functions.scm) define-public
#(define (find-value-to-offset prop self alist)
   "Return the first value of the property @var{prop} in the property
                     alist @var{alist} @em{after} having found @var{self}."
(let ((segment (member (cons prop self) alist)))
  (if (not segment)
      (assoc-get prop alist)
      (assoc-get prop (cdr segment)))))

% Return the dir-most head from note-column.
% TODO: implement in C++ with a Scheme interface.
#(define (get-extremal-head note-column dir)
   (let ((elts (ly:grob-object note-column 'elements))
         (init -inf.0)
         (result #f))
     (for-each
      (lambda (idx)
        (let* ((elt (ly:grob-array-ref elts idx)))
          (if (grob::has-interface elt 'note-head-interface)
              (let ((off (ly:grob-property elt 'Y-offset)))
                (if (> (* off dir) init)
                    (begin
                     (set! init off)
                     (set! result elt)))))))
      (reverse (iota (ly:grob-array-length elts))))
     result))

shapeII =
#(define-music-function (parser location all-specs item)
   (list? symbol-list-or-music?)
   (_i "TODO: write description when finished")

   (define (single-point-spec? x)
     (or (number-pair? x)
         (and (not (null? x))
              (or (number? (car x))
                  (symbol? (car x))))))

   (define (shape-curve grob)
     (let* ((orig (ly:grob-original grob))
            (siblings (if (ly:spanner? grob)
                          (ly:spanner-broken-into orig) '()))
            (total-found (length siblings))
            (immutable-props (ly:grob-basic-properties grob))
            (value (find-value-to-offset 'control-points shape-curve 
immutable-props))
            (default-cpts (if (procedure? value)
                              (value grob)
                              value))
            (slur-dir (ly:grob-property grob 'direction)))

       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;
       ;; functions for handling various types of specs: ;;;;;;;;;

       ;; flips offset values for right points and downward slurs
       (define (symmetrical-offset coords offs side)
         (cons (+ (car coords)(* -1 side (second offs)))
           (+ (cdr coords) (* slur-dir (third offs)))))

       ;; position a cpt in polar coordinates.
       (define (polar-coords points spec side absolute?)
         (let* ((x-dif (- (car (last points)) (car (first points))))
                (y-dif (- (cdr (last points)) (cdr (first points))))
                (slur-length (sqrt (+ (expt x-dif 2) (expt y-dif 2))))
                (radius (* slur-length (third spec)))
                (ref-slope (if absolute? 0 (atan (/ y-dif x-dif))))
                (angl (+ (degrees->radians (second spec))
                        (* -1 side ref-slope slur-dir)))
                (ref-pt (if (= LEFT side)
                            (first points)
                            (last points)))
                (x-coord (- (car ref-pt) (* side radius (cos angl))))
                (y-coord (+ (cdr ref-pt) (* slur-dir radius (sin angl)))))
           (cons x-coord y-coord)))

       ;; adjust a middle cpt relative to its default polar-coordinates.
       ;; TODO: merge with the function above?
       (define (rel-polar-coords points spec side)
         (let* ((point1 (if (= LEFT side)
                            (first default-cpts)
                            (last default-cpts)))
                (point2 (if (= LEFT side)
                            (second default-cpts)
                            (third default-cpts)))
                (x-dif (- (car point2) (car point1)))
                (y-dif (- (cdr point2) (cdr point1)))
                (dist (sqrt (+ (expt x-dif 2) (expt y-dif 2))))
                (radius (* dist (third spec)))
                (ref-slope (atan (/ y-dif x-dif)))
                (angl (+ (degrees->radians (second spec))
                        (* -1 side ref-slope slur-dir)))

                (x-coord (- (car point1) (* side radius (cos angl))))
                (y-coord (+ (cdr point1) (* slur-dir radius (sin angl)))))
           (cons x-coord y-coord)))

       ;; place slur end relative to the notehead.
       (define (notehead-placement default spec side)
         (let* ((get-name (lambda (x) (assq-ref (ly:grob-property x 'meta) 
'name)))
                (bound (ly:spanner-bound grob side))
                (bound-name (get-name bound)))
           (if (not (eq? bound-name 'NoteColumn))
               default
               (let* ((head (get-extremal-head bound slur-dir))
                      (yoff (if (<= 2 (length spec))
                                (third spec)
                                1.2))
                      (xoff (if (<= 3 (length spec))
                                (second spec)
                                0))
                      ;; in case of cross-staff curves:
                      (refp (ly:grob-system grob))
                      (ref-bound (ly:spanner-bound grob LEFT))
                      (ref-y (ly:grob-relative-coordinate ref-bound refp Y))
                      (my-y (ly:grob-relative-coordinate bound refp Y))
                      (cross-staff-correction (- my-y ref-y))
                      ;; UGH!! I have no idea why this is needed, but without 
this correction
                      ;; the example below renders wrongly:
                      ;; { d''1-\shapeII #'(() (()()()(head))) ( f'' \break a'' 
g'') }
                      ;; the if clause is necessary because otherwise the 'fix' 
will
                      ;; break the cross-staff case.  UGH!!
                      (ugh-correction
                       (if (ly:grob-property grob 'cross-staff) ; returns 
boolean
                           0.0
                           (- (car (ly:grob-property bound 'Y-extent))
                             (car (ly:grob-extent bound refp Y)))))
                      (cross-staff-correction (+ cross-staff-correction 
ugh-correction))

                      (head-yoff (+ (ly:grob-property head 'Y-offset)
                                   cross-staff-correction))
                      (head-yext (coord-translate
                                  (ly:grob-property head 'Y-extent)
                                  head-yoff))
                      (head-y-mid (+ (* 0.5 (car head-yext))
                                    (* 0.5 (cdr head-yext))))

                      (ref-x (ly:grob-relative-coordinate ref-bound refp X))
                      (head-x (ly:grob-relative-coordinate head refp X))
                      (head-xoff (- head-x ref-x))
                      (head-xext (coord-translate
                                  (ly:grob-property head 'X-extent)
                                  head-xoff))
                      (head-x-mid (+ (* 0.5 (car head-xext))
                                    (* 0.5 (cdr head-xext)))))
                 (cons (+ (* -1 side xoff) head-x-mid)
                   (+ (* slur-dir yoff) head-y-mid))))))

       ;; end of functions for handling specs. ;;;;;;;;;;;;;;;;;;;
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;

       ;; does this spec start with specified symbol?
       ;; TODO: check other list elements
       (define (spec-type? spec symbol-list)
         (and (list? spec)
              (symbol? (first spec))
              (member (first spec) symbol-list)))

       (define (calc-one-point current-state specifications which-point)
         (if (null? specifications)
             (list-ref current-state which-point)
             (let ((coords (list-ref current-state which-point))
                   (spec (list-ref specifications which-point))
                   (side (if (< 1 which-point) RIGHT LEFT)))
               (cond
                ((null? spec) coords)
                ((number-pair? spec)
                 (coord-translate coords spec))
                ((number-list? spec) ; 2-elem list -> pair:
                 (coord-translate coords (cons (first spec)(second spec))))
                ((spec-type? spec '(s sym symmetrical))
                 (symmetrical-offset coords spec side))
                ((spec-type? spec '(a abs absolute))
                 (cons (second spec)(third spec)))
                ((spec-type? spec '(p polar))
                 (polar-coords current-state spec side #f))
                ((spec-type? spec '(ap absolute-polar))
                 (polar-coords current-state spec side #t))
                ((spec-type? spec '(rp relative-polar))
                 (rel-polar-coords current-state spec side))
                ((spec-type? spec '(h head))
                 (notehead-placement coords spec side))
                (else (begin
                       (ly:programming-error
                        (_ "unknown control-point instruction type: ~a\nUsing 
default coordinates for control-point ~a.")
                        spec
                        (+ which-point 1))
                       coords))))))

       (define (calc-one-sibling specs)
         ;; 'specs' is a set of instructions for one sibling.
         (let ((new-cpts default-cpts)
               ;; make \shape #'((foo)) equivalent to \shape #'((foo foo foo 
foo))
               ;; and \shape #'((foo bar)) to \shape #'((foo bar bar foo)):
               (specs (cond
                       ((= 1 (length specs))
                        (make-list 4 (car specs)))
                       ((= 2 (length specs))
                        (list (first specs)
                          (second specs)
                          (second specs)
                          (first specs)))
                       ((= 3 (length specs))
                        (append specs '(())))
                       (else specs))))

           ;; In some cases (most notably when using polar coordinates),
           ;; middle cpts need to access information that is available
           ;; only after processing outer cpts (e.g. slur length).
           (list-set! new-cpts 0 (calc-one-point new-cpts specs 0))
           (list-set! new-cpts 3 (calc-one-point new-cpts specs 3))
           (list-set! new-cpts 1 (calc-one-point new-cpts specs 1))
           (list-set! new-cpts 2 (calc-one-point new-cpts specs 2))
           new-cpts))

       (define (find-specs-for-current-sibling sibs specs)
         (if (pair? specs)
             (if (eq? (car sibs) grob)
                 (calc-one-sibling (car specs))
                 (find-specs-for-current-sibling (cdr sibs) (cdr specs)))
             default-cpts))

       ;; normalize all-specs:
       (if (or (null? all-specs)
               (any single-point-spec? all-specs))
           (set! all-specs (list all-specs)))

       ;; if there are more siblings than specifications,
       ;; reuse last specification for remaining siblings.
       (if (> (- total-found (length all-specs)) 0)
           (append! all-specs
             (list (last all-specs))))

       (if (>= total-found 2)
           (find-specs-for-current-sibling siblings all-specs)
           (calc-one-sibling (car all-specs)))))

   #{ \tweak control-points #shape-curve #item #})

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

_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel

Reply via email to