input/lsr/scheme/transpose-pitches-with-minimum-accidentals.ly

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