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 |
\version "2.19.15"
#(define (naturalize-instrument-range p instrument )
(let ((o (ly:pitch-octave p))
(a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps, ;; for historical reasons
(n (ly:pitch-notename p)))
(cond
((equal? instrument "clarinet" )
(if (<= o -1) (begin (set! o -1 )))
(if (>= o 3) (begin (set! o 2 )))
(cond
( (and (= o -1) (<= a 2) (<= n 1)) (set! o 0))
( (and (= o 2) (> n 3)) (set! o 1))
( (and (= o 2) (<= n 3)) (set! o 2)) )
(if (> o 2) (begin (set! o 2 ))))
((equal? instrument "flute")
(if (< o 0) (begin (set! o 0 )))
(cond
( (and (= o 0) (< a 0) (= n 0)) (set! o 1))
( (and (= o 2) (> n 3)) (set! o 1))
( (and (= o 2) (<= n 3)) (set! o 2)) )
(if (> o 2) (begin (set! o 2 )))) )
(ly:make-pitch o n (/ a 4))
))
my-color = #(x11-color 'red)
#(define (instrumentrange music instrument )
( ly:music? string? )
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element))
(p (ly:music-property music 'pitch)))
(if (pair? es)
(ly:music-set-property! music 'elements
(map (lambda (x) (instrumentrange x instrument)) es)))
(if (ly:music? e) (ly:music-set-property! music 'element
(instrumentrange e instrument )))
(if (ly:pitch? p)
(let ((new-pitch (naturalize-instrument-range p instrument)))
(ly:music-set-property! music 'pitch new-pitch)
(if (and (not (equal? p new-pitch)) (color? my-color))
(ly:music-set-property! music 'tweaks
(acons
'color my-color
(ly:music-property music 'tweaks))))))
music))
naturalizeInstrumentRange =
#(define-music-function (parser location instrument m )
( string? ly:music? )
(instrumentrange m instrument ))
\score {
\new Staff
\naturalizeInstrumentRange "clarinet"
\relative c'' {
d4 r16 d,,16 [ e'16 f16 ] e8 [ a,8 ] a''16 [ g'16 a16 e16 ] | % 4
f8 [ d8 ] r4 r2 | % 5
}
}
\score {
\new Staff
\relative c'' {
d4 r16 d,,16 [ e'16 f16 ] e8 [ a,8 ] a''16 [ g'16 a16 e16 ] | % 4
f8 [ d8 ] r4 r2 | % 5
}} |