Left: | ||
Right: |
OLD | NEW |
---|---|
(Empty) | |
1 (define-module (scm merge-rests-engraver) | |
2 #:use-module (lily)) | |
3 | |
4 (define has-one-or-less (lambda (lst) (or (null? lst) (null? (cdr lst))))) | |
5 (define has-at-least-two (lambda (lst) (not (has-one-or-less lst)))) | |
6 (define (all-equal lst pred) | |
7 (or (has-one-or-less lst) | |
8 (and (pred (car lst) (cadr lst)) (all-equal (cdr lst) pred)))) | |
9 | |
10 (define (rest-length rest) | |
thomasmorley651
2017/05/18 20:54:41
This definition is unused later and wouldn't work
horndude77
2017/05/20 05:18:37
I removed the method, though you're right I should
| |
11 (ly:grob-property rest-a 'duration-log)) | |
12 | |
13 (define (rest-same-length rest-a rest-b) | |
14 (eq? | |
david.nalesnik
2017/05/18 14:15:24
Here (and elsewhere) use eqv? to compare numbers.
horndude77
2017/05/20 05:18:37
Done.
| |
15 (ly:grob-property rest-a 'duration-log) | |
16 (ly:grob-property rest-b 'duration-log))) | |
17 | |
18 ; Engraver to merge rests in multiple voices on the same staff. | |
19 ; | |
20 ; This works by gathering all rests at a time step. If they are all of the same | |
21 ; length and there are at least two they are moved to the correct location as | |
22 ; if there were one voice. | |
23 (define-public merge-rests-engraver | |
david.nalesnik
2017/05/18 14:15:24
Here (and below) use the scheme-engraver macro for
thomasmorley651
2017/05/18 20:54:41
Two general questions:
(1)
Is it possible to merge
horndude77
2017/05/20 05:18:37
Done.
horndude77
2017/05/20 05:18:38
Done. They're not combined.
| |
24 (lambda (context) | |
25 (let ((rests '())) | |
26 `((start-translation-timestep . ,(lambda (trans) | |
27 (set! rests '()))) | |
28 (stop-translation-timestep . ,(lambda (trans) | |
29 (if (and (has-at-least-two rests) (all-eq ual rests rest-same-length)) | |
30 (for-each | |
31 (lambda (rest) (ly:grob-set-property! rest 'Y-offset 0)) | |
32 rests)))) | |
33 (acknowledgers | |
34 (rest-interface . ,(lambda (engraver grob source-engraver) | |
35 (if (eq? 'Rest (assoc-ref (ly:grob-property grob ' meta) 'name)) | |
david.nalesnik
2017/05/18 14:15:23
(See comment about recognizing grobs below.)
horndude77
2017/05/20 05:18:37
Done.
| |
36 (set! rests (cons grob rests)))))))))) | |
37 | |
38 (define (mmrest-same-length rest-a rest-b) | |
39 (eq? | |
david.nalesnik
2017/05/18 14:15:24
eqv?
horndude77
2017/05/20 05:18:37
Done.
| |
40 (ly:grob-property rest-a 'measure-count) | |
41 (ly:grob-property rest-b 'measure-count))) | |
42 | |
43 (define (is-single-bar-rest? mmrest) | |
44 (eq? (ly:grob-property mmrest 'measure-count) 1)) | |
david.nalesnik
2017/05/18 14:15:24
eqv?
horndude77
2017/05/20 05:18:38
Done.
| |
45 | |
46 ; For single measures they should hang from the second line from the top | |
47 ; (offset of 1). For longer multimeasure rests they should be centered on the | |
48 ; middle line (offset of 0). | |
49 ; NOTE: For one-line staves full single measure rests should be positioned at | |
50 ; 0, but I don't anticipate this engraver's use in that case. No errors are | |
51 ; given in this case. | |
52 (define (mmrest-offset mmrest) | |
53 (if (is-single-bar-rest? mmrest) 1 0)) | |
54 | |
55 ; Create a lambda for moving rests to the correct offset. | |
56 (define (move-mmrest-to-single-voice example-mmrest) | |
57 (let ((offset (mmrest-offset example-mmrest))) | |
58 (lambda (mmrest) (ly:grob-set-property! mmrest 'Y-offset offset)))) | |
59 | |
60 ; Move all multimeasure rests to the single voice location. | |
61 (define (merge-mmrests rests) | |
62 (if (all-equal rests mmrest-same-length) | |
63 (for-each (move-mmrest-to-single-voice (car rests)) rests))) | |
64 | |
65 ; Engraver to merge multimeasure rests in multiple voices on the same staff. | |
66 ; | |
67 ; Works similar to merge-rest-engraver except for multimeasure rests. | |
68 (define-public merge-mmrests-engraver | |
69 (lambda (context) | |
70 (let* ((curr-rests '()) | |
david.nalesnik
2017/05/18 14:15:24
let* not needed -- use let
horndude77
2017/05/20 05:18:37
Done.
| |
71 (rests '())) | |
72 `((start-translation-timestep . ,(lambda (trans) | |
thomasmorley651
2017/05/18 20:54:41
The order:
start-translation-timestep
stop-transla
horndude77
2017/05/20 05:18:37
Done.
| |
73 (set! curr-rests '()))) | |
74 (stop-translation-timestep . ,(lambda (trans) | |
75 (if (has-at-least-two curr-rests) | |
76 (set! rests (cons curr-rests rests))))) | |
77 (finalize . ,(lambda (translator) | |
78 (for-each merge-mmrests rests))) | |
79 (acknowledgers | |
80 (rest-interface . ,(lambda (engraver grob source-engraver) | |
81 (if (eq? 'MultiMeasureRest (assoc-ref (ly:grob-pro perty grob 'meta) 'name)) | |
david.nalesnik
2017/05/18 14:15:23
You could use grob::name here. Ordinarily, though
horndude77
2017/05/20 05:18:37
Since both multimeasure rests and rests have the r
| |
82 (set! curr-rests (cons grob curr-rests)))))))))) | |
83 | |
OLD | NEW |