- (if (= dir START)
- ;; Start rules -- start anywhere unless 3/4 with default rules
- ;; #t if beam is to start
- (or (not (use-special-3-4-rules?
- time-signature-fraction
- base-moment
- exceptions)) ;; start anywhere if not default 3/4
- (= (ly:moment-main-numerator pos) 0) ;; start at beginning of measure
- (and beam-half-measure
- (equal? type '(1 . 8))
- (equal? pos (ly:make-moment 3 8))) ;; start at mid-measure if 1/8 note beam
- (beat-end? pos beat-endings) ;; start if 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 -- #t if beam is to end
- (or (= (ly:moment-main-numerator pos) 0) ;; end at measure beginning
- (if (use-special-3-4-rules?
- time-signature-fraction
- base-moment
- exceptions)
- ;; special rule for default 3/4 beaming
- (if (and (equal? type '(1 . 8))
- (or beam-whole-measure
- (and beam-half-measure
- (not (equal? pos (ly:make-moment 3 8))))))
- #f
- (beat-end? pos beat-endings))
- ;; rules for all other cases -- check for applicable exception
- (if (null? exception-grouping)
- (beat-end? pos beat-endings) ;; no exception, so check beat ending
- (member pos exception-moments)))))))) ;; check exception rule
+(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))))))