]> git.donarmstrong.com Git - lilypond.git/blob - scm/auto-beam.scm
Update from Trevor.
[lilypond.git] / scm / auto-beam.scm
1 ;;;; auto-beam.scm -- Auto-beam-engraver settings
2 ;;;;
3 ;;;; source file of the GNU LilyPond music typesetter
4 ;;;; 
5 ;;;; (c) 2000--2007 Jan Nieuwenhuizen <janneke@gnu.org>
6
7 ;;; specify generic beam begin and end times
8
9 ;;; format:
10 ;;;
11 ;;;   function shortest-duration-in-beam time-signature
12 ;;;
13 ;;; where
14 ;;;
15 ;;;     function = begin or end
16 ;;;     shortest-duration-in-beam = numerator denominator; e.g.: 1 16
17 ;;;     time-signature = numerator denominator, e.g.: 4 4
18 ;;;
19 ;;; unspecified or wildcard entries for duration or time-signature
20 ;;; are given by * *
21
22 ;;; maybe do:  '(end shortest-1 16 time-3 4) ?
23
24 (define-public default-auto-beam-settings
25   `(
26     ;; in 3 2 time:
27     ;;   end beams each 1 2 note
28     ;;   end beams with 16th notes each 1 4 note
29     ;;   end beams with 32th notes each 1 8 note
30
31     ((end * * 3 2) . ,(ly:make-moment 1 2))
32     ((end * * 3 2) . ,(ly:make-moment 2 2))
33     
34     ((end 1 16 3 2) . ,(ly:make-moment 1 4))
35     ((end 1 16 3 2) . ,(ly:make-moment 1 2))
36     ((end 1 16 3 2) . ,(ly:make-moment 3 4))
37     ((end 1 16 3 2) . ,(ly:make-moment 5 4))
38     
39     ((end 1 32 3 2) . ,(ly:make-moment 1 8))
40     ((end 1 32 3 2) . ,(ly:make-moment 1 4))
41     ((end 1 32 3 2) . ,(ly:make-moment 3 8))
42     ((end 1 32 3 2) . ,(ly:make-moment 1 2))
43     ((end 1 32 3 2) . ,(ly:make-moment 5 8))
44     ((end 1 32 3 2) . ,(ly:make-moment 3 4))
45     ((end 1 32 3 2) . ,(ly:make-moment 7 8))
46     ((end 1 32 3 2) . ,(ly:make-moment 9 8))
47     ((end 1 32 3 2) . ,(ly:make-moment 5 4))
48     ((end 1 32 3 2) . ,(ly:make-moment 11 8))
49
50     ((end * * 3 4) . ,(ly:make-moment 3 4))
51
52     ((end 1 16 3 4) . ,(ly:make-moment 1 4))
53     ((end 1 16 3 4) . ,(ly:make-moment 1 2))
54     
55     ((end 1 32 3 4) . ,(ly:make-moment 1 8))
56     ((end 1 32 3 4) . ,(ly:make-moment 1 4))
57     ((end 1 32 3 4) . ,(ly:make-moment 3 8))
58     ((end 1 32 3 4) . ,(ly:make-moment 1 2))
59     ((end 1 32 3 4) . ,(ly:make-moment 5 8))
60
61     ((end * * 3 8) . ,(ly:make-moment 3 8))
62
63     ;; in common time:
64     ;;   end beams each 1 2 note
65     ;;   end beams with 32th notes each 1 8 note
66     ;;   end beams with 1 8 triplets each 1 4 note
67
68     ((end * * 4 4) . ,(ly:make-moment 1 2))
69     ((end 1 12 4 4) . ,(ly:make-moment 1 4))
70     ((end 1 12 4 4) . ,(ly:make-moment 3 4))
71     
72     ((end 1 16 4 4) . ,(ly:make-moment 1 4))
73     ((end 1 16 4 4) . ,(ly:make-moment 3 4))
74     
75     ((end 1 32 4 4) . ,(ly:make-moment 1 8))
76     ((end 1 32 4 4) . ,(ly:make-moment 1 4))
77     ((end 1 32 4 4) . ,(ly:make-moment 3 8))
78     ((end 1 32 4 4) . ,(ly:make-moment 5 8))
79     ((end 1 32 4 4) . ,(ly:make-moment 3 4))
80     ((end 1 32 4 4) . ,(ly:make-moment 7 8))
81
82     ((end * * 2 4) . #f) ;; switch-off at-any-beat feature
83     ((end * * 2 4) . ,(ly:make-moment 1 4))
84     ((end 1 32 2 4) . ,(ly:make-moment 1 8))
85     ((end 1 32 2 4) . ,(ly:make-moment 3 8))
86
87     ((end * * 4 8) . #f) ;; switch-off at-any-beat feature
88     ((end * * 4 8) . ,(ly:make-moment 1 4))
89     ((end 1 32 4 8) . ,(ly:make-moment 1 8))
90     ((end 1 32 4 8) . ,(ly:make-moment 3 8))
91
92     ((end * * 4 16) . #f) ;; switch-off at-any-beat feature
93     ((end * * 4 16) . ,(ly:make-moment 1 8))
94
95     ((end * * 6 8) . #f) ;; switch-off at-any-beat feature
96     ((end * * 6 8) . ,(ly:make-moment 3 8))
97     ((end 1 32 6 8) . ,(ly:make-moment 1 8))
98     ((end 1 32 6 8) . ,(ly:make-moment 1 4))
99     ((end 1 32 6 8) . ,(ly:make-moment 1 2))
100     ((end 1 32 6 8) . ,(ly:make-moment 5 8))
101
102     ((end * * 9 8) . #f) ;; switch-off at-any-beat feature
103     ((end * * 9 8) . ,(ly:make-moment 3 8))
104     ((end * * 9 8) . ,(ly:make-moment 3 4))
105     ((end 1 32 9 8) . ,(ly:make-moment 1 8))
106     ((end 1 32 9 8) . ,(ly:make-moment 1 4))
107     ((end 1 32 9 8) . ,(ly:make-moment 1 2))
108     ((end 1 32 9 8) . ,(ly:make-moment 5 8))
109     ((end 1 32 9 8) . ,(ly:make-moment 7 8))
110     ((end 1 32 9 8) . ,(ly:make-moment 1 1))
111     ((end 1 32 9 8) . ,(ly:make-moment 9 8))
112
113     ((end * * 12 8) . #f) ;; switch-off at-every-beat
114     ((end * * 12 8) . ,(ly:make-moment 3 8))
115     ((end * * 12 8) . ,(ly:make-moment 3 4))
116     ((end * * 12 8) . ,(ly:make-moment 9 8))
117     ((end * * 12 8) . ,(ly:make-moment 2 1))
118     ((end 1 32 12 8) . ,(ly:make-moment 1 8))
119     ))
120
121 (define (override-property-setting context property setting value)
122   "Like the C++ code that executes \\override, but without type
123 checking. "
124   (ly:context-set-property!
125    context property
126    (cons (cons setting value) (ly:context-property context property))))
127
128 (define (revert-property-setting context property setting)
129   "Like the C++ code that executes \revert, but without type
130 checking. "
131
132   (define (revert-member alist entry new)
133     "Return ALIST, with ENTRY removed.  ALIST is not modified, instead
134 a fresh copy of the list-head is made."
135     (cond
136      ((null? alist) new)
137      ((equal? (car alist) entry) (revert-member (cdr alist) entry new))
138      (else (revert-member (cdr alist) entry (cons (car alist) new)))))
139
140   (ly:context-set-property!
141    context property
142    (revert-member (ly:context-property context property) setting '())))
143
144 (define-public (override-auto-beam-setting setting num den . rest)
145   (ly:export
146    (context-spec-music
147     (make-apply-context (lambda (c)
148                           (override-property-setting
149                            c 'autoBeamSettings
150                            setting (ly:make-moment num den))))
151     (if (and (pair? rest) (symbol? (car rest)))
152         (car rest)
153         'Voice))))
154
155 (define-public (score-override-auto-beam-setting setting num den)
156   (override-auto-beam-setting setting num den 'Score))
157
158 (define-public (revert-auto-beam-setting setting num den . rest)
159   (ly:export
160    (context-spec-music
161     (make-apply-context (lambda (c)
162                           (revert-property-setting
163                            c 'autoBeamSettings
164                            (cons setting (ly:make-moment num den)))))
165     (if (and (pair? rest) (symbol? (car rest)))
166         (car rest)
167         'Voice))))
168
169 ;;  Determine end moment for auto beaming (or begin moment, but mostly
170 ;;  0== anywhere).  In order of decreasing priority:
171 ;;
172 ;;  1. end <type>   *     *
173 ;;  2. end   *      *     *
174 ;;  3. end <type> <num> <den>
175 ;;  4. end   *    <num> <den>
176 ;;  5. if 1-4 not specified: begin anywhere, end at every beat
177 ;;
178 ;;  Rationale:
179 ;;
180 ;;  [user override]
181 ;;  1. override for specific duration type
182 ;;  2. generic override
183 ;;
184 ;;  [to be defined in config file]
185 ;;  3. exceptions for specific time signature, for specific duration type
186 ;;  4. exceptions for specific time signature
187 ;;  5. easy catch-all rule for non-specified measure types
188
189 (define-public (default-auto-beam-check context dir test)
190   (define (get name default)
191     (let ((value (ly:context-property context name)))
192       (if (not (null? value)) value default)))
193
194   ;; Don't start auto beams on grace notes
195   (if (and (!= (ly:moment-grace-numerator (ly:context-now context)) 0)
196            (= dir START))
197       #f
198       (let* ((beat-length (get 'beatLength (ly:make-moment 1 1)))
199              (measure-length (get 'measureLength (ly:make-moment 1 1)))
200              (measure-pos (get 'measurePosition ZERO-MOMENT))
201              (settings (get 'autoBeamSettings '()))
202              (function (list (if (= dir START) 'begin 'end)))
203              (num-mom (ly:moment-div measure-length beat-length))
204              (num (inexact->exact
205                    (round (/ (ly:moment-main-numerator num-mom)
206                              (ly:moment-main-denominator num-mom)))))
207              (den (ly:moment-main-denominator beat-length))
208              (time (list num den))
209              (type (list (ly:moment-main-numerator test)
210                          (ly:moment-main-denominator test)))
211              (pos (if (>= (ly:moment-main-numerator measure-pos) 0)
212                       measure-pos
213                       (ly:moment-add measure-length measure-pos)))
214              (lst (list
215                    ;; Hmm, should junk user-override feature,
216                    ;; or split this in user-override and config section?
217                    (append function type '(* *))
218                    (append function '(* * * *))
219                    (append function type time)
220                    (append function '(* *) time))))
221
222         (if (or
223              ;; always begin or end beams at beginning/ending of measure
224              (= (ly:moment-main-numerator pos) 0)
225              (first-member (map (lambda (x) (cons x pos)) lst) settings))
226             #t
227             (if (= dir START)
228                 ;; if no entry matches our function + time or type,
229                 ;; start anywhere
230                 (not (first-assoc lst settings))
231                 ;; if no entry matches our function + time or type,
232                 ;; end at any beat
233                 (and (not (first-assoc lst settings))
234                      (= (ly:moment-main-denominator
235                          (ly:moment-div pos beat-length)) 1)))))))