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 @end example
  16 "
  17 }
  18
  19 #(define  (unhair-pitch p)
  20   (let* ((o (pitch-octave p))
  21          (a (pitch-alteration p))
  22          (n (pitch-notename p)))
  23
  24     (cond
  25      ((and (> a 0) (or (eq? n 6) (eq? n 2)))
  26       (set! a (- a 1)) (set! n (+ n 1)))
  27      ((and (< a 0) (or (eq? n 0) (eq? n 3)))
  28       (set! a (+ a 1)) (set! n (- n 1))))
  29
  30     (cond
  31      ((eq? a 2)  (set! a 0) (set! n (+ n 1)))
  32      ((eq? a -2) (set! a 0) (set! n (- n 1))))
  33
  34     (if (< n 0) (begin (set!  o (- o 1)) (set! n (+ n 7))))
  35     (if (> n 7) (begin (set!  o (+ o 1)) (set! n (- n 7))))
  36
  37     (make-pitch o n a)))
  38
  39 #(define (smart-transpose music pitch)
  40   (let* ((es (ly-get-mus-property music 'elements))
  41          (e (ly-get-mus-property music 'element))
  42          (p (ly-get-mus-property music 'pitch))
  43          (body (ly-get-mus-property music 'body))
  44          (alts (ly-get-mus-property music 'alternatives)))
  45
  46     (if (pair? es)
  47         (ly-set-mus-property
  48          music 'elements
  49          (map (lambda (x) (smart-transpose x pitch)) es)))
  50
  51     (if (music? alts)
  52         (ly-set-mus-property
  53          music 'alternatives
  54          (smart-transpose alts pitch)))
  55
  56     (if (music? body)
  57         (ly-set-mus-property
  58          music 'body
  59          (smart-transpose body pitch)))
  60
  61     (if (music? e)
  62         (ly-set-mus-property
  63          music 'element
  64          (smart-transpose e pitch)))
  65
  66     (if (pitch? p)
  67         (begin
  68           (set! p (unhair-pitch (Pitch::transpose p pitch)))
  69           (ly-set-mus-property music 'pitch p)))
  70
  71     music))
  72
  73
  74 music = \notes \relative c' { c4 d  e f g a b  c }
  75
  76 \score {
  77   \notes \context Staff {
  78     \transpose ais' \music
  79     \apply #(lambda (x) (smart-transpose x (make-pitch 0 5 1)))
  80       \music
  81   }
  82   \paper { linewidth = -1. }
  83 }
  84