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 = "There is a way to enforce enharmonic modifications for
   6 notes in order to have the minimum number of accidentals. In that
   7 case, ``Double accidentals should be removed, as well as E-sharp
   8 (-> F), bC (-> B), bF (-> E), B-sharp (-> C).'', as proposed by a
   9 request for a new feature.  In this manner, the most natural
  10 enharmonic notes are chosen in this example.  "
  11 }
  12
  13 #(define  (naturalise-pitch p)
  14   (let* ((o (ly:pitch-octave p))
  15          (a (* 4 (ly:pitch-alteration p)))
  16     ; alteration, a, in quarter tone steps, for historical reasons
  17          (n (ly:pitch-notename p)))
  18
  19     (cond
  20      ((and (> a 1) (or (eq? n 6) (eq? n 2)))
  21       (set! a (- a 2))
  22       (set! n (+ n 1)))
  23      ((and (< a -1) (or (eq? n 0) (eq? n 3)))
  24       (set! a (+ a 2))
  25       (set! n (- n 1))))
  26
  27     (cond
  28      ((> a 2) (set! a (- a 4)) (set! n (+ n 1)))
  29      ((< a -2) (set! a (+ a 4)) (set! n (- n 1))))
  30
  31     (if (< n 0) (begin (set!  o (- o 1)) (set! n (+ n 7))))
  32     (if (> n 6) (begin (set!  o (+ o 1)) (set! n (- n 7))))
  33
  34     (ly:make-pitch o n (/ a 4))))
  35
  36 #(define (naturalise music)
  37   (let* ((es (ly:music-property music 'elements))
  38          (e (ly:music-property music 'element))
  39          (p (ly:music-property music 'pitch)))
  40
  41     (if (pair? es)
  42         (ly:music-set-property!
  43          music 'elements
  44          (map (lambda (x) (naturalise x)) es)))
  45
  46     (if (ly:music? e)
  47         (ly:music-set-property!
  48          music 'element
  49          (naturalise e)))
  50
  51     (if (ly:pitch? p)
  52         (begin
  53           (set! p (naturalise-pitch p))
  54           (ly:music-set-property! music 'pitch p)))
  55
  56     music))
  57
  58 music =  \relative c' { c4 d  e f g a b  c }
  59
  60 naturaliseMusic =
  61 #(define-music-function (parser location m)
  62                                         (ly:music?)
  63                         (naturalise m))
  64
  65 \score {
  66    \new Staff {
  67      \transpose c ais \music
  68      \naturaliseMusic \transpose c ais \music
  69     \break
  70     \transpose c deses \music
  71     \naturaliseMusic \transpose c deses \music
  72   }
  73   \layout { ragged-right = ##t}
  74 }
  75
  76