[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Modified enharmonic.ly (from snippets) (Peter Gentry)
From: |
Peter Gentry |
Subject: |
Modified enharmonic.ly (from snippets) (Peter Gentry) |
Date: |
Wed, 10 Dec 2014 17:26:04 -0000 |
I have revised this small file.
It will sort out accidentals removing double flats/sharps, setting all
according to the current key signature or choosing sharp/flat
as first found in the case of a natural key.
\version "2.18.2"
% OS Vista and Frescobaldi
#(define s 0)
#(define k 0)
#(define nbuf 0)
#(define abuf 0)
#(define (naturalize-pitch p tonic)
(define sharpkey-list '((0 . 0) (1 . 1) (2 . 1) (3 . 0) (4 . 1) (5 . 1) (6 .
1)))
(define flatkey-list '((0 . 0) (1 . 0) (2 . 0) (3 . 1) (4 . 0) (5 . 0) (6 .
0)))
(define sharp-list '((0 . 0) (1 . 0) (2 . 1) (3 . 0) (4 . 0) (5 . 0) (6 .
1)))
(define flat-list '((0 . 1) (1 . 0) (2 . 0) (3 . 1) (4 . 0) (5 . 0) (6
. 0)))
(let ((o (ly:pitch-octave p))
(a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps,
;; for historical reasons
;; get currrent pitch
(n (ly:pitch-notename p)))
; if keychange event determine if key contains flats s=1, naturals s=2 , or
sharps s=3 ")
(cond ((eq? tonic 1 )
(set! s 2)
(set! k 0)
(if (and (eq? a 0) (eq? (cdr(assoc n sharpkey-list)) 1)) (set! s 3))
(if (and (eq? a 0) (eq? (cdr(assoc n flatkey-list)) 1)) (set! s 1))
(if (> a 0) (set! s 3) )
(if (< a 0) (set! s 1) )
;;set preferred accidental
(cond ((and (eq? s 1) (eq? k 0) ) (set! k -2) ) ) ;; flat key
(cond ((and (eq? s 3) (eq? k 0) ) (set! k 2) ) ) ;; sharp key
(set! tonic 0) ))
(set! nbuf n)
(set! abuf a)
; if no keychange event naturalize the pitch
; 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)) )) )
;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)) )) )
;;deal with Cb to B and Fb to E
(cond ((and (eq? tonic 0 ) (< a -1) (eq? (cdr(assoc n flat-list )) 1)
(begin (set! a 0) (set! n (- n 1))))))
;;deal with; B# to C and E# toF
(cond ((and (eq? tonic 0 ) (> a 1) (eq? (cdr(assoc n sharp-list )) 1)
(begin (set! a 0) (set! n (+ n 1))))) )
;take account of preferred flats
(cond ( (and ( < k 0 ) ( > a 0) (eq? (cdr(assoc n sharp-list )) 0 ) )
(begin (set! a (* a -1)) (set! n (+ n 1)))))
(cond ( (and ( < 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 ( > k 0 ) ( < a 0) (eq? (cdr(assoc n flat-list )) 0 ) )
(begin (set! a (* a -1)) (set! n (- n 1)))))
(cond ((and ( > k 0 ) ( < a 0) (eq? (cdr(assoc n flat-list )) 1 ) )
(begin (set! a 0) (set! n (- n 1)))))
;; if natural key save first acceidental as preferred
(cond ((and (eq? s 2) (eq? k 0) ) (set! k a) ) )
;; 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)
(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)))
(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 (ly:pitch? p)
(begin
(set! p (naturalize-pitch p 0))
(ly:music-set-property! music 'pitch p)))
(if (ly:pitch? t)
(begin
(set! t (naturalize-pitch t 1))
(ly:music-set-property! music 'tonic t)))
music)
)
naturalizeMusic =
#(define-music-function (parser location m)
(ly:music?)
(naturalize m))
regards
Peter Gentry
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Modified enharmonic.ly (from snippets) (Peter Gentry),
Peter Gentry <=