comparison utils/utils.lisp @ 54:df1482ef96fe

utils.lisp: fix and extend krumhansl-key-finder

darcs-hash:20070621120851-c0ce4-bde38534beea40f71e8206f85583111fdfbe1fcd.gz

 						(aref vector2 j))))
 			      equation-tr)
 		(aref results-array i) (/ equation-t equation-b))))))
 
 
+(defparameter *krumhansl-schmuckler-minor-key*
+  (make-array 12 :initial-contents '(6.33 2.68 3.52 5.38 2.6 3.53 2.54 4.75 3.98 2.69 3.34 3.17)))
+
 (defparameter *krumhansl-schmuckler-major-key*
-  (make-array 12 :initial-contents '(6.33 2.68 3.52 5.38 2.6 3.53 2.54 4.75 3.98 2.69 3.34 3.17)))
-
-(defparameter *krumhansl-schmuckler-minor-key*
   (make-array 12 :initial-contents '(6.35 2.23 3.48 2.33 4.38 4.09 2.52 5.19 2.39 3.66 2.29 2.88)))
 
 (defun krumhansl-key-finder (anchored-period composition
 			     &key (major *krumhansl-schmuckler-major-key*)
 			     (minor *krumhansl-schmuckler-minor-key*))

 		     best-score (aref majors i))))
     (loop for i from 0 to 11
 	  do (when (> (aref minors i) best-score)
 	       (setf key (list i :minor)
 		     best-score (aref minors i))))
-    key))
+    (values key (key->midi-key-signature key anchored-period))))
+
+(defvar *line-of-fifths* (list 5 10 3 8 1 0 7 2 9 4 11 6))
+
+(defun key->midi-key-signature (key anchored-period)
+  (let* ((tonic (car key))
+         (mode (cadr key))
+         (sharps (- (ecase mode
+                      (:major (position tonic *line-of-fifths*))
+                      (:minor (position (mod (- tonic 9) 12) *line-of-fifths*)))
+                    5))
+         (mode (ecase mode (:major 0) (:minor 9))))
+    (amuse:make-midi-key-signature sharps mode 
+                                   (timepoint anchored-period) 
+                                   (duration anchored-period))))
 
 (defun levenshtein-distance (s1 s2 &key (insertion-cost 1)
 			  (insertion-function) (deletion-cost 1)
 			  (deletion-function) (substitution-cost 1)
 			  (substitution-test #'equal) (substitution-function))