1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
;;MultiMeasureRests
(let ((params MultiMeasureRests::params)(count 1)(WMRtag DenemoWholeMeasureRestTag)(MMRtag "MultiMeasureRests"))
(define (count-grouped-rests)
(let outer-loop ()
(if (d-MoveToMeasureRight)
(let loop ()
(if (d-Directive-standalone? MMRtag)
(begin
(set! count (1+ count))
(outer-loop)
)
(if (d-NextObjectInMeasure)
(loop)))))))
(define (re-calculate)
(d-PushPosition)
(d-MultiMeasureRests 'ungroup)
(d-PopPosition)
(d-MultiMeasureRests #f))
(define (ungroup)
(if (d-Directive-standalone? MMRtag)
(begin
(d-DeleteObject)
(d-WholeMeasureRest)))
(let outer-loop ()
(if (d-MoveToMeasureRight)
(let loop ()
(if (d-Directive-standalone? MMRtag)
(begin
(d-DeleteObject)
(d-WholeMeasureRest)
(outer-loop))
(if (d-NextObjectInMeasure)
(loop)))))))
(define (next-chord-good)
(let loop ()
(if (and (or (d-NextObjectInMeasure) (and (d-MeasureRight) (not (EmptyMeasure?)))) (not (d-Directive-standalone?)) (not (Timesignature?)) (not (Music?)))
(loop)
(Music?))))
(define (groupable-wholemeasure-rest?)
(and (d-Directive-chord? WMRtag) (not (d-GetNonprinting)) (not (d-DirectiveGetNthTag-chord 1))))
;;; procedure starts here
(disp params)
(if (Appending?)
(d-MoveCursorLeft))
(if (and (not params) (d-Directive-standalone? MMRtag))
(set! params "edit"))
(if (eq? params 'recalculate)
(re-calculate)
(cond ((groupable-wholemeasure-rest?)
(set! count 1)
(d-DeleteObject)
(d-Directive-standalone MMRtag)
(d-DirectivePut-standalone-minpixels MMRtag 100)
(d-DirectivePut-standalone-graphic MMRtag "MultiMeasureRests")
(d-DirectivePut-standalone-gx MMRtag 50)
(d-DirectivePut-standalone-gy MMRtag -2)
(d-PushPosition)
(let loop ()
(if (next-chord-good)
(begin
(if (groupable-wholemeasure-rest?)
(begin
(set! count (1+ count))
(d-DeleteObject)
(d-Directive-standalone MMRtag)
(d-SetDurationInTicks (* 1536 (GetPrevailingTimeSig #t)))
(d-DirectivePut-standalone-graphic MMRtag "BracketedWholeMeasureRest")
(d-DirectivePut-standalone-gx MMRtag 50)
(d-DirectivePut-standalone-gy MMRtag -2)
(d-DirectivePut-standalone-postfix MMRtag "%{ grouped rest %}")
(d-DirectivePut-standalone-override MMRtag DENEMO_OVERRIDE_LILYPOND)
(d-DirectivePut-standalone-display MMRtag (_ "Grouped in whole measure rest"))
(d-DirectivePut-standalone-tx MMRtag 25)
(d-DirectivePut-standalone-ty MMRtag -30)
(d-DirectivePut-standalone-minpixels MMRtag 100)
(loop))))))
(d-PopPosition)
(if (d-Directive-standalone? MMRtag)
(begin
(d-SetDurationInTicks (* 1536 (GetPrevailingTimeSig #t)))
(d-DirectivePut-standalone-display MMRtag (string-append "Rest " (number->string count)))
(d-DirectivePut-standalone-ty MMRtag -28)
(d-DirectivePut-standalone-postfix MMRtag (string-append "\\set Score.skipBars = ##t R1*" (GetPrevailingTimeSig) "*" (number->string count)))))
(d-SetSaved #f))
((d-Directive-standalone? MMRtag)
(if (equal? (d-DirectiveGet-standalone-postfix MMRtag) "%{ grouped rest %}")
(begin
(d-InfoDialog (_ "This whole measure rest is grouped with adjacent ones to form a multi-measure rest.\nThe first of the group should be the multi-measure rest itself. Place the cursor on that object to do editing.") #f))
(begin
(if (equal? params "edit")
(let ((choice (d-PopupMenu (list (cons (_ "Help") 'help) (cons (_ "Recalculate") 'recalculate) (cons (_ "Un-group") 'ungroup)))))
(cond ((equal? choice 'help)
(d-InfoDialog (_ "This represents a number of whole measure rests.\nThe following measure rests are grouped with this one when typeset on their own. In full score they are typeset separately to match the other parts.\nIf you add further grouped whole measure rests, this Directive will need re-calculating.\nThe check score routine that is run before printing will do this for you.") #f))
((equal? choice 'recalculate)
(re-calculate))
((equal? choice 'ungroup)
(ungroup))))
(if (eq? params 'ungroup)
(ungroup)
(re-calculate) )))))
(else (let ((number (if params params (begin (d-GetUserInput (_ "Creating Multi-Measure Rests") (_ "Give number of whole measure rests to insert") "2")))))
(if (number? number) (set! number (number->string number)))
(if number
(let ( (meas #f)
(num #f)
(merge (d-GetDurationInTicks))
(oldvol (d-MasterVolume)))
(if merge (set! merge (zero? merge))) ;; we will create mm rests in following bars and then merge the initial empty duration one
(set! number (string->number number))
(if (not (EmptyMeasure?))
(d-InsertMeasureAfter))
(set! meas (d-GetMeasure))
(d-MasterVolume 0)
(set! num number)
(while (positive? number)
(if (not (EmptyMeasure?))
(d-InsertMeasure))
(d-InsertWholeMeasureRest)
(set! number (1- number)))
(d-MasterVolume oldvol)
(d-GoToPosition #f #f meas 1)
(d-MultiMeasureRests)
(if (and merge (d-MoveToMeasureLeft))
(begin
(d-MergeWithNextMeasure)
(d-GoToPosition #f #f (+ num (- meas 2)) 2)))
(d-GoToPosition #f #f (+ num (- meas 1)) 2))
(d-WarningDialog (_ "Cancelled"))))))))
|
