diff utils/utils.lisp @ 54:df1482ef96fe

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

darcs-hash:20070621120851-c0ce4-bde38534beea40f71e8206f85583111fdfbe1fcd.gz

--- a/utils/utils.lisp	Thu Jun 21 13:07:21 2007 +0100
+++ b/utils/utils.lisp	Thu Jun 21 13:08:51 2007 +0100
@@ -126,10 +126,10 @@
 		(aref results-array i) (/ equation-t equation-b))))))
 
 
-(defparameter *krumhansl-schmuckler-major-key*
+(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-minor-key*
+(defparameter *krumhansl-schmuckler-major-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
@@ -147,7 +147,21 @@
 	  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)
@@ -402,4 +416,4 @@
       (when previous-event
 	(push (span (pitch- event previous-event))
 	      intervals))
-      (setf previous-event event))))
\ No newline at end of file
+      (setf previous-event event))))