Final version of enharmonic.ly

[Peter Gentry]

This version detects major/minor key by counting the accidentals from 
'pitch-alist and the tonic from 'tonic.

\version "2.18.2"
%{ P Gentry 25December 2014 12:36
;; Modified version of the LilyPond snippet enharmonic.ly (probably better as 
enharmonic.ily)
;; This script will enharmonically spell a music object
;; Semi-tone intervals are dealt in accordance with the Key signature
;; If the Key is C Major or A Minor the first accidental encountered is chosen 
as the preferred accidental
;; For other keys the preferred accidental is taken from the key signature
;; Minor keys are detected ie G major/E minor are treated the same.
;;It may not be elegant but it seems to work
%}

#(define k 0)
#(define nbuf 0)
#(define abuf 0)
#(define keysig 0)
# (define sharps 0)
# (define flats 0)
# (define ton 0)
 
 #(define (count-sharps lst ns ton)
 (if 
     (null? lst)  (set! count-sharps sharps)
      (begin
      (if (eq? ns 0) set! (= ton (car(car  lst))))
      (if (> (cdr(assoc ns lst)) 0) (set! sharps ( + sharps 1 ))      )
        ( set! ns (+ ns 1) ) 
      (if (< ns 7) (count-sharps   lst  ns ton))
        ) 
     ) 
   )
 
 #(define (count-flats lst ns ton)
 (if 
     (null? lst)  (set! count-flats flats)
      (begin
      (if (eq? ns 0) set! (= ton (car(car  lst))))
       (if (< (cdr(assoc ns lst)) 0) (set! flats ( + flats 1 ))      )
        ( set! ns (+ ns 1) ) 
       (if (< ns 7) (count-flats   lst  ns ton))
        ) 
     ) 
   )

 #(define (naturalize-pitch p tonic key-list)
 (define sharp-list    '((0 . 0) (1 . 0) (2 . 1) (3 . 0) (4 . 0) (5 . 0) (6 . 
1)))  ; notes E# and B# may be changed to F and C
dependant on key
 (define flat-list     '((0 . 1) (1 . 0) (2 . 0) (3 . 1) (4 . 0) (5 . 0) (6 . 
0)))  ; notes Cb and Fb may be changed to B and E
dependant on key

 (let ((o (ly:pitch-octave p))
 (a (* 4 (ly:pitch-alteration p)))
 (n (ly:pitch-notename p)))

;if keychange event  detected determine if key contains flats s=1, naturals s=2 
, or sharps s=3 ")   

(cond ((eq? tonic  1 )
(begin
  (set! sharps 0)
  (count-sharps key-list 0 ton)

  (set! flats 0)
  (count-flats key-list 0 ton)
 
(if (and (eq? flats 0) (eq? sharps 0) (eq? n 0)) (display "C major"))
(if (and (eq? flats 0) (eq? sharps 0) (eq? n 5)) (display "A minor"))

  (set! keysig 0)                               ;C Major & A minor contain no 
accidentals
  (set! k 0)
  (if  (> sharps 0)     (set! keysig 3))  ; key contains sharps G D A E B F# C# 
 Major or E F# C# G#  D# A# Minor
  (if  (> flats 0)        (set! keysig 6))  ;key contains flats     F Bb Eb Ab 
Db    Major or G C   F   Bb  Eb Ab  Minor
  (if (eq? sharps 7 )  (set! keysig 1))  ;key C# Major or A# Minor
  (if (eq? sharps 6 )  (set! keysig 2))  ;key F# Major or D# Minor
  (if (eq? flats 7 )     (set! keysig 4))  ;key Cb Major or Ab Minor
  (if (eq? flats 6 )     (set! keysig 5))  ;key Gb Major or Eb Minor

;; if not C major set preferred accidental  type
  (if  (and (< keysig 4)  (> keysig 0)  (eq? k 0))  (set! k  2) )    ;; a sharp 
key
  (if  (and (> keysig 3)                   (eq? k 0))    (set! k -2) )   ;;  a 
flat key
  )
 )
)

; if no keychange event  naturalize the pitch 

(set! nbuf n)
(set! abuf a)
; first remove double accidentals
; 1 deal with double sharps 
(cond ((and (eq? tonic 0) (> a 2)) (begin  (set! n (+ n 1))  (set! a (- a 4)) 
))) 
(cond ((> n 6)  (begin  (set! n (- n 7))  (set! o(+ o 1))  )) )
(cond ((and (eq? (cdr(assoc nbuf sharp-list )) 1) (eq? abuf 4))  (begin (set! a 
(+ a 2)) )))

; 2 deal with double flats
(cond ((and (eq? tonic 0) (< a -2)) (begin (set! n (- n 1)) (set! a(+ a 4)) )))
(cond ((< n 0)  (begin (set! n(+ n 7)) (set! o(- o 1)) )))
(cond ((and (eq? (cdr(assoc nbuf flat-list )) 1) (eq? abuf -4))  (begin (set! a 
(- a 2)) ))) 

;; if key C Major save first accidental as preferred type
(if  (and (eq? tonic 0) (eq? keysig 0) (eq? k 0) (not (eq? a 0)))   (set! k a) 
)  

;;deal with semi-tones Cb to B and Fb to E
; if keysig 6 or 0  and note is Cb or Fb  make note B or E
 (if (and (eq? tonic 0)  (or (eq? keysig 6 ) (eq? keysig 0)) (< a -1)   (eq? 
(cdr(assoc n flat-list)) 1) ) 
     (begin (set! a  0)  (set! n (- n 1))))
; if keysig 4  and  note is  B or E make note Cb or Fb 
 (if (and  (eq? tonic 0) (eq? keysig 4)   (or (eq? n 2) (eq? n 6)) (eq? a 0))
      (begin (set! a -2) (set! n (+ n 1))))
; if keysig 5 and  note is  E make note Fb
 (if (and (eq? tonic 0) (eq? keysig 5) (eq? n 3) (eq? a 0))  
     (begin (set! a  -2)  (set! n (+ n 1))))
 
;;deal with semi-tones B# to C and E# toF
; if keysig 3 or 0  and note is E# or B# make note natural 
(if (and (eq? tonic 0) (or (eq? keysig 3 ) (eq? keysig 0) ) (> a 1) (eq? 
(cdr(assoc n sharp-list)) 1) )  
     (begin (set! a  0)  (set! n (+ n 1))))
; if keysig 1  and  note is  C or F make note B# or E#
 (if (and  (eq? tonic 0) (eq? keysig 1)  (or (eq? n 0) (eq? n 3)) (eq? a 0))
      (begin (set! a 2) (set! n (- n 1))))
; if keysig 2 and  note is   F  make note E#
 (if (and (eq? tonic 0) (eq? keysig 2) (eq? n 3) (eq? a 0))  
     (begin (set! a  2)  (set! n (- n 1))))

;; modify the octave if necessary
(if ( < n 0) (begin (set! o (- o 1)) (set! n (+ n 7))))
(if  (> n 6) (begin (set! o (+ o 1)) (set! n (- n 7))))

;take account of preferred flats
(cond  ( (and  (eq? tonic 0) ( < k 0 )  ( > a  0) (eq? (cdr(assoc n sharp-list 
)) 0 )) (begin  (set! a (* a -1)) (set! n (+ n 1)))))
(cond  ( (and  (eq? tonic 0) ( < k 0 )  ( > a  0) (eq? (cdr(assoc n sharp-list 
)) 1 )) (begin  (set! a 0)        (set! n (+ n 1)))))

;take account of preferred sharps
(cond  ((and  (eq? tonic 0) ( > k 0 )  ( < a  0)  (eq? (cdr(assoc n flat-list 
)) 0 ))  (begin  (set! a (* a -1)) (set! n (-  n
1)))))
(cond  ((and  (eq? tonic 0) ( > k 0 )  ( < a  0)  (eq? (cdr(assoc n flat-list 
)) 1 ))  (begin  (set! a 0)        (set! n (-  n
1)))))

;; modify the octave if necessary
(if ( < n 0) (begin (set! o (- o 1)) (set! n (+ n 7))))
(if  (> n 6) (begin (set! o (+ o 1)) (set! n (- n 7))))
(ly:make-pitch o n (/ a 4))
;; end scope of let
 ) 
;; end scope of naturalize-pitch

) 

#(define (naturalize music)
; get music data from the music file
(let ((es (ly:music-property music 'elements))
       (e   (ly:music-property music 'element))
       (p   (ly:music-property music 'pitch))
       (t   (ly:music-property music 'tonic))
       (key-list (ly:music-property music 'pitch-alist)))
;write back to Lilypond
(if (pair? es)
(ly:music-set-property!
music 'elements
(map (lambda (x) (naturalize x)) es)))

(if (ly:music? e)
(ly:music-set-property!
music 'element
(naturalize e)))

; if lilypond pitch then naturalize before write back
(if (ly:pitch? p)
(begin
(set! p (naturalize-pitch p 0 key-list))
(ly:music-set-property! music 'pitch p)))


  ; if lilypond tonic then call naturalize but don't modify the pitch before 
write back
(if (ly:pitch? t)
(begin
(set! t (naturalize-pitch t 1 key-list))
(ly:music-set-property! music 'tonic t)))



music )  
) 

naturalizeMusic =
#(define-music-function (parser location m)
(ly:music?)
(naturalize m))



Merry Christmas etc etc

Peter Gentry