input/tricks/smart-transpose.ly

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