Balken mit Kurven [gelöst]

Begonnen von kilgore, Montag, 1. Mai 2017, 15:41

« vorheriges - nächstes »

kilgore

Liebes Forum,

Ich freue mich sehr zum ersten mal in das neue Forum zu posten, freue mich auch über die Abteilung für neue Musik.

Ich suche ein bessere Methode um alternative Balken-Linien zu machen. Ein Komponist für den ich Noten setze nutzt oft kurvige, wellen-artige Balken um eine ungleichmäßige Ausführung von (zB) Achteln zu notieren. Mit Stift und Papier ist das Kinderleicht, im Computersatz aber eine Herausforderung.

Meine Methode mit Postscript ist irgendwie schon OK, aber äußerst mühsam und unpraktisch. Mit Copy/Paste komme ich gut klar, aber die Höhe und Länge müssen immer angepasst werden und letztlich sieht es nicht so toll aus wie es könnte. Außerdem geht es nur bei Waagerechte Balken. Hat jemand vielleicht eine Idee wie man das schneller und leichter lösen könnte?


\version "2.18.2"


\relative c' {
  \stemUp
  \once \override Beam #'transparent = ##t
  \once \override TextScript #'Y-extent = #'( 0 . 0 )
  \once \override TextScript #'extra-offset = #'( 0.1 . 1.3 )
  c'8[^\markup {
    \postscript #"
        .5 setlinewidth
        1.1 -1.1 moveto
.2 0 rlineto
        .75 .75 1.5 -.75 2.25 0 rcurveto
.75 .75 1.5 -.75 2.25 0 rcurveto
.75 .75 1.5 -.75 2.25 0 rcurveto
.75 .75 1.5 -.75 2.25 0 rcurveto
        .75 .75 1.5 -.75 2.25 0 rcurveto
        .75 .75 1.5 -.75 2.25 0 rcurveto
        .75 .75 1.5 -.75 2.25 0 rcurveto
.75 .75 1.5 -.75 1.6 0 rcurveto

.2 0 rlineto
        stroke"
  }
  c c c c c c c]
}



Vielen Dank!
kil

Hilflos-im-Code

Ich gehe mal bei deiner Beschreibung davon aus, dass das nicht so regelmäßig aussehen soll, wie im Minimalbeispiel.

Pragmatisch gesehen könnte es ganz klug sein, die Noten als Svg zu kompilieren und dann in Inkscape die Balken zu bearbeiten.

harm6

Hallo kil :D

schön Dich hier zu sehen!

Ich hab mal das angehängte Bild produziert. (mittels draw-squiggle-line als stencil-override)

Du siehst, daß die Notenhälse manchmal überstehen.

Man könnte das vielleicht lösen, indem man dafür Sorge trägt, daß ein Hals immer auf einen nach außen weisenden Kurvenbauch trifft. Das würde aber wahrscheinlich ein unregelmäßiges Bild ergeben.
Die Stemlängen so neu zu berechnen, daß sie immer passen wäre eine Heidenarbeit, bei der ich momentan noch nicht mal weiß wie man das angehen könnte.

Generell ist draw-squiggle-line wohl auch nicht die richtige Methode, da müßte man was neues erfinden.
Du möchtest wahrscheinlich auch mehr als einen Balken für 16-tel und kürzer setzen können, vielleicht auch kneed-beams...
Mach es nicht einfacher ;)

Aber ich denk' mal weiter drüber nach...

Gruß,
  Harm

Falls es jemanden interessiert hier der code zum Bild:

\version "2.19.56"

\relative c' {
  \stemUp
  \once \override Beam.stencil =
  #(lambda (grob)
    (let* ((default-stil (ly:beam::print grob))
           (x-pos (ly:grob-property grob 'X-positions))
           (y-pos (ly:grob-property grob 'positions)))
   (ly:stencil-translate-axis
     (grob-interpret-markup grob
       (markup
         #:override '(thickness . 1.4)
         #:override '(height . 0.3)
         #:draw-squiggle-line
         1
         (cons (- (interval-length x-pos) 0.1) (interval-length y-pos))
         #t))
      0.76 ;; (beam-thickness * 2) - (line-thickness * 2)
      Y)))
   
  c8[ d e f g a b]
}


kilgore

Hey harm6!

Nach genau so eine Lösung habe ich gesucht! Da muss ich aber wohl auf die Entwickler-Version updaten, draw-squiggle-line gibt es wohl noch nicht im Stabilen-Version.

Das Problem mit den Hälsen habe ich auch mit meiner Lösung. Wenn die Squiggle-Linie dicker ist könnte man das vielleicht damit schon lösen, dazu den Balken leicht nach oben/unten schieben. Auf jeden Fall viel weniger Arbeit als ich schon jetzt damit habe...

Kann man das draw-squiggle-line irgendwie in 2.18 bzw. in meinem .ly Datei importieren?

Danke danke!!
LG
kil

harm6

ZitatKann man das draw-squiggle-line irgendwie in 2.18 bzw. in meinem .ly Datei importieren?

Ja, aber draw-squiggle-line verwendet, make-bow-stencil und make-bezier-sandwich-stencil (alle von mir bzw von mir gepatched).
make-bezier-sandwich-stencil fusst jetzt aber auf make-path-stencil (nicht von mir) welcher einen Haufen anderer nicht öffentlicher Funktionen benötigt.

Aber ja es geht, siehe unten.
Ich habe dann auf die Schnelle noch eine Möglichkeit eingebaut die "Strichstärke" zu verändern nicht nur die thickness. (Entspricht bei Slurs dem Unterschied von line-thickness und thickness).
Noch bin ich nicht daran gegangen den neuen Beam wirklich passgenau zu gestalten, auch sind zwei oder mehr z.Zt noch nicht möglich.
Getestet ist auch nur das angegebene Beispiel.
Aber das sollte jetzt auch unter 2.18.2 laufen :)


\version "2.18.2"

#(define (sign x)
  (if (= x 0)
      0
      (if (< x 0) -1 1)))
     
#(define (line-part-min-max x1 x2)
  (list (min x1 x2) (max x1 x2)))
     
#(define (bezier-part-min-max x1 x2 x3 x4)
  ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
   (map
    (lambda (x)
      (+ (* x1 (expt (- 1 x) 3))
         (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
            (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
               (* x4 (expt x 3))))))
    (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
           (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
        (list 0.0 1.0)
        (filter
         (lambda (x) (and (>= x 0) (<= x 1)))
         (append
          (list 0.0 1.0)
          (map (lambda (op)
                 (if (not (eqv? 0.0
                                (exact->inexact (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
                     ;; Zeros of the bezier curve
                     (/ (+ (- x1 (* 2 x2))
                           (op x3
                               (sqrt (- (+ (expt x2 2)
                                           (+ (expt x3 2) (* x1 x4)))
                                        (+ (* x1 x3)
                                           (+ (* x2 x4) (* x2 x3)))))))
                        (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
                     ;; Apply L'hopital's rule to get the zeros if 0/0
                     (* (op 0 1)
                        (/ (/ (- x4 x3) 2)
                           (sqrt (- (+ (* x2 x2)
                                       (+ (* x3 x3) (* x1 x4)))
                                    (+ (* x1 x3)
                                       (+ (* x2 x4) (* x2 x3)))))))))
               (list + -))))))))
     
#(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
  (map (lambda (x)
         (apply bezier-part-min-max x))
       `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))

#(define (line-min-max x1 y1 x2 y2)
  (map (lambda (x)
         (apply line-part-min-max x))
       `((,x1 ,x2) (,y1 ,y2))))
     
#(define (path-min-max origin pointlist)

  ((lambda (x)
     (list
      (reduce min +inf.0 (map caar x))
      (reduce max -inf.0 (map cadar x))
      (reduce min +inf.0 (map caadr x))
      (reduce max -inf.0 (map cadadr x))))
   (map (lambda (x)
          (if (= (length x) 8)
              (apply bezier-min-max x)
              (apply line-min-max x)))
        (map (lambda (x y)
               (append (list (cadr (reverse x)) (car (reverse x))) y))
             (append (list origin)
                     (reverse (cdr (reverse pointlist)))) pointlist))))
     
#(define-public (make-path-stencil path thickness x-scale y-scale fill)
  "Make a stencil based on the path described by the list @var{path},
with thickness @var{thickness}, and scaled by @var{x-scale} in the X
direction and @var{y-scale} in the Y direction.  @var{fill} is a boolean
argument that specifies if the path should be filled.  Valid path
commands are: moveto rmoveto lineto rlineto curveto rcurveto closepath,
and their standard SVG single letter equivalents: M m L l C c Z z."

  (define (convert-path path origin previous-point)
    "Recursive function to standardize command names and
convert any relative path expressions (in @var{path}) to absolute
values.  Returns a list of lists.  @var{origin} is a pair of x and y
coordinates for the origin point of the path (used for closepath and
reset by moveto commands).  @var{previous-point} is a pair of x and y
coordinates for the previous point in the path."
    (if (pair? path)
        (let*
         ((head-raw (car path))
          (rest (cdr path))
          (head (cond
                 ((memq head-raw '(rmoveto M m)) 'moveto)
                 ((memq head-raw '(rlineto L l)) 'lineto)
                 ((memq head-raw '(rcurveto C c)) 'curveto)
                 ((memq head-raw '(Z z)) 'closepath)
                 (else head-raw)))
          (arity (cond
                  ((memq head '(lineto moveto)) 2)
                  ((eq? head 'curveto) 6)
                  (else 0)))
          (coordinates-raw (take rest arity))
          (is-absolute (if (memq head-raw
                           '(rmoveto m rlineto l rcurveto c)) #f #t))
          (coordinates (if is-absolute
                           coordinates-raw
                           ;; convert relative coordinates to absolute by
                           ;; adding them to previous point values
                           (map (lambda (c n)
                                  (if (even? n)
                                      (+ c (car previous-point))
                                      (+ c (cdr previous-point))))
                             coordinates-raw
                             (iota arity))))
          (new-point (if (eq? head 'closepath)
                         origin
                         (cons
                          (list-ref coordinates (- arity 2))
                          (list-ref coordinates (- arity 1)))))
          (new-origin (if (eq? head 'moveto)
                          new-point
                          origin)))
         (cons (cons head coordinates)
           (convert-path (drop rest arity) new-origin new-point)))
        '()))

  (let* ((path-absolute (convert-path path (cons 0 0) (cons 0 0)))
         ;; scale coordinates
         (path-scaled (if (and (= 1 x-scale) (= 1 y-scale))
                          path-absolute
                          (map (lambda (path-unit)
                                 (map (lambda (c n)
                                        (cond
                                         ((= 0 n) c)
                                         ((odd? n) (* c x-scale))
                                         (else (* c y-scale))))
                                   path-unit
                                   (iota (length path-unit))))
                            path-absolute)))
         ;; a path must begin with a 'moveto'
         (path-final (if (eq? 'moveto (car (car path-scaled)))
                         path-scaled
                         (append (list (list 'moveto 0 0)) path-scaled)))
         ;; remove all commands in order to calculate bounds
         (path-headless (map cdr (delete (list 'closepath) path-final)))
         (bound-list (path-min-max
                      (car path-headless)
                      (cdr path-headless))))
    (ly:make-stencil
     `(path ,thickness
        `(,@',(concatenate path-final))
        'round
        'round
        ,(if fill #t #f))
     (coord-translate
      ((if (< x-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 0)
        (list-ref bound-list 1)))
      `(,(/ thickness -2) . ,(/ thickness 2)))
     (coord-translate
      ((if (< y-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 2)
        (list-ref bound-list 3)))
      `(,(/ thickness -2) . ,(/ thickness 2))))))
     
#(define (make-bezier-sandwich-stencil coords thick)
   (make-path-stencil
       `(moveto
           ,(car (list-ref coords 0))
           ,(cdr (list-ref coords 0))
         curveto
           ,(car (list-ref coords 1))
           ,(cdr (list-ref coords 1))
           ,(car (list-ref coords 2))
           ,(cdr (list-ref coords 2))
           ,(car (list-ref coords 3))
           ,(cdr (list-ref coords 3))
         curveto
           ,(car (list-ref coords 4))
           ,(cdr (list-ref coords 4))
           ,(car (list-ref coords 5))
           ,(cdr (list-ref coords 5))
           ,(car (list-ref coords 0))
           ,(cdr (list-ref coords 0))
         closepath)
       thick
       1
       1
       #t))

#(define* (make-bow-stencil
           start stop thickness angularity bow-height orientation
           #:optional (line-width 0.1))
  "Create a bow stencil.
It starts at point @var{start}, ends at point @var{stop}.
@var{thickness} is the thickness of the bow.
The higher the value of number @var{angularity}, the more angular the shape of
the bow.
@var{bow-height} determines the height of the bow.
@var{orientation} determines, whether the bow is concave or convex.
Both variables are supplied to support independent usage.

Done by calculating a horizontal unit-bow first, then moving all control-points
to the correct positions.
Limitation: s-curves are currently not supported.
"

;;;; Coding steps:
;;;; (1) calculate control-points for a "unit"-bow from '(0 . 0) to '(1 . 0)
;;;;     user settable `bow-height' and `thickness' are scaled down.
;;;; (2) move control-points to match `start' and `stop'

  (let* (;; REMARK
         ;; 'line-width' is now an optional argument
         ;; we use a fixed line-width as border for different behaviour
         ;; for larger and (very) small lengths
         ;(line-width 0.1)
         ;; `start'-`stop' distances
         (dx (- (car stop) (car start)))
         (dy (- (cdr stop) (cdr start)))
         (length-to-print (magnitude (make-rectangular dx dy))))

    (if (= 0 length-to-print)
        empty-stencil
        (let* (
          ;;;; (1) calculate control-points for the horizontal unit-bow,
               ;; y-values for 2nd/3rd control-points
               (outer-control
                 (* 4/3 (sign orientation) (/ bow-height length-to-print)))
               (inner-control
                 (* (sign orientation)
                    (- (abs outer-control) (/ thickness length-to-print))))
               ;; x-values for 2nd/3rd control-points depending on `angularity'
               (offset-index
                 (- (* 0.6 angularity) 0.8))
               (left-control
                 (+ 0.1 (* 0.3 angularity)))
               (right-control
                 (- 1 left-control))
               ;; defining 2nd and 3rd outer control-points
               (left-outer-control-point
                 (cons left-control outer-control))
               (right-outer-control-point
                 (cons right-control outer-control))
               ;; defining 2nd and 3rd inner control-points
               (left-inner-control-point
                 (cons left-control inner-control))
               (right-inner-control-point
                 (cons right-control inner-control))
               (coord-list
                 (list
                   '(0 . 0)
                   left-outer-control-point
                   right-outer-control-point
                   '(1 . 0)
                   right-inner-control-point
                   left-inner-control-point))
               ;;;; (2) move control-points to match `start' and `stop'
               (moved-coord-list
                 (map
                   (lambda (p)
                     (cons
                       (+ (car start) (- (* (car p) dx) (* (cdr p) dy)))
                       (+ (cdr start) (+ (* (car p) dy) (* (cdr p) dx)))))
                   coord-list)))

          ;; final stencil
          (make-bezier-sandwich-stencil
            moved-coord-list
            (min (* 2 thickness) line-width))))))
           
#(define-markup-command (draw-squiggle-line layout props sq-length dest eq-end?)
  (number? number-pair? boolean?)
  #:category graphic
  #:properties ((thickness 0.5)
                (angularity 0)
                (height 0.5)
                (orientation 1)
                ;; added
                (line-width 0.1)
                )
  "
@cindex drawing squiggled lines within text

A squiggled line.

If @code{eq-end?} is set to @code{#t}, it is ensured the squiggled line ends
with a bow in same direction as the starting one.  @code{sq-length} is the
length of the first bow.  @code{dest} is the end point of the squiggled line.
To match @code{dest} the squiggled line is scaled accordingly.
Its appearance may be customized by overrides for @code{thickness},
@code{angularity}, @code{height} and @code{orientation}.
@lilypond[verbatim,quote]
\\markup
  \\column {
    \\draw-squiggle-line #0.5 #'(6 . 0) ##t
    \\override #'(orientation . -1)
    \\draw-squiggle-line #0.5 #'(6 . 0) ##t
    \\draw-squiggle-line #0.5 #'(6 . 0) ##f
    \\override #'(height . 1)
    \\draw-squiggle-line #0.5 #'(6 . 0) ##t
    \\override #'(thickness . 5)
    \\draw-squiggle-line #0.5 #'(6 . 0) ##t
    \\override #'(angularity . 2)
    \\draw-squiggle-line #0.5 #'(6 . 0) ##t
  }
@end lilypond"
  (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness))
         (thick (* thickness line-thickness))
         (x (car dest))
         (y (cdr dest))
         (length-to-print (magnitude (make-rectangular x y)))
         ;; Make a guess how many bows may be needed
         (guess (max 1 (truncate (/ length-to-print sq-length))))
         ;; If `eq-end?' is set #t, make sure squiggle-line starts and ends
         ;; with a bow in same direction
         (amount (if (and (even? guess) eq-end?) (1+ guess) guess))
         ;; The lined-up bows needs to fit `length-to-print'
         ;; Thus scale the length of first bow accordingly
         ;; Other bows are copies
         (guessed-squiggle-line-length (* amount sq-length))
         (line-length-diff (- length-to-print guessed-squiggle-line-length))
         (line-length-diff-for-each-squiggle
           (/ line-length-diff amount))
         (first-bow-length (+ sq-length line-length-diff-for-each-squiggle))
         ;; Get first bows
         ;; TODO two bows are created via `make-bow-stencil'
         ;;      cheaper to use `ly:stencil-scale'?
         (first-bow-end-coord
           (cons
             (/ (* first-bow-length x) length-to-print)
             (/ (* first-bow-length y) length-to-print)))
         (init-bow
           (lambda (o)
             (make-bow-stencil
               '(0 . 0)
               first-bow-end-coord
               thick angularity height o line-width)))
         (init-bow-up (init-bow orientation))
         (init-bow-down (init-bow (- orientation)))
         ;; Get a list of starting-points for the bows
         (list-of-starts
           (map
             (lambda (n)
               (cons
                 (* n (car first-bow-end-coord))
                 (* n (cdr first-bow-end-coord))))
             (iota amount))))
    ;; The final stencil: lined-up bows
    (apply ly:stencil-add
      (map
        ly:stencil-translate
        (circular-list init-bow-up init-bow-down)
        list-of-starts))))
       
       

\relative c' {
  \stemUp
  \once \override Beam.stencil =
  #(lambda (grob)
    (let* ((default-stil (ly:beam::print grob))
           (x-pos (ly:grob-property grob 'X-positions))
           (y-pos (ly:grob-property grob 'positions)))
   (ly:stencil-translate-axis
     (grob-interpret-markup grob
       (markup
         ;; customize thickness line-width height angularity:
         #:override '(thickness . 1.4)
         #:override '(line-width . 1.6)
         #:override '(height . 0.3)
         #:override '(angularity . 0.6)
         ;; defaults:
         ;#:override '(orientation . 1)
         #:draw-squiggle-line
           ;; sq-length
           1.1
           ;; dest
           (cons (- (interval-length x-pos) 0.1) (interval-length y-pos))
           ;; eq-end?
           #t))
      ;; move in Y-direction
      0.76 ;; (beam-thickness * 2) - (line-thickness * 2)
      Y)))
   
  c8[ d e f g a b]
}


Aber angesichts dieser geballten Ladung von scheme-code ...
Willst Du nicht upgraden? Du bräuchtest immer noch obige Fassungen von make-bow-stencil und draw-squiggle-line, aber den Rest hättest Du gespart.

Gruß,
  Harm

kilgore

Lieber Harm,

Tausend Dank, du bist wirklich ein Schatz für dieses Forum! Das ist für meine Zwecke perfekt. 16tel Balken usw. brauche ich erstmal gar nicht. Du hast mir eine Menge Zeit gespart!   :D :D :D

ZitatWillst Du nicht upgraden?

Naja, vielleicht sollte ich es wieder mit zwei Versionen in Frescobaldi versuchen. Ich nutze Lilypond "professionell" für offizielle Aufträge und mach mir beim Entwickler-Version immer sorgen, dass es später nicht mehr Kompatibel ist.... mal schauen...

Gruß
kilgore

harm6

Hallo,

ich hab noch weiter daran gearbeitet. Im Anhang das bisherige Ergebnis.
Funktioniert jetzt auch für 16-tel und kleiner. Ist aber nicht robust gegen fontSize-Änderungen etc.

Auch bin ich unsicher wie ich einen speziellen Punkt regeln soll:
Im Beispiel gilt ragged-right = ##t
Setzt man es ##f, so werden einfach weiter squiggle hinzugefügt.
D.h. die squiggle-Länge ist absolut, nicht relativ zur Beam-Länge.
Wäre es relativ zur Beam-Länge würden keine squiggle hinzugefügt, sondern sie vorhandenen gestreckt.

Probier es aus und sag mir dann wie Du es haben willst.

Gruß,
  Harm

kilgore

Wow, genau das wollte ich erzeugen können! Wirklich hervorragend. Ich mag es, dass ich die Wellen anpassen können...relativ zu Beam-Länge wäre aus meiner Sicht unnötig. Die folgende Werte finde ich am Ergebnis gerade ganz hübsch: \squiggleBeam #0.2 #0.5 #4

Was macht eigentlich das erste Wert? Beim rumprobieren ändert sich im Ergebnis gar nichts, wenn man das erste Wert ändert....

Malte

Zitat von: kilgore am Dienstag,  2. Mai 2017, 14:55
Was macht eigentlich das erste Wert? Beim rumprobieren ändert sich im Ergebnis gar nichts, wenn man das erste Wert ändert....
Probier mal mit sehr kleinen Werten wie 0.01 rum ;)

harm6

#9
Hier das beste was ich hinkriege.
Sollte jetzt wesentlich robuster sein und auch mit kneed-beams funktionieren.
Beachte das die Argumente von 'squiggleBeam' verändert sind, siehe Kommentar dort.
Ebenfalls im Code eine Funktion mit der Du die Länge der Notenhälse korrigieren kannst. Ist aber momentan nirgendwo angewendet, um erst mal das Bild an sich klar zu machen.


\version "2.18.2"

#(define (sign x)
  (if (= x 0)
      0
      (if (< x 0) -1 1)))
     
#(define (line-part-min-max x1 x2)
  (list (min x1 x2) (max x1 x2)))
     
#(define (bezier-part-min-max x1 x2 x3 x4)
  ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
   (map
    (lambda (x)
      (+ (* x1 (expt (- 1 x) 3))
         (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
            (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
               (* x4 (expt x 3))))))
    (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
           (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
        (list 0.0 1.0)
        (filter
         (lambda (x) (and (>= x 0) (<= x 1)))
         (append
          (list 0.0 1.0)
          (map (lambda (op)
                 (if (not (eqv? 0.0
                                (exact->inexact
                                  (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
                     ;; Zeros of the bezier curve
                     (/ (+ (- x1 (* 2 x2))
                           (op x3
                               (sqrt (- (+ (expt x2 2)
                                           (+ (expt x3 2) (* x1 x4)))
                                        (+ (* x1 x3)
                                           (+ (* x2 x4) (* x2 x3)))))))
                        (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
                     ;; Apply L'hopital's rule to get the zeros if 0/0
                     (* (op 0 1)
                        (/ (/ (- x4 x3) 2)
                           (sqrt (- (+ (* x2 x2)
                                       (+ (* x3 x3) (* x1 x4)))
                                    (+ (* x1 x3)
                                       (+ (* x2 x4) (* x2 x3)))))))))
               (list + -))))))))
     
#(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
  (map (lambda (x)
         (apply bezier-part-min-max x))
       `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))

#(define (line-min-max x1 y1 x2 y2)
  (map (lambda (x)
         (apply line-part-min-max x))
       `((,x1 ,x2) (,y1 ,y2))))
     
#(define (path-min-max origin pointlist)

  ((lambda (x)
     (list
      (reduce min +inf.0 (map caar x))
      (reduce max -inf.0 (map cadar x))
      (reduce min +inf.0 (map caadr x))
      (reduce max -inf.0 (map cadadr x))))
   (map (lambda (x)
          (if (= (length x) 8)
              (apply bezier-min-max x)
              (apply line-min-max x)))
        (map (lambda (x y)
               (append (list (cadr (reverse x)) (car (reverse x))) y))
             (append (list origin)
                     (reverse (cdr (reverse pointlist)))) pointlist))))
     
#(define-public (make-path-stencil path thickness x-scale y-scale fill)
  "Make a stencil based on the path described by the list @var{path},
with thickness @var{thickness}, and scaled by @var{x-scale} in the X
direction and @var{y-scale} in the Y direction.  @var{fill} is a boolean
argument that specifies if the path should be filled.  Valid path
commands are: moveto rmoveto lineto rlineto curveto rcurveto closepath,
and their standard SVG single letter equivalents: M m L l C c Z z."

  (define (convert-path path origin previous-point)
    "Recursive function to standardize command names and
convert any relative path expressions (in @var{path}) to absolute
values.  Returns a list of lists.  @var{origin} is a pair of x and y
coordinates for the origin point of the path (used for closepath and
reset by moveto commands).  @var{previous-point} is a pair of x and y
coordinates for the previous point in the path."
    (if (pair? path)
        (let*
         ((head-raw (car path))
          (rest (cdr path))
          (head (cond
                 ((memq head-raw '(rmoveto M m)) 'moveto)
                 ((memq head-raw '(rlineto L l)) 'lineto)
                 ((memq head-raw '(rcurveto C c)) 'curveto)
                 ((memq head-raw '(Z z)) 'closepath)
                 (else head-raw)))
          (arity (cond
                  ((memq head '(lineto moveto)) 2)
                  ((eq? head 'curveto) 6)
                  (else 0)))
          (coordinates-raw (take rest arity))
          (is-absolute (if (memq head-raw
                           '(rmoveto m rlineto l rcurveto c)) #f #t))
          (coordinates (if is-absolute
                           coordinates-raw
                           ;; convert relative coordinates to absolute by
                           ;; adding them to previous point values
                           (map (lambda (c n)
                                  (if (even? n)
                                      (+ c (car previous-point))
                                      (+ c (cdr previous-point))))
                             coordinates-raw
                             (iota arity))))
          (new-point (if (eq? head 'closepath)
                         origin
                         (cons
                          (list-ref coordinates (- arity 2))
                          (list-ref coordinates (- arity 1)))))
          (new-origin (if (eq? head 'moveto)
                          new-point
                          origin)))
         (cons (cons head coordinates)
           (convert-path (drop rest arity) new-origin new-point)))
        '()))

  (let* ((path-absolute (convert-path path (cons 0 0) (cons 0 0)))
         ;; scale coordinates
         (path-scaled (if (and (= 1 x-scale) (= 1 y-scale))
                          path-absolute
                          (map (lambda (path-unit)
                                 (map (lambda (c n)
                                        (cond
                                         ((= 0 n) c)
                                         ((odd? n) (* c x-scale))
                                         (else (* c y-scale))))
                                   path-unit
                                   (iota (length path-unit))))
                            path-absolute)))
         ;; a path must begin with a 'moveto'
         (path-final (if (eq? 'moveto (car (car path-scaled)))
                         path-scaled
                         (append (list (list 'moveto 0 0)) path-scaled)))
         ;; remove all commands in order to calculate bounds
         (path-headless (map cdr (delete (list 'closepath) path-final)))
         (bound-list (path-min-max
                      (car path-headless)
                      (cdr path-headless))))
    (ly:make-stencil
     `(path ,thickness
        `(,@',(concatenate path-final))
        'round ;; line-cap-style: butt, round, square
        'round ;; line-join-style: bevel, round, miter
        ,(if fill #t #f))
     (coord-translate
      ((if (< x-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 0)
        (list-ref bound-list 1)))
      `(,(/ thickness -2) . ,(/ thickness 2)))
     (coord-translate
      ((if (< y-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 2)
        (list-ref bound-list 3)))
      `(,(/ thickness -2) . ,(/ thickness 2))))))
     
     
#(define (make-special-bezier-sandwich-stencil coords thick)
;; thickness of path is set zero, otherwise it's too hard to calculate
;; later on.
;; The thickness of the resulting bezier-sandwich is a result of the
;; offset 'coords' in Y-direction controlled by 'thick'
   (make-path-stencil
       `(moveto
           ,(car (list-ref coords 0))
           ,(cdr (list-ref coords 0))
         curveto
           ,(car (list-ref coords 1))
           ,(cdr (list-ref coords 1))
           ,(car (list-ref coords 2))
           ,(cdr (list-ref coords 2))
           ,(car (list-ref coords 3))
           ,(cdr (list-ref coords 3))
         lineto
           ,(car (list-ref coords 3))
           ,(- (cdr (list-ref coords 3)) thick)
         curveto
           ,(car (list-ref coords 4))
           ,(- (cdr (list-ref coords 4)) thick)
           
           ,(car (list-ref coords 5))
           ,(- (cdr (list-ref coords 5)) thick)
           
           ,(car (list-ref coords 0))
           ,(- (cdr (list-ref coords 0)) thick)
         closepath)
       ;; line-thickess
       0
       1
       1
       #t))

#(define* (make-special-bow-stencil
           start stop thickness angularity bow-height orientation
           #:optional (line-width 0.1))
  "Create a bow stencil.
It starts at point @var{start}, ends at point @var{stop}.
@var{thickness} is the thickness of the bow.
The higher the value of number @var{angularity}, the more angular the shape of
the bow.
@var{bow-height} determines the height of the bow.
@var{orientation} determines, whether the bow is concave or convex.
Both variables are supplied to support independent usage.

Done by calculating a horizontal unit-bow first, then moving all control-points
to the correct positions.
Limitation: s-curves are currently not supported.
"

;;;; Coding steps:
;;;; (1) calculate control-points for a "unit"-bow from '(0 . 0) to '(1 . 0)
;;;;     user settable `bow-height' and `thickness' are scaled down.
;;;; (2) move control-points to match `start' and `stop'

  (let* (;; `start'-`stop' distances
         (dx (- (car stop) (car start)))
         (dy (- (cdr stop) (cdr start)))
         (length-to-print (magnitude (make-rectangular dx dy))))

    (if (= 0 length-to-print)
        empty-stencil
        (let* (
          ;;;; (1) calculate control-points for the horizontal unit-bow,
               ;; y-values for 2nd/3rd control-points
               (outer-control
                 (* 4/3 (sign orientation) (/ bow-height length-to-print)))
               (inner-control
                 (* (sign orientation)
                    (- (abs outer-control) (/ thickness length-to-print))))
               ;; x-values for 2nd/3rd control-points depending on `angularity'
               (offset-index
                 (- (* 0.6 angularity) 0.8))
               (left-control
                 (+ 0.1 (* 0.3 angularity)))
               (right-control
                 (- 1 left-control))
               ;; defining 2nd and 3rd outer control-points
               (left-outer-control-point
                 (cons left-control outer-control))
               (right-outer-control-point
                 (cons right-control outer-control))
               ;; defining 2nd and 3rd inner control-points
               (left-inner-control-point
                 (cons left-control inner-control))
               (right-inner-control-point
                 (cons right-control inner-control))
               (coord-list
                 (list
                   '(0 . 0)
                   left-outer-control-point
                   right-outer-control-point
                   '(1 . 0)
                   right-inner-control-point
                   left-inner-control-point))
               ;;;; (2) move control-points to match `start' and `stop'
               (moved-coord-list
                 (map
                   (lambda (p)
                     (cons
                       (+ (car start) (- (* (car p) dx) (* (cdr p) dy)))
                       (+ (cdr start) (+ (* (car p) dy) (* (cdr p) dx)))))
                   coord-list)))

          ;; final stencil
          (make-special-bezier-sandwich-stencil
            moved-coord-list
            line-width)))))
             
#(define (make-special-squiggle-line-stencil
            sq-length dest eq-end? thickness
            angularity height orientation line-width)
(lambda (grob)
  (let* ((line-thickness
           (ly:output-def-lookup (ly:grob-layout grob) 'line-thickness))
         (thick (* thickness line-thickness))
         (x (car dest))
         (y (cdr dest))
         (length-to-print (magnitude (make-rectangular x y)))
         ;; Make a guess how many bows may be needed
         (guess (max 1 (truncate (/ length-to-print sq-length))))
         ;; If `eq-end?' is set #t, make sure squiggle-line starts and ends
         ;; with a bow in same direction
         (amount (if (and (even? guess) eq-end?) (1+ guess) guess))
         ;; The lined-up bows needs to fit `length-to-print'
         ;; Thus scale the length of first bow accordingly
         ;; Other bows are copies
         (guessed-squiggle-line-length (* amount sq-length))
         (line-length-diff (- length-to-print guessed-squiggle-line-length))
         (line-length-diff-for-each-squiggle
           (/ line-length-diff amount))
         (first-bow-length (+ sq-length line-length-diff-for-each-squiggle))
         ;; Get first bows
         ;; TODO two bows are created via `make-bow-stencil'
         ;;      cheaper to use `ly:stencil-scale'?
         (first-bow-end-coord
           (cons
             (/ (* first-bow-length x) length-to-print)
             (/ (* first-bow-length y) length-to-print)))
         (init-bow
           (lambda (o)
             (make-special-bow-stencil
               '(0 . 0)
               first-bow-end-coord
               thick angularity height o line-width)))
         (init-bow-up (init-bow orientation))
         (init-bow-down (init-bow (- orientation)))
         ;; Get a list of starting-points for the bows
         (list-of-starts
           (map
             (lambda (n)
               (cons
                 (* n (car first-bow-end-coord))
                 (* n (cdr first-bow-end-coord))))
             (iota amount))))
    ;; The final stencil: lined-up bows
    (apply ly:stencil-add
      (map
        ly:stencil-translate
        (circular-list init-bow-up init-bow-down)
        list-of-starts)))))
#(use-modules (ice-9 pretty-print))
#(define (beam::print-squiggles thick height length)
;; 'thick' is the thickness of the beam
;;     N.B. the gap between single beams is currently hardcoded, so collisions
;;          may happen if 'thick' is too great.
;; 'height' is the height of a single squiggle
;; 'length' is the length of a single squiggle
  (lambda (grob)
    (let* ((default-stil (ly:beam::print grob))
           (x-pos (ly:grob-property grob 'X-positions))
           (y-pos (ly:grob-property grob 'positions))
           ;(beam-thick (ly:grob-property grob 'beam-thickness))
           (first-stem (ly:grob-parent grob X))
           (first-stem-dir (ly:grob-property first-stem 'direction))
           (first-stem-y-ext
             (ly:grob-property first-stem 'Y-extent))
           (stem-thick (ly:grob-property first-stem 'thickness 1.3))
           (layout-line-thick (layout-line-thickness grob))
           (beam-count
             (- (ly:grob-property (ly:grob-parent grob X) 'duration-log) 2))
           (beam-dir (ly:grob-property grob 'direction))
           ;; hmmm, found by try'n error...
           (beam-gap 0.87)
           (stem-end-y
             (if (> first-stem-dir 0)
                 (cdr first-stem-y-ext)
                 (car first-stem-y-ext)))
           (single-squiggle-beam-proc
             (make-special-squiggle-line-stencil
               length ;; sq-length
               ;; dest
               (cons (- (cdr x-pos) (car x-pos))
                     (- (cdr y-pos) (car y-pos)))
               #t ;;eq-end?
               ;; The thickness of a single bow's outline should be zero.
               ;; Otherwise the thickness in make-path-stencil will lead to
               ;; very hard predictable results
               0
               0.5 ;; angularity
               height ;; height
               beam-dir ;; orientation
               thick ;; line-width
               )))

      (ly:stencil-add
        ;; The colored default stencil, uncomment for comparison
        ;(stencil-with-color default-stil cyan)
        (ly:stencil-translate
          (reduce ly:stencil-add empty-stencil
            (map
              (lambda (amount)
                (ly:stencil-translate-axis
                  ;; If the condition is #t the main-beam is colored red
                  ;; Useful for debugging purpose
                  (if #f
                      (stencil-with-color
                        (single-squiggle-beam-proc grob)
                        (if (eqv? amount 0) red black))
                      (single-squiggle-beam-proc grob))
                  (* first-stem-dir -1 amount beam-gap)
                  Y))
              (iota beam-count)))
          (cons
           ;; Move the final stencil half stem-thick to the left
           (- (* stem-thick 0.5 layout-line-thick))
           (+ (/ thick 2) (* first-stem-dir thick -1) stem-end-y)))))))
     
squiggleBeam =
#(define-music-function (parser location thick height length)
  (number? number? number?)
;; 'thick' is the thickness of the beam
;;     N.B. the gap between single beams is currently hardcoded, so collisions
;;          may happen if 'thick' is too great.
;; 'height' is the height of a single squiggle
;; 'length' is the length of a single squiggle
  #{
    \override Beam.stencil = #(beam::print-squiggles thick height length)
  #})
     

adjustStem =
#(define-music-function (parser location val)(number?)
#{
  \once \override Stem.after-line-breaking =
    #(lambda (grob)
      (let* ((y-ext (ly:grob-property grob 'Y-extent))
             (y-lngth (- (cdr y-ext) (car y-ext))))
      (ly:grob-set-property! grob 'length
        (+ (* y-lngth 2) val))))
#})


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

\paper {
  indent = 0
  ragged-right = ##t
}

\relative c' {
  \cadenzaOn
  \squiggleBeam #0.4 #0.5 #3

  \voiceOne c'8[ c c c c c c c]
  \bar "" \break
  \voiceOne c16[ d e f g a b]
  \bar "" \break
  \voiceTwo c32[ d e f g a b]
  \bar "" \break
  \voiceOne b64[ a g f e d c]
  \bar "" \break
  \voiceTwo b,128[ a g f e d c]

}

top = \change Staff = "1"
bottom = \change Staff = "2"

music = \relative c {
        \override Beam #'auto-knee-gap = #0
        \set tupletSpannerDuration = #(ly:make-moment 1 16)
        \override TupletNumber #'transparent = ##t
 
        \squiggleBeam #0.4 #0.5 #3
        \once \override  Beam #'positions = #'(4.5 . 5)
        \times 2/3 {
        \bottom c32[ g' \top eis']
        \once \override  Beam #'positions = #'(-4.5 . -6)
        c'32[ e, \bottom g,]
        \top e''[ \bottom c,, \top  g'']
        }
        \times 4/5 {
        \bottom c,,64[ \top  g'' e' \bottom c,, \top c'']
        }
}

\score {
  \new PianoStaff <<
    \new Staff = "1" {
      s4
    }
    \new Staff = "2" {
      \clef bass
      \music
    }
  >>
}


Das sind jetzt annähernd 500 Zeilen Code.
Ich hoffe, daß
Code: [Auswählen]
bald auch wieder in Linux/firefox funktioniert, ansonsten wird es mühsam lol

Ist aber auch angehängt.


Gruß,
  Harm

kilgore

harm6! :o ??? :D

Sieht wirklich mega gut aus, danke für deine Zeit! Das werde ich sehr gut verwenden können.  \adjustStem ist voll praktisch!

Eine Sache die noch nicht geht (brauche ich nicht, ist mir nur aufgefallen) ist etwas wie:

e16[ e e e e8 e]

Die zwei Balken bleiben bis zum Ende, nur einen Wert erlaubt innerhalb [ ]. 

(übrigens, bei mir funktioniert Code: [Auswählen] in Linux mit Firefox.....)

harm6

Zitat
Eine Sache die noch nicht geht (brauche ich nicht, ist mir nur aufgefallen) ist etwas wie:

e16[ e e e e8 e]

Die zwei Balken bleiben bis zum Ende, nur einen Wert erlaubt innerhalb [ ]. 

Yep.
Schau Dir mal das angehängte png an. Dort hab ich den default und den neuen squiggle-Beam übereinander gelegt.
Den zweiten squiggle-beam zu zeichnen wäre nur dann sinnvoll, wenn er parallel zum ersten wäre.
Allerdings beginnt das entsprechende squiggle des ersten Balkens nicht am Stem an dem das zweite squiggle dann anfinge.
Ein (oder mehrere) squiggle "mittendrin" anzufangen und aufzuhören halte ich zumindest mit diesem Ansatz für unmöglich.
Tatsächlich wäre es wohl möglich beams zu stückeln, d.h jeweils von einem zu nächsten Stem zu zeichnen, dann könnte man parallele squiggle haben, erkauft sich das aber mit einem völlig uneinheitlichen Bild was squiggle-Längen angeht.

Insoweit wird es wohl so bleiben, daß Du nur eine sich nach dem ersten Notenwert richtende Anzahl an parallelen squiggle-Balken haben kannst.

Es sei denn jemand fällt noch was besseres ein.

Zitat(übrigens, bei mir funktioniert Code: [Auswählen] in Linux mit Firefox.....)

Hat Malte ja gefixt. Vielen Dank nochmal!


Gruß,
  Harm



kilgore

Hi harm, ja jetzt verstehe ich auch warum, danke für die Erklärung. Bin trotzdem mega begeistert. Allein für diese Lösung hat sich meine Spende gelohnt!

kilgore

Hey Harm,

Beim nutzen deiner tollen Lösung habe ich ein komisches Verhalten entdeckt mit \adjustBeam - bei Gruppen über mehrere Systeme werden die unteren Tönen sehr weit nach unten gezogen.   :o Mir ist das sehr rätselhaft - weißt du was los ist?



\version "2.18.2"

#(define (sign x)
  (if (= x 0)
      0
      (if (< x 0) -1 1)))
     
#(define (line-part-min-max x1 x2)
  (list (min x1 x2) (max x1 x2)))
     
#(define (bezier-part-min-max x1 x2 x3 x4)
  ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
   (map
    (lambda (x)
      (+ (* x1 (expt (- 1 x) 3))
         (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
            (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
               (* x4 (expt x 3))))))
    (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
           (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
        (list 0.0 1.0)
        (filter
         (lambda (x) (and (>= x 0) (<= x 1)))
         (append
          (list 0.0 1.0)
          (map (lambda (op)
                 (if (not (eqv? 0.0
                                (exact->inexact
                                  (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
                     ;; Zeros of the bezier curve
                     (/ (+ (- x1 (* 2 x2))
                           (op x3
                               (sqrt (- (+ (expt x2 2)
                                           (+ (expt x3 2) (* x1 x4)))
                                        (+ (* x1 x3)
                                           (+ (* x2 x4) (* x2 x3)))))))
                        (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
                     ;; Apply L'hopital's rule to get the zeros if 0/0
                     (* (op 0 1)
                        (/ (/ (- x4 x3) 2)
                           (sqrt (- (+ (* x2 x2)
                                       (+ (* x3 x3) (* x1 x4)))
                                    (+ (* x1 x3)
                                       (+ (* x2 x4) (* x2 x3)))))))))
               (list + -))))))))
     
#(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
  (map (lambda (x)
         (apply bezier-part-min-max x))
       `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))

#(define (line-min-max x1 y1 x2 y2)
  (map (lambda (x)
         (apply line-part-min-max x))
       `((,x1 ,x2) (,y1 ,y2))))
     
#(define (path-min-max origin pointlist)

  ((lambda (x)
     (list
      (reduce min +inf.0 (map caar x))
      (reduce max -inf.0 (map cadar x))
      (reduce min +inf.0 (map caadr x))
      (reduce max -inf.0 (map cadadr x))))
   (map (lambda (x)
          (if (= (length x) 8)
              (apply bezier-min-max x)
              (apply line-min-max x)))
        (map (lambda (x y)
               (append (list (cadr (reverse x)) (car (reverse x))) y))
             (append (list origin)
                     (reverse (cdr (reverse pointlist)))) pointlist))))
     
#(define-public (make-path-stencil path thickness x-scale y-scale fill)
  "Make a stencil based on the path described by the list @var{path},
with thickness @var{thickness}, and scaled by @var{x-scale} in the X
direction and @var{y-scale} in the Y direction.  @var{fill} is a boolean
argument that specifies if the path should be filled.  Valid path
commands are: moveto rmoveto lineto rlineto curveto rcurveto closepath,
and their standard SVG single letter equivalents: M m L l C c Z z."

  (define (convert-path path origin previous-point)
    "Recursive function to standardize command names and
convert any relative path expressions (in @var{path}) to absolute
values.  Returns a list of lists.  @var{origin} is a pair of x and y
coordinates for the origin point of the path (used for closepath and
reset by moveto commands).  @var{previous-point} is a pair of x and y
coordinates for the previous point in the path."
    (if (pair? path)
        (let*
         ((head-raw (car path))
          (rest (cdr path))
          (head (cond
                 ((memq head-raw '(rmoveto M m)) 'moveto)
                 ((memq head-raw '(rlineto L l)) 'lineto)
                 ((memq head-raw '(rcurveto C c)) 'curveto)
                 ((memq head-raw '(Z z)) 'closepath)
                 (else head-raw)))
          (arity (cond
                  ((memq head '(lineto moveto)) 2)
                  ((eq? head 'curveto) 6)
                  (else 0)))
          (coordinates-raw (take rest arity))
          (is-absolute (if (memq head-raw
                           '(rmoveto m rlineto l rcurveto c)) #f #t))
          (coordinates (if is-absolute
                           coordinates-raw
                           ;; convert relative coordinates to absolute by
                           ;; adding them to previous point values
                           (map (lambda (c n)
                                  (if (even? n)
                                      (+ c (car previous-point))
                                      (+ c (cdr previous-point))))
                             coordinates-raw
                             (iota arity))))
          (new-point (if (eq? head 'closepath)
                         origin
                         (cons
                          (list-ref coordinates (- arity 2))
                          (list-ref coordinates (- arity 1)))))
          (new-origin (if (eq? head 'moveto)
                          new-point
                          origin)))
         (cons (cons head coordinates)
           (convert-path (drop rest arity) new-origin new-point)))
        '()))

  (let* ((path-absolute (convert-path path (cons 0 0) (cons 0 0)))
         ;; scale coordinates
         (path-scaled (if (and (= 1 x-scale) (= 1 y-scale))
                          path-absolute
                          (map (lambda (path-unit)
                                 (map (lambda (c n)
                                        (cond
                                         ((= 0 n) c)
                                         ((odd? n) (* c x-scale))
                                         (else (* c y-scale))))
                                   path-unit
                                   (iota (length path-unit))))
                            path-absolute)))
         ;; a path must begin with a 'moveto'
         (path-final (if (eq? 'moveto (car (car path-scaled)))
                         path-scaled
                         (append (list (list 'moveto 0 0)) path-scaled)))
         ;; remove all commands in order to calculate bounds
         (path-headless (map cdr (delete (list 'closepath) path-final)))
         (bound-list (path-min-max
                      (car path-headless)
                      (cdr path-headless))))
    (ly:make-stencil
     `(path ,thickness
        `(,@',(concatenate path-final))
        'round ;; line-cap-style: butt, round, square
        'round ;; line-join-style: bevel, round, miter
        ,(if fill #t #f))
     (coord-translate
      ((if (< x-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 0)
        (list-ref bound-list 1)))
      `(,(/ thickness -2) . ,(/ thickness 2)))
     (coord-translate
      ((if (< y-scale 0) reverse-interval identity)
       (cons
        (list-ref bound-list 2)
        (list-ref bound-list 3)))
      `(,(/ thickness -2) . ,(/ thickness 2))))))
     
     
#(define (make-special-bezier-sandwich-stencil coords thick)
;; thickness of path is set zero, otherwise it's too hard to calculate
;; later on.
;; The thickness of the resulting bezier-sandwich is a result of the
;; offset 'coords' in Y-direction controlled by 'thick'
   (make-path-stencil
       `(moveto
           ,(car (list-ref coords 0))
           ,(cdr (list-ref coords 0))
         curveto
           ,(car (list-ref coords 1))
           ,(cdr (list-ref coords 1))
           ,(car (list-ref coords 2))
           ,(cdr (list-ref coords 2))
           ,(car (list-ref coords 3))
           ,(cdr (list-ref coords 3))
         lineto
           ,(car (list-ref coords 3))
           ,(- (cdr (list-ref coords 3)) thick)
         curveto
           ,(car (list-ref coords 4))
           ,(- (cdr (list-ref coords 4)) thick)
           
           ,(car (list-ref coords 5))
           ,(- (cdr (list-ref coords 5)) thick)
           
           ,(car (list-ref coords 0))
           ,(- (cdr (list-ref coords 0)) thick)
         closepath)
       ;; line-thickess
       0
       1
       1
       #t))

#(define* (make-special-bow-stencil
           start stop thickness angularity bow-height orientation
           #:optional (line-width 0.1))
  "Create a bow stencil.
It starts at point @var{start}, ends at point @var{stop}.
@var{thickness} is the thickness of the bow.
The higher the value of number @var{angularity}, the more angular the shape of
the bow.
@var{bow-height} determines the height of the bow.
@var{orientation} determines, whether the bow is concave or convex.
Both variables are supplied to support independent usage.

Done by calculating a horizontal unit-bow first, then moving all control-points
to the correct positions.
Limitation: s-curves are currently not supported.
"

;;;; Coding steps:
;;;; (1) calculate control-points for a "unit"-bow from '(0 . 0) to '(1 . 0)
;;;;     user settable `bow-height' and `thickness' are scaled down.
;;;; (2) move control-points to match `start' and `stop'

  (let* (;; `start'-`stop' distances
         (dx (- (car stop) (car start)))
         (dy (- (cdr stop) (cdr start)))
         (length-to-print (magnitude (make-rectangular dx dy))))

    (if (= 0 length-to-print)
        empty-stencil
        (let* (
          ;;;; (1) calculate control-points for the horizontal unit-bow,
               ;; y-values for 2nd/3rd control-points
               (outer-control
                 (* 4/3 (sign orientation) (/ bow-height length-to-print)))
               (inner-control
                 (* (sign orientation)
                    (- (abs outer-control) (/ thickness length-to-print))))
               ;; x-values for 2nd/3rd control-points depending on `angularity'
               (offset-index
                 (- (* 0.6 angularity) 0.8))
               (left-control
                 (+ 0.1 (* 0.3 angularity)))
               (right-control
                 (- 1 left-control))
               ;; defining 2nd and 3rd outer control-points
               (left-outer-control-point
                 (cons left-control outer-control))
               (right-outer-control-point
                 (cons right-control outer-control))
               ;; defining 2nd and 3rd inner control-points
               (left-inner-control-point
                 (cons left-control inner-control))
               (right-inner-control-point
                 (cons right-control inner-control))
               (coord-list
                 (list
                   '(0 . 0)
                   left-outer-control-point
                   right-outer-control-point
                   '(1 . 0)
                   right-inner-control-point
                   left-inner-control-point))
               ;;;; (2) move control-points to match `start' and `stop'
               (moved-coord-list
                 (map
                   (lambda (p)
                     (cons
                       (+ (car start) (- (* (car p) dx) (* (cdr p) dy)))
                       (+ (cdr start) (+ (* (car p) dy) (* (cdr p) dx)))))
                   coord-list)))

          ;; final stencil
          (make-special-bezier-sandwich-stencil
            moved-coord-list
            line-width)))))
             
#(define (make-special-squiggle-line-stencil
            sq-length dest eq-end? thickness
            angularity height orientation line-width)
(lambda (grob)
  (let* ((line-thickness
           (ly:output-def-lookup (ly:grob-layout grob) 'line-thickness))
         (thick (* thickness line-thickness))
         (x (car dest))
         (y (cdr dest))
         (length-to-print (magnitude (make-rectangular x y)))
         ;; Make a guess how many bows may be needed
         (guess (max 1 (truncate (/ length-to-print sq-length))))
         ;; If `eq-end?' is set #t, make sure squiggle-line starts and ends
         ;; with a bow in same direction
         (amount (if (and (even? guess) eq-end?) (1+ guess) guess))
         ;; The lined-up bows needs to fit `length-to-print'
         ;; Thus scale the length of first bow accordingly
         ;; Other bows are copies
         (guessed-squiggle-line-length (* amount sq-length))
         (line-length-diff (- length-to-print guessed-squiggle-line-length))
         (line-length-diff-for-each-squiggle
           (/ line-length-diff amount))
         (first-bow-length (+ sq-length line-length-diff-for-each-squiggle))
         ;; Get first bows
         ;; TODO two bows are created via `make-bow-stencil'
         ;;      cheaper to use `ly:stencil-scale'?
         (first-bow-end-coord
           (cons
             (/ (* first-bow-length x) length-to-print)
             (/ (* first-bow-length y) length-to-print)))
         (init-bow
           (lambda (o)
             (make-special-bow-stencil
               '(0 . 0)
               first-bow-end-coord
               thick angularity height o line-width)))
         (init-bow-up (init-bow orientation))
         (init-bow-down (init-bow (- orientation)))
         ;; Get a list of starting-points for the bows
         (list-of-starts
           (map
             (lambda (n)
               (cons
                 (* n (car first-bow-end-coord))
                 (* n (cdr first-bow-end-coord))))
             (iota amount))))
    ;; The final stencil: lined-up bows
    (apply ly:stencil-add
      (map
        ly:stencil-translate
        (circular-list init-bow-up init-bow-down)
        list-of-starts)))))
#(use-modules (ice-9 pretty-print))
#(define (beam::print-squiggles thick height length)
;; 'thick' is the thickness of the beam
;;     N.B. the gap between single beams is currently hardcoded, so collisions
;;          may happen if 'thick' is too great.
;; 'height' is the height of a single squiggle
;; 'length' is the length of a single squiggle
  (lambda (grob)
    (let* ((default-stil (ly:beam::print grob))
           (x-pos (ly:grob-property grob 'X-positions))
           (y-pos (ly:grob-property grob 'positions))
           ;(beam-thick (ly:grob-property grob 'beam-thickness))
           (first-stem (ly:grob-parent grob X))
           (first-stem-dir (ly:grob-property first-stem 'direction))
           (first-stem-y-ext
             (ly:grob-property first-stem 'Y-extent))
           (stem-thick (ly:grob-property first-stem 'thickness 1.3))
           (layout-line-thick (layout-line-thickness grob))
           (beam-count
             (- (ly:grob-property (ly:grob-parent grob X) 'duration-log) 2))
           (beam-dir (ly:grob-property grob 'direction))
           ;; hmmm, found by try'n error...
           (beam-gap 0.87)
           (stem-end-y
             (if (> first-stem-dir 0)
                 (cdr first-stem-y-ext)
                 (car first-stem-y-ext)))
           (single-squiggle-beam-proc
             (make-special-squiggle-line-stencil
               length ;; sq-length
               ;; dest
               (cons (- (cdr x-pos) (car x-pos))
                     (- (cdr y-pos) (car y-pos)))
               #t ;;eq-end?
               ;; The thickness of a single bow's outline should be zero.
               ;; Otherwise the thickness in make-path-stencil will lead to
               ;; very hard predictable results
               0
               0.5 ;; angularity
               height ;; height
               beam-dir ;; orientation
               thick ;; line-width
               )))

      (ly:stencil-add
        ;; The colored default stencil, uncomment for comparison
        ;(stencil-with-color default-stil cyan)
        (ly:stencil-translate
          (reduce ly:stencil-add empty-stencil
            (map
              (lambda (amount)
                (ly:stencil-translate-axis
                  ;; If the condition is #t the main-beam is colored red
                  ;; Useful for debugging purpose
                  (if #f
                      (stencil-with-color
                        (single-squiggle-beam-proc grob)
                        (if (eqv? amount 0) red black))
                      (single-squiggle-beam-proc grob))
                  (* first-stem-dir -1 amount beam-gap)
                  Y))
              (iota beam-count)))
          (cons
           ;; Move the final stencil half stem-thick to the left
           (- (* stem-thick 0.5 layout-line-thick))
           (+ (/ thick 2) (* first-stem-dir thick -1) stem-end-y)))))))
     
squiggleBeam =
#(define-music-function (parser location thick height length)
  (number? number? number?)
;; 'thick' is the thickness of the beam
;;     N.B. the gap between single beams is currently hardcoded, so collisions
;;          may happen if 'thick' is too great.
;; 'height' is the height of a single squiggle
;; 'length' is the length of a single squiggle
  #{
    \override Beam.stencil = #(beam::print-squiggles thick height length)
  #})
     

adjustStem =
#(define-music-function (parser location val)(number?)
#{
  \once \override Stem.after-line-breaking =
    #(lambda (grob)
      (let* ((y-ext (ly:grob-property grob 'Y-extent))
             (y-lngth (- (cdr y-ext) (car y-ext))))
      (ly:grob-set-property! grob 'length
        (+ (* y-lngth 2) val))))
#})






up = \relative c' {
  \squiggleBeam #0.4 #0.5 #3
  \stemUp
c'8[ c \adjustStem #-1 c c
\change Staff = "down"
c,,
\change Staff = "up"
c'' c c]
}

down = \relative c' {
  \clef bass
s1
}

<<
\new PianoStaff <<
    \new Staff = "up" { \up }
    \new Staff = "down" { \down }
  >>
>>


harm6

Zitat
Beim nutzen deiner tollen Lösung habe ich ein komisches Verhalten entdeckt mit \adjustBeam - bei Gruppen über mehrere Systeme werden die unteren Tönen sehr weit nach unten gezogen.   Mir ist das sehr rätselhaft - weißt du was los ist?

:(
Das ist ein Verhalten welches leider häufig auftritt, wenn man Längen in Y-Richtung ausliest. Ich hatte gehofft beim Weg über 'after-line-breaking und 'Y-extent (anstatt grob-extent) diesen Seiteneffekt vermeiden zu können. Im Beispiel wird es wahrscheinlich dadurch getriggert, daß die Stimme über zwei Staffs läuft, die natürlich der spacing-engine unterliegen.

Versuch doch mal:

adjustStem =
#(define-music-function (parser location val)(number?)
#{
  \once \override Stem.stencil =
    #(lambda (grob)
      (let* ((y-ext (ly:grob-property grob 'Y-extent))
             (y-lngth (- (cdr y-ext) (car y-ext))))
      (ly:grob-set-property! grob 'length (+ (* y-lngth 2) val))
      (ly:stem::print grob)))
#})


Wenn das auch Probleme gibt muß man wohl noch anders dran gehen...

Gruß,
  Harm