Chord Analyzer/scheme
Zur Navigation springen
Zur Suche springen
#(define (music-elts x)
(if (not (ly:music? x))
'()
(ly:music-property x 'elements)))
#(define (music-name x)
(if (not (ly:music? x))
#f
(ly:music-property x 'name)))
#(define (list-all-chords-from-music music)
;; each element of the list is ly:music
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (music-name music)))
(if (eq? p 'EventChord)
(cons music pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(music-elts music))))))))
#(define (naturalize-pitch p)
;; reduces alteration greater than a half tone step
;; #(display (naturalize-pitch #{ fes #}))
;; #<Pitch e >
(let ((o (ly:pitch-octave p))
(a (* 4 (ly:pitch-alteration p)))
;; alteration, a, in quarter tone steps,
;; for historical reasons
(n (ly:pitch-notename p)))
(cond
((and (> a 1)
(or (eq? n 6)
(eq? n 2)))
(set! a (- a 2))
(set! n (+ n 1)))
((and (< a -1)
(or (eq? n 0) (eq? n 3)))
(set! a (+ a 2))
(set! n (- n 1))))
(cond
((> a 2) (set! a (- a 4)) (set! n (+ n 1)))
((< a -2) (set! a (+ a 4)) (set! n (- n 1))))
(ly:make-pitch o n (/ a 4))))
#(define (all-pitches-from-music music)
"Return a list of all pitches from @var{music}."
;; Opencoded for efficiency.
(reverse!
(let loop ((music music) (pitches '()))
(let ((p (ly:music-property music 'pitch)))
(if (ly:pitch? p)
(cons (naturalize-pitch p) pitches)
(let ((elt (ly:music-property music 'element)))
(fold loop
(if (ly:music? elt)
(loop elt pitches)
pitches)
(ly:music-property music 'elements))))))))
#(define (pitch-equals? p1 p2)
;(write-me "pitch-equals? ----------------------------> " (list p1 p2))
(and
(= (ly:pitch-alteration p1) (ly:pitch-alteration p2))
(= (ly:pitch-notename p1) (ly:pitch-notename p2))))
#(define (ist-in? the-chord the-scale)
(let* ((chordpitches (all-pitches-from-music the-chord))
(scalepitches (all-pitches-from-music the-scale)))
;(write-me "chordpitches ------------------> " chordpitches)
;(write-me "scalepitches ------------------> " scalepitches)
(every (lambda (x)
(let
((istdrin (->bool
(member x scalepitches pitch-equals?))))
;(write-me "ist-in? (x) ---------------------> " istdrin)
istdrin))
chordpitches)))
#(define (chords-contained chord-music the-scale)
(let* ((chord-list (list-all-chords-from-music chord-music)))
; (write-me "chord-list ------------------> " chord-list)
;(write-me "ly:music-property event-chord-------> "
;(ly:music-property chord-music 'elements))
;(write-me "is list? chord-list -------------> " (list? chord-list))
;(write-me "length chord-list ---------------> " (length chord-list))
;(map (lambda (x) (write-me "ly:music elements of chord-list ---------------> " (ly:music? x))) chord-list)
(filter (lambda (x) (ist-in? x the-scale)) chord-list)))))