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