input/test/smart-transpose.ly

   1 \version "1.3.146"
   2
   3 \header {
   4 texidoc="
   5 @example
   6     Here's a copy of my feature request :
   7 @quotation
   8         Your task, if you accept it is to implement a \smarttranspose
   9         command> that would translate such oddities into more natural
  10         notations. Double accidentals should be removed, as well as E-sharp
  11         (-> F), bC (-> B), bF (-> E), B-sharp (-> C).
  12 @end quotation
  13
  14 You mean like this. (Sorry 'bout the nuked indentation.)
  15
  16 Modified to use the standard transpose mechanism. The question is
  17 how useful these enharmonic modifications are. Mats B.
  18 @end example
  19 "
  20 }
  21
  22 #(define  (unhair-pitch p)
  23   (let* ((o (pitch-octave p))
  24          (a (pitch-alteration p))
  25          (n (pitch-notename p)))
  26
  27     (cond
  28      ((and (> a 0) (or (eq? n 6) (eq? n 2)))
  29       (set! a (- a 1)) (set! n (+ n 1)))
  30      ((and (< a 0) (or (eq? n 0) (eq? n 3)))
  31       (set! a (+ a 1)) (set! n (- n 1))))
  32
  33     (cond
  34      ((eq? a 2)  (set! a 0) (set! n (+ n 1)))
  35      ((eq? a -2) (set! a 0) (set! n (- n 1))))
  36
  37     (if (< n 0) (begin (set!  o (- o 1)) (set! n (+ n 7))))
  38     (if (> n 6) (begin (set!  o (+ o 1)) (set! n (- n 7))))
  39
  40     (make-pitch o n a)))
  41
  42 #(define (simplify music)
  43   (let* ((es (ly-get-mus-property music 'elements))
  44          (e (ly-get-mus-property music 'element))
  45          (p (ly-get-mus-property music 'pitch))
  46          (body (ly-get-mus-property music 'body))
  47          (alts (ly-get-mus-property music 'alternatives)))
  48
  49     (if (pair? es)
  50         (ly-set-mus-property
  51          music 'elements
  52          (map (lambda (x) (simplify x)) es)))
  53
  54     (if (music? alts)
  55         (ly-set-mus-property
  56          music 'alternatives
  57          (simplify alts)))
  58
  59     (if (music? body)
  60         (ly-set-mus-property
  61          music 'body
  62          (simplify body)))
  63
  64     (if (music? e)
  65         (ly-set-mus-property
  66          music 'element
  67          (simplify e)))
  68
  69     (if (pitch? p)
  70         (begin
  71           (set! p (unhair-pitch p))
  72           (ly-set-mus-property music 'pitch p)))
  73
  74     music))
  75
  76 music = \notes \relative c' { c4 d  e f g a b  c }
  77
  78 \score {
  79   \notes \context Staff {
  80     \transpose ais' \music
  81     \apply #simplify \transpose ais' \music
  82   }
  83   \paper { linewidth = -1. }
  84 }
  85