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
|
;;InsertGraceNoteHints FIX FOR EMPTY MEASURES
(let ((last-object 'none) (notice #f) (params InstallGraceNoteHints::params))
(define (GetStartTick)
(define tick (d-GetStartTick))
(if tick tick 0))
(define (clean-measure)
(let loop ()
(if (and (not (eq? params 'check)) (Rest?) (d-IsGrace))
(begin
(d-DeleteObject)
(loop)))
(if (d-NextObjectInMeasure)
(loop))))
(define (get-grace)
(define str "(d-InsertBlankWholeNote)(d-MoveCursorLeft)(d-ToggleGrace)")
(let ((duration (d-GetNoteBaseDuration)) )
(set! str (string-append str "(d-Change" (number->string duration) ")(d-MoveCursorRight)")))
(let loop ()
(if (d-NextChordInMeasure)
(if (d-IsGrace)
(begin
(set! str (string-append str "(d-InsertBlankWholeNote)(d-MoveCursorLeft)(d-ToggleGrace)" "(d-Change" (number->string (d-GetNoteBaseDuration)) ")(d-MoveCursorRight)"))
(loop)))))
str)
(define (no-grace-at-tick start-tick)
(define ret #t)
(d-PushPosition)
(let loop ()
(if (= start-tick (GetStartTick))
(if (d-IsGrace)
(set! ret #f)
(if (d-NextObjectInMeasure)
(loop)))))
(d-PopPosition)
(if (not (Music?))
(d-NextObjectInMeasure))
ret)
(define (ensure-grace start-tick grace)
(let loop ()
(if (and (> start-tick (GetStartTick)) (d-NextObjectInMeasure))
(loop)
(begin
(if (= (GetStartTick) start-tick)
(if (and (no-grace-at-tick start-tick) (not params) (not (d-Directive-standalone? "MultiMeasureRests")))
(eval-string grace)))))))
(define (dangerous-grace?)
(let loop ()
(if (not (and (d-IsGrace) (not (d-GetNonprinting)) last-object))
(begin
(set! last-object (not (Music?)))
(if (d-NextObjectInMeasure)
(loop)))))
(d-IsGrace))
(define (fix-measure)
(set! last-object 'beginning)
(if (and (MeasureComplete?) (dangerous-grace?))
(let ((start-tick (GetStartTick)) (grace (get-grace)))
(if (eq? params 'check)
(begin
(if (positive? CheckScore::ignore)
(set! CheckScore::ignore (1- CheckScore::ignore))
(begin
(set! params 'abort)
(set! notice (_ "You may need Grace Note Hints\nPlace grace non-printing rests in the other staffs at this moment if needed or run Install Grace Note Hints to insert them everywhere."))
(set! CheckScore::error-position (GetPosition))
(set! CheckScore::return notice))))
(set! notice (_ "Grace note hints installed")))
(if (not params)
(begin
(d-PushPosition)
(while (MoveUpStaffOrVoice))
(while (d-PrevObjectInMeasure)) ;;if it doesn't go up a staff we may not be at the start.
(ensure-grace start-tick grace)
(let loop ()
(if (MoveDownStaffOrVoice)
(begin
(if (MeasureComplete?)
(ensure-grace start-tick grace))
(loop))))
(d-PopPosition))))))
(define (action-staff action)
(d-MoveToBeginning)
(action)
(while (d-MoveToMeasureRight)
(action)))
(define (action-movement action)
(action-staff action)
(while (MoveDownStaffOrVoice)
(action-staff action)))
;;;actual procedure follows
(if (not params)
(set! params (RadioBoxMenu (cons (_ "Install Hints") #f) (cons (_ "Remove Hints") 'remove))))
(if (eq? params 'remove)
(d-InstallGraceNoteHints 'delete)
(begin
(d-PushPosition)
(while (MoveUpStaffOrVoice))
(action-movement clean-measure)
(while (MoveUpStaffOrVoice))
(action-movement fix-measure)
(if notice
(TimedNotice notice))
(d-PopPosition))))
;;;;;;;;;;;;;;;;;;;;;;
|
