feathered beams

[chf]

Liebe Freunde,

Code Auswählen Erweitern



\version "2.19.49"

#(define ((stem-length y) grob)
  (if (ly:stencil? (ly:stem::print grob))
    (begin
      (and
        (ly:grob-set-property! grob 'length y)
        ;;(ly:grob-set-property! grob 'color red);; construction-helper, comment out!
        ;;(ly:grob-set-property! grob 'layer 6) ;; construction-helper, comment out!
        )
     (ly:stem::print grob))
     ))
   
xyOut =
#(define-music-function (parser location y-length)(number?)
#{
        \once \override  Stem #'stencil = #(stem-length y-length)
#})

#(define ((grow-beam-var number) grob)
(cond
   ((< (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming))) 2)
    (ly:beam::print grob))
   ((= number 0)
    (begin
      (ly:grob-set-property! grob 'grow-direction LEFT)
      (ly:beam::print grob)))
   ((>= number (1- (ly:grob-array-length (ly:grob-object grob 'stems))))
    (begin
     (ly:grob-set-property! grob 'grow-direction RIGHT)
     (ly:beam::print grob)))

   ((ly:stencil? (ly:beam::print grob)) ;; delete this?
    (let* ((beam (ly:beam::print grob))
           (dir (ly:beam::calc-direction grob))
           (b-d (ly:output-def-lookup (ly:grob-layout grob) 'blot-diameter))
           (beam-extent-X (ly:stencil-extent beam X))
           (beam-length-x-orig (interval-length beam-extent-X))
           (beam-length-x (- beam-length-x-orig b-d))
           (beam-extent-Y (ly:stencil-extent beam Y))
           (beam-length-y (interval-length beam-extent-Y))
           (orig-beam-thickness (ly:grob-property grob 'beam-thickness))
           (beam-count (length (cdr (ly:grob-property (ly:grob-parent grob X) 'beaming)))) 
           (space-between-beams (* 0.46 (ly:grob-property grob 'gap)))                     
           (orig-beam-length-at-stem (+ (* beam-count orig-beam-thickness)(* (- beam-count 1) space-between-beams)))
           (beam-positions (ly:grob-property grob 'positions))
           (beam-slant (cond ((<= (car beam-positions) (cdr beam-positions)) 1)
                             ;;((= (car beam-positions) (cdr beam-positions)) 0)
                             ((> (car beam-positions) (cdr beam-positions)) -1)))
           (orig-slope (* beam-slant (/ (- beam-length-y orig-beam-length-at-stem) beam-length-x)))
           (alpha (atan orig-slope))
           (beam-thickness (* 0.8 orig-beam-thickness))
           (h-max (- (/ orig-beam-length-at-stem (cos alpha)) (* 1.3 beam-thickness)))
           (dir-peak (if (and (ly:grob-property grob 'knee) (< number 0) (= (car beam-positions) (cdr beam-positions)))
       -1
       1))
           (number-a (if (integer? (abs number))
                   (abs number)
                   (inexact->exact (floor (abs number)))))
           (number-b (- (abs number) (floor (abs number))))
           (stems (ly:grob-object grob 'stems))
           (stem-count (ly:grob-array-length stems))
           (refp (ly:grob-system grob))
           (first-stem (ly:grob-array-ref stems 0))
           (target-stem (if (< (abs number-a) stem-count)
                   (ly:grob-array-ref stems number-a)
                   (ly:grob-array-ref stems (- stem-count 1 ))))
           (next-stem (if (< (+ (abs number-a) 1) stem-count)
                   (ly:grob-array-ref stems (+ number-a 1))
                   (ly:grob-array-ref stems (- stem-count 1 ))))
           (first-stem-coord (ly:grob-relative-coordinate first-stem refp X))
           (target-stem-coord (ly:grob-relative-coordinate target-stem refp X))
           (next-stem-coord (ly:grob-relative-coordinate next-stem refp X))
           (first-stem-to-target-stem-length (interval-length (cons first-stem-coord target-stem-coord)))
           (stem-to-next-stem-length (interval-length (cons target-stem-coord next-stem-coord)))
           (factor (/ beam-length-x first-stem-to-target-stem-length))

;; markup-a is the longest beam

           (markup-a (markup #:beam beam-length-x
                (if (and (ly:grob-property grob 'knee) (< number 0)(= (car beam-positions) (cdr beam-positions)))
                                        (* dir-peak orig-slope)
                                        orig-slope)
                                    beam-thickness))

  ;; left piece
     ;; y-length of left piece
           (y-L
             (lambda (n)
               (- (/ (- beam-length-y orig-beam-length-at-stem) factor) (* dir beam-slant (* n (/ h-max (- beam-count 1)))))
               ))
     ;; x-length of left piece
           (x-L (+ first-stem-to-target-stem-length (* number-b stem-to-next-stem-length)))
     ;; slope of left piece
           (slope-part-beam-L
             (lambda (n)
               (cond ((or (and (> dir 0) (> beam-slant 0)) (and (< dir 0) (> beam-slant 0)))
                      (if (and (ly:grob-property grob 'knee) (< number 0))
                          (* (* 1 dir-peak) (/ (y-L n) x-L))
                          (* dir-peak (/ (y-L n) x-L)))
                          )
                     ((or (and (> dir 0) (< beam-slant 0)) (and (< dir 0) (< beam-slant 0)))
                      (* -1 (/ (y-L n) x-L))))))
     ;; construct left piece
           (part-beam-L
             (lambda (n)
                 (markup #:beam x-L
                                (slope-part-beam-L n)
                                beam-thickness)))
     ;; markup of left piece
           (markup-L (lambda (n) (markup (part-beam-L n))))
     ;; stencil of left piece
           (beam-part-L (lambda (n) (grob-interpret-markup grob (markup-L n))))
     ;; y-extent of left piece
           (beam-part-L-ext-y (lambda (n) (ly:stencil-extent (beam-part-L n) Y)))
     ;; length of left piece
           (length-beam-part-L-y (lambda (n) (interval-length (beam-part-L-ext-y n))))

  ;; right piece
           (y-R (lambda (n) (- (- beam-length-y orig-beam-length-at-stem) (y-L n))))
           (x-R (- beam-length-x x-L))
           (slope-part-beam-R
             (lambda (n)
               (cond
               ((or (and (> dir 0) (> beam-slant 0)) (and (< dir 0) (> beam-slant 0)))
                      (if (and (ly:grob-property grob 'knee) (< number 0))
                        (* (* 1 dir-peak) (/ (y-R n) x-R))
                        (/ (y-R n) x-R))
                      )
                     ((or (and (> dir 0) (< beam-slant 0)) (and (< dir 0) (< beam-slant 0)))
                      (* -1  (/ (y-R n) x-R))))))
           (part-beam-R
             (lambda (n)
               (markup #:beam (- beam-length-x x-L)
                              (slope-part-beam-R n)
                              beam-thickness)))
           (markup-R (lambda (n) (markup (part-beam-R n))))

   ;; parts of feathered beams
           (beam-pieces
             (map
               (lambda (n)
                 (ly:stencil-combine-at-edge
                   (ly:stencil-translate-axis
                     (grob-interpret-markup grob (markup-L n))
                     -0.025 X)
                   X RIGHT
                   (ly:stencil-translate-axis
                     (grob-interpret-markup grob (markup-R n))
                     (cond ((and (> dir 0)(> beam-slant 0))
                            (if (and (>= (slope-part-beam-L n) 0)(>= (slope-part-beam-R n) 0))
                                (- (length-beam-part-L-y n) beam-thickness)
                                (* -1 (- (length-beam-part-L-y n) beam-thickness))))
                           ((and (> dir 0)(< beam-slant 0))
                            (* -1 (- (length-beam-part-L-y n) beam-thickness)))

                           ((and (< dir 0)(> beam-slant 0))
                            (* dir-peak (- (length-beam-part-L-y n) beam-thickness)))
                           ((and (< dir 0)(< beam-slant 0))
                            (if (and (<= (slope-part-beam-L n) 0)(<= (slope-part-beam-R n) 0))
                                (* -1 (- (length-beam-part-L-y n) beam-thickness))
                                (- (length-beam-part-L-y n) beam-thickness)))
                                  )
                     Y)
                   0))
               (cdr (iota beam-count))))

                       )   ;; end of defs in let*

      (define (helper beam-pieces)
        (ly:stencil-add
          (car beam-pieces)
          (if (null? (cdr beam-pieces))
              (car beam-pieces)
              (helper (cdr beam-pieces)))))

      (ly:stencil-translate-axis
       (ly:stencil-add
         ;; first (long beam)
         (ly:stencil-translate-axis
           (grob-interpret-markup grob markup-a)
             -0.025 X)
           ;; other beams
           (helper beam-pieces))
       (car beam-positions)
       Y)
     ) ;; end of let*
    )
  )
)

#(define (moment=? a b)
   (not (or (ly:moment<? a b) (ly:moment<? b a))))

#(define (moment>? a b)
   (not (or (ly:moment<? a b) (moment=? a b))))
   
featherDurationsTest=
#(define-music-function (parser location factor turnaround-orig argument)
                                         (ly:moment? number? ly:music?)
   (let* ((orig-duration (ly:music-length argument))
          (multiplier (ly:make-moment 1 1))
          (turnaround (if (and (integer? turnaround-orig) (>= turnaround-orig 0))
          turnaround-orig
          (inexact->exact (floor (abs turnaround-orig)))))
          (elements (ly:music-property argument 'elements))
          (dif (- (length elements) turnaround))
          (lth (cond ((>= dif 0) dif)
                     (else (length elements))))
          (peak-multiplier
            (reduce
              (lambda (mom prev) (ly:moment-mul mom prev))
              multiplier
              (make-list turnaround factor)))
          (end-multiplier
            (reduce
              (lambda (mom prev) (ly:moment-mul mom prev))
              peak-multiplier
              (append
                (list peak-multiplier)
                (make-list lth ;;(- (length elements) turnaround)
                           (ly:moment-div (ly:make-moment 1 1) factor)))))
          (comparison
            (if (< (ly:moment-main-numerator factor) (ly:moment-main-denominator factor))
                (lambda (a b) (ly:moment<? a b))
                (lambda (a b) (moment>? a b)))))
     (music-map
       (lambda (mus)
         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
             (begin
               ;;(display multiplier) (newline) ; shows pattern of modification
               (ly:music-compress mus multiplier)
               (if (comparison peak-multiplier multiplier)
                   (set! multiplier (ly:moment-mul factor multiplier))
                   (begin
                     (set! multiplier (ly:moment-div multiplier factor))
                     (set! peak-multiplier end-multiplier)))))
        mus)
      argument)

     (ly:music-compress
       argument
       (ly:moment-div orig-duration (ly:music-length argument)))

     argument))

\relative c'{
  \clef bass
\once \override Beam.stencil = #(grow-beam-var 9)
\once \override Beam #'length-fraction = #1.8

\override Score.SpacingSpanner.uniform-stretching = ##f   {
    \once \override TupletNumber.transparent= ##t       
   \times 12/18 {\override Beam #'positions = #'(0 . 0)
                 es16 [(c bes) es (c bes) 
                 \override NoteHead #'transparent = ##t \override NoteHead #'no-ledgers = ##t             
                 es c bes es c bes es c bes es c bes] }
}               
}

Mit dieser wunderbaren Funktion arbeite ich schon lange und immer wieder,
aber hier habe ich erstmals ein Problem mit den Hälsen. Die Anwendung von \xy gelingt mir nicht,
und der Versuch, die Neigung des Balkens zu ändern, ist auch gescheitert...

Gruß
chf

[harm6]

Hallo,

Dein override für 'length-fraction stört das Geschehen. Das hab ich damals offensichtlich nicht in Erwägung gezogen.
In dieser Hinsicht ist der Code buggy.
Aber warum verwendest Du 'length-fraction überhaupt? Er verändert den Abstand an der "Spitze" sowieso nicht.

der Versuch, die Neigung des Balkens zu ändern, ist auch gescheitert...

\override Beam.positions = ...
funktioniert doch

Die Anwendung von \xy gelingt mir nicht,

Das hat noch nie gut funktioniert. Möglicherweise auch bedingt durch Versionsänderungen. Der ursprüngliche Code ist ja schon recht alt.

Insoweit habe ich folgendes entwickelt:

Code Auswählen Erweitern


#(define (adjust-beamed-stems pairs)
  (lambda (grob)
    (let* ((stems (ly:grob-array->list (ly:grob-object grob 'stems)))
           (stem-stil-exprs
             (map-in-order
               (lambda (st)
                 (ly:stencil-expr (ly:grob-property st 'stencil)))
               stems))
           ;(foo
           ;  (begin
           ;    (pretty-print stems)
           ;    'foo))
           (new-stem-stil-expr
             (map
               (lambda (e p)
                `(,@(take e 3)
                  ,(+ (fourth e) (car p))
                  ,(+ (fifth e) (cdr p))
                  ,(last e)))
               stem-stil-exprs
               pairs)))

      (for-each
        (lambda (stem new-stem-expr)
          (ly:grob-set-property! stem 'stencil
            (ly:make-stencil
               new-stem-expr
               (cons (- (second new-stem-expr)) (third new-stem-expr))
               (cons (- (fourth new-stem-expr)) (fifth new-stem-expr)))))
        stems
        new-stem-stil-expr))))


Die Anwendung ist, z.B.:
\once \override Beam.after-line-breaking =
  #(adjust-beamed-stems '((2 . 1) (0 . 0) (0 . 0)))

Wobei jedes Zahlenpaar den Anfangs und Endpunkt eines Stems representiert.
Die  nicht zu verändernden Stems müssen vom Anfang an mit (0 . 0) angegeben werden. Zur Verlängerung nur des 4. Stems nach oben also:
  #(adjust-beamed-stems '((0 . 0)(0 . 0)(0 . 0)(0 . 2)))
Falls Du weiter Stems verändern willst mußt Du die Liste erweitern, ansonsten bleiben diese unverändert.


Gruß,
  Harm

[chf]

Hallo Harm,

der Verzicht auf die "length-fraktion" hat schon alles geklärt.

\override Beam.positions = ...
funktioniert doch

Hier war ich ungenau - es funktioniert, aber das Gewinde der "Stellschraube" ist zu steil... Es geht wohl nur in ganzen Zahlen?

Ich wünsche einen schönen Sonntag!
Christa

[harm6]

Hier war ich ungenau - es funktioniert, aber das Gewinde der "Stellschraube" ist zu steil... Es geht wohl nur in ganzen Zahlen?

Hier weiß ich nicht was Du meinst.

Aber
\override Beam.positions = ...
funktioniert natürlich auch mit Kommazahlen.

Gruß,
  Harm