input/features/smart-transpose.ly

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