- ;; Start rules
- (or (not (equal? time-signature-fraction '(3 . 4))) ;; start anywher if not 3/4
- (beat-end? pos beat-endings) ;; are we at start of beat?
- (and (not (equal? test-beam base-moment)) ;; is beat split?
- (not (beat-end? (ly:moment-add pos test-beam)
- beat-endings)))) ;; will this note end the beat
- ;; End rules
- (or (= (ly:moment-main-numerator pos) 0) ;; end at measure beginning
- (if (null? exception-grouping)
- (beat-end? pos beat-endings) ;; no exception, so check beat ending
- (member pos exception-moments))))))) ;; check exception rule
+ ;; Start rules -- #t if beam is allowed to start
+ (or beam-half-measure ;; Start anywhere, but option for mid-measure
+ (not (= (+ pos pos) measure-length))
+ (not (= 3 (car time-signature-fraction))) ;; in triple meter
+ (not (= (denominator type) ;; when the beamed note is 1/6 of a measure
+ (* 2 (cdr time-signature-fraction)))))
+ ;; End rules -- #t if beam is required to end
+ (or (zero? pos) ;; end at measure beginning
+ (if exception-grouping
+ (beat-end? pos exception-moments) ;; check exception rule
+ (beat-end? pos beat-endings))))))) ;; no exception, so check beat ending
+
+
+(define-public (extract-beam-exceptions music)
+ "Creates a value useful for setting @code{beamExceptions} from @var{music}."
+ (define (car> a b) (> (car a) (car b)))
+ (define (beatify! lst)
+ ;; takes a collection of end points, sorts them, and returns the
+ ;; non-zero differences as beaming pattern
+ (let ((s (sort-list! lst <)))
+ (remove! zero?
+ (map - s (cons 0 s)))))
+ (let ((res '()))
+ (let analyze ((m (unfold-repeats-fully (event-chord-reduce music)))
+ (pos 0))
+ ;; enter beam ends from m starting at pos into res, return new pos
+ (cond ((music-is-of-type? m 'bar-check) 0)
+ ((music-is-of-type? m 'simultaneous-music)
+ (fold (lambda (m prev) (max (analyze m pos) prev))
+ pos
+ (ly:music-property m 'elements)))
+ ((not (music-is-of-type? m 'rhythmic-event))
+ (let ((elt (ly:music-property m 'element)))
+ (fold analyze
+ (if (ly:music? elt) (analyze elt pos) pos)
+ (ly:music-property m 'elements))))
+ ;; Have rhythmic event.
+ ((any
+ (lambda (art)
+ (and (music-is-of-type? art 'beam-event)
+ (= (ly:music-property art 'span-direction START) STOP)))
+ (ly:music-property m 'articulations))
+ (let* ((len (duration-length (ly:music-property m 'duration)))
+ (pos (+ pos len))
+ (ass (assv len res)))
+ (cond ((or (zero? len) (not (integer? (/ pos len))))
+ (ly:warning m (_ "Beam end fits no pattern")))
+ (ass
+ (set-cdr! ass (cons (/ pos len) (cdr ass))))
+ (else
+ (set! res (cons (list len (/ pos len)) res))))
+ pos))
+ (else
+ (+ pos (duration-length (ly:music-property m 'duration))))))