]> git.donarmstrong.com Git - lilypond.git/blob - input/new/transposing-pitches-with-minimum-accidentals-smart-transpose.ly
899659fc88c99d37a14c5d714485cf01984a081a
[lilypond.git] / input / new / transposing-pitches-with-minimum-accidentals-smart-transpose.ly
1 \version "2.11.33"
2 \header {
3   doctitle = "Transposing music with minimum accidentals"
4   lsrtags = "pitches"
5  texidoc = "This example uses some Scheme code to enforce enharmonic modifications for
6 notes in order to have the minimum number of accidentals. In this
7 case, the following rules apply:
8
9 @itemize
10 @item
11 Double accidentals should be removed
12
13 @item
14 B sharp -> C
15
16 @item
17 E sharp -> F
18
19 @item
20 C flat -> B
21
22 @item
23 F flat -> E
24
25 @end itemize
26
27 In this manner, the most natural enharmonic notes are chosen.
28 "}
29
30 #(define  (naturalize-pitch p)
31   (let* ((o (ly:pitch-octave p))
32          (a (* 4 (ly:pitch-alteration p))) 
33     ; alteration, a, in quarter tone steps, for historical reasons
34          (n (ly:pitch-notename p)))
35     (cond
36      ((and (> a 1) (or (eq? n 6) (eq? n 2)))
37       (set! a (- a 2))
38       (set! n (+ n 1)))
39      ((and (< a -1) (or (eq? n 0) (eq? n 3)))
40       (set! a (+ a 2))
41       (set! n (- n 1))))
42     (cond
43      ((> a 2) (set! a (- a 4)) (set! n (+ n 1)))
44      ((< a -2) (set! a (+ a 4)) (set! n (- n 1))))
45     (if (< n 0) (begin (set!  o (- o 1)) (set! n (+ n 7))))
46     (if (> n 6) (begin (set!  o (+ o 1)) (set! n (- n 7))))
47     (ly:make-pitch o n (/ a 4))))
48
49 #(define (naturalize music)
50   (let* ((es (ly:music-property music 'elements))
51          (e (ly:music-property music 'element))
52          (p (ly:music-property music 'pitch)))
53     (if (pair? es)
54         (ly:music-set-property!
55          music 'elements
56          (map (lambda (x) (naturalize x)) es)))
57     (if (ly:music? e)
58         (ly:music-set-property!
59          music 'element
60          (naturalize e)))
61     (if (ly:pitch? p)
62         (begin
63           (set! p (naturalize-pitch p))
64           (ly:music-set-property! music 'pitch p)))
65     music))
66
67 naturalizeMusic =
68 #(define-music-function (parser location m)
69                                         (ly:music?)
70                         (naturalize m))
71
72 music =  \relative c' { c4 d e g }
73
74 \score {
75   \new Staff {
76     \transpose c ais \music
77     \naturalizeMusic \transpose c ais \music
78     \transpose c deses \music
79     \naturalizeMusic \transpose c deses \music
80   }
81   \layout { ragged-right = ##t }
82 }