LEFT | RIGHT |
(no file at all) | |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 2012 David Nalesnik <david.nalesnik@gmail.com> | 3 ;;;; Copyright (C) 2012 David Nalesnik <david.nalesnik@gmail.com> |
4 ;;;; | 4 ;;;; |
5 ;;;; LilyPond is free software: you can redistribute it and/or modify | 5 ;;;; LilyPond is free software: you can redistribute it and/or modify |
6 ;;;; it under the terms of the GNU General Public License as published by | 6 ;;;; it under the terms of the GNU General Public License as published by |
7 ;;;; the Free Software Foundation, either version 3 of the License, or | 7 ;;;; the Free Software Foundation, either version 3 of the License, or |
8 ;;;; (at your option) any later version. | 8 ;;;; (at your option) any later version. |
9 ;;;; | 9 ;;;; |
10 ;;;; LilyPond is distributed in the hope that it will be useful, | 10 ;;;; LilyPond is distributed in the hope that it will be useful, |
(...skipping 99 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
110 receive a count with @code{\\startMeasureCount} and | 110 receive a count with @code{\\startMeasureCount} and |
111 @code{\\stopMeasureCount}."))) | 111 @code{\\stopMeasureCount}."))) |
112 | 112 |
113 (ly:register-translator | 113 (ly:register-translator |
114 Span_stem_engraver 'Span_stem_engraver | 114 Span_stem_engraver 'Span_stem_engraver |
115 '((grobs-created . (Stem)) | 115 '((grobs-created . (Stem)) |
116 (events-accepted . ()) | 116 (events-accepted . ()) |
117 (properties-read . ()) | 117 (properties-read . ()) |
118 (properties-written . ()) | 118 (properties-written . ()) |
119 (description . "Connect cross-staff stems to the stems above in the system"))
) | 119 (description . "Connect cross-staff stems to the stems above in the system"))
) |
| 120 |
| 121 (define-public (Merge_rests_engraver context) |
| 122 "Engraver to merge rests in multiple voices on the same staff. |
| 123 |
| 124 This works by gathering all rests at a time step. If they are all of the same |
| 125 length and there are at least two they are moved to the correct location as |
| 126 if there were one voice." |
| 127 |
| 128 (define (is-single-bar-rest? mmrest) |
| 129 (eqv? (ly:grob-property mmrest 'measure-count) 1)) |
| 130 |
| 131 (define (is-whole-rest? rest) |
| 132 (eqv? (ly:grob-property rest 'duration-log) 0)) |
| 133 |
| 134 (define (mmrest-offset mmrest) |
| 135 "For single measures they should hang from the second line from the top |
| 136 (offset of 1). For longer multimeasure rests they should be centered on the |
| 137 middle line (offset of 0). |
| 138 NOTE: For one-line staves full single measure rests should be positioned at |
| 139 0, but I don't anticipate this engraver's use in that case. No errors are |
| 140 given in this case." |
| 141 (if (is-single-bar-rest? mmrest) 1 0)) |
| 142 |
| 143 (define (rest-offset rest) |
| 144 (if (is-whole-rest? rest) 1 0)) |
| 145 |
| 146 (define (rest-eqv rest-len-prop) |
| 147 "Compare rests according the given property" |
| 148 (define (rest-len rest) (ly:grob-property rest rest-len-prop)) |
| 149 (lambda (rest-a rest-b) |
| 150 (eqv? (rest-len rest-a) (rest-len rest-b)))) |
| 151 |
| 152 (define (merge-mmrests rests) |
| 153 "Move all multimeasure rests to the single voice location." |
| 154 (if (all-equal rests (rest-eqv 'measure-count)) |
| 155 (merge-rests rests mmrest-offset))) |
| 156 |
| 157 (define (merge-rests rests offset-function) |
| 158 (let ((y-offset (offset-function (car rests)))) |
| 159 (for-each |
| 160 (lambda (rest) (ly:grob-set-property! rest 'Y-offset y-offset)) |
| 161 rests)) |
| 162 (for-each |
| 163 (lambda (rest) (ly:grob-set-property! rest 'transparent #t)) |
| 164 (cdr rests))) |
| 165 |
| 166 (define has-one-or-less (lambda (lst) (or (null? lst) (null? (cdr lst))))) |
| 167 (define has-at-least-two (lambda (lst) (not (has-one-or-less lst)))) |
| 168 (define (all-equal lst pred) |
| 169 (or (has-one-or-less lst) |
| 170 (and (pred (car lst) (cadr lst)) (all-equal (cdr lst) pred)))) |
| 171 |
| 172 (let ((curr-mmrests '()) |
| 173 (mmrests '()) |
| 174 (rests '())) |
| 175 (make-engraver |
| 176 ((start-translation-timestep translator) |
| 177 (set! rests '()) |
| 178 (set! curr-mmrests '())) |
| 179 (acknowledgers |
| 180 ((rest-interface engraver grob source-engraver) |
| 181 (cond |
| 182 ((ly:context-property context 'suspendRestMerging #f) |
| 183 #f) |
| 184 ((grob::has-interface grob 'multi-measure-rest-interface) |
| 185 (set! curr-mmrests (cons grob curr-mmrests))) |
| 186 (else |
| 187 (set! rests (cons grob rests)))))) |
| 188 ((stop-translation-timestep translator) |
| 189 (if (and (has-at-least-two rests) (all-equal rests (rest-eqv 'duration-l
og))) |
| 190 (merge-rests rests rest-offset)) |
| 191 (if (has-at-least-two curr-mmrests) |
| 192 (set! mmrests (cons curr-mmrests mmrests)))) |
| 193 ((finalize translator) |
| 194 (for-each merge-mmrests mmrests))))) |
LEFT | RIGHT |