X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fauto-beam.scm;h=b77022f2fca1cb2e24a164cdf4e2f7e8d1628f87;hb=1999a1bdb8c925ca279d79b330ba6497200445eb;hp=df31f369900f0233f09f451b8ce45b0b10ae49c4;hpb=b7a0cffbf9d1069860368f289a5b50e9d1d90ba8;p=lilypond.git diff --git a/scm/auto-beam.scm b/scm/auto-beam.scm index df31f36990..b77022f2fc 100644 --- a/scm/auto-beam.scm +++ b/scm/auto-beam.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2000--2009 Jan Nieuwenhuizen +;;;; Copyright (C) 2000--2012 Jan Nieuwenhuizen ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -15,36 +15,51 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -;; Determine end moment for auto beaming (or begin moment, but mostly -;; 0== anywhere). We only consider the current time signature. -;; In order of decreasing priority: +;; Determine whether an auto beam should be extended to the right +;; of the current stem. We start anywhere, except mid-measure in +;; 3/4 time. We end according to the follwing rules, in order of +;; decreasing priority: ;; ;; 1. end -;; 2. end * -;; 3. if 1-2 not specified, begin anywhere, end at beatLength intervals +;; 2. end +;; 3. if 1-2 not specified, end at beatStructure intervals ;; ;; Rationale: ;; ;; [user override] ;; 1. override for specific duration type -;; 2. override for all duration types in a time signature. +;; 2. overrides apply to shorter durations ;; -;; defined in scm/beam-settings.scm: +;; defined in scm/time-signature-settings.scm: ;; 1. Default grouping for common time signatures -;; 2. exceptions for specific time signature, for specific duration type - -(define-public (default-auto-beam-check context dir test-beam) +(define-public (default-auto-beam-check context dir measure-pos test-beam) (define (get name default) (let ((value (ly:context-property context name))) (if (not (null? value)) value default))) - (define (ending-moments group-list start-beat beat-length) + (define (beamingmoment (car a)) + (fraction->moment (car b)))) + + (define (ending-moments group-list start-beat base-moment) (if (null? group-list) '() (let ((new-start (+ start-beat (car group-list)))) - (cons (ly:moment-mul (ly:make-moment new-start 1) beat-length) - (ending-moments (cdr group-list) new-start beat-length))))) + (cons (ly:moment-mul (ly:make-moment new-start 1) base-moment) + (ending-moments (cdr group-list) new-start base-moment))))) + + (define (larger-setting test-beam sorted-alist) + (if (null? sorted-alist) + '() + (let* ((first-key (caar sorted-alist)) + (first-moment (fraction->moment first-key))) + (if (moment<=? test-beam first-moment) + (car sorted-alist) + (larger-setting test-beam (cdr sorted-alist)))))) + + (define (beat-end? moment beat-structure) + (pair? (member moment beat-structure))) ;; member returns a list if found, not #t ;; Start of actual auto-beam test routine ;; @@ -53,47 +68,54 @@ (if (and (!= (ly:moment-grace-numerator (ly:context-now context)) 0) (= dir START)) #f - (if (= dir START) - ;; start anywhere is currently implemented - #t - (let* ((beat-length (get 'beatLength (ly:make-moment 1 4))) - (measure-length (get 'measureLength (ly:make-moment 1 1))) - (time-signature-fraction - (get 'timeSignatureFraction '(4 . 4))) - (measure-pos (get 'measurePosition ZERO-MOMENT)) - (settings (get 'beamSettings '())) - (function (if (= dir START) 'begin 'end)) - (type (cons (ly:moment-main-numerator test-beam) - (ly:moment-main-denominator test-beam))) - (pos (if (>= (ly:moment-main-numerator measure-pos) 0) - measure-pos - (ly:moment-add measure-length measure-pos))) - (type-grouping (ly:beam-grouping - settings - time-signature-fraction - function - type)) - (default-grouping (ly:beam-grouping - settings - time-signature-fraction - function - '*)) - (beat-grouping (if (null? type-grouping) - default-grouping - type-grouping)) - (grouping-moment (if (null? type-grouping) - beat-length - test-beam)) - (grouping-moments (ending-moments - beat-grouping 0 grouping-moment))) - (if (null? beat-grouping) - ;; no rule applies, so end at beatLength - (= (ly:moment-main-denominator - (ly:moment-div pos beat-length)) 1) - ;; otherwise, end at beginning of measure or - ;; at specified moment - (or - ;; start/end at beginning of measure - (= (ly:moment-main-numerator pos) 0) - ;; end if measure-pos matches a specified ending moment - (member pos grouping-moments))))))) + (let* ((base-moment (get 'baseMoment (ly:make-moment 1 4))) + (measure-length (get 'measureLength (ly:make-moment 1 1))) + (time-signature-fraction + (get 'timeSignatureFraction '(4 . 4))) + (beat-structure (get 'beatStructure '(1 1 1 1))) + (beat-endings (ending-moments beat-structure 0 base-moment)) + (exceptions (sort (assoc-get 'end + (get 'beamExceptions '()) + '()) + beamingfraction test-beam)) + (non-grace (ly:make-moment + (ly:moment-main-numerator measure-pos) + (ly:moment-main-denominator measure-pos))) + (pos (if (ly:momentmoment default-beat-length) + test-beam)) + (exception-moments (ending-moments + exception-grouping 0 grouping-moment))) + + (if (= dir START) + ;; Start rules -- #t if beam is allowed to start + (or beam-half-measure ;; Start anywhere, but option for mid-measure + (not (equal? (ly:moment-add pos pos) measure-length)) + (not (= 3 (car time-signature-fraction))) ;; in triple meter + (not (= (cdr 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 (= (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 +