# HG changeset patch
# User David Lewis <d.lewis@gold.ac.uk>
# Date 1185461224 -3600
# Node ID cf198383852d7230113e8e2fe13a0db68a2bdc03
# Parent  956f4c6f857104b40eeaf777d269c689574986cb
Re-instated get-applicable-x for midi-related implementations and added key-sigs to midi

darcs-hash:20070726144704-f76cc-a24c9e6c07b43c4084a73218f76a0b345fac5369.gz

diff -r 956f4c6f8571 -r cf198383852d implementations/geerdes/methods.lisp
--- a/implementations/geerdes/methods.lisp	Thu Jul 26 12:41:09 2007 +0100
+++ b/implementations/geerdes/methods.lisp	Thu Jul 26 15:47:04 2007 +0100
@@ -146,4 +146,20 @@
   (= (midi-channel event) 4))
 
 (defmethod crotchet ((identifier geerdes-identifier))
-  (make-instance 'floating-period :interval 1))
\ No newline at end of file
+  (make-instance 'floating-period :interval 1))
+
+(defmethod get-applicable-time-signatures ((anchored-period anchored-period) (composition midi-composition))
+  (%find-overlapping anchored-period (time-signatures composition)))
+(defmethod get-applicable-tempi ((anchored-period anchored-period) (composition midi-composition))
+  (%find-overlapping anchored-period (tempi composition)))
+(defmethod get-applicable-key-signatures ((anchored-period anchored-period) (composition midi-composition))
+  (%find-overlapping anchored-period (key-signatures composition)))
+
+(defun %find-overlapping (period1 period-list)
+  (let ((result-list))
+    (dolist (period2 period-list result-list)
+      (cond
+	((before period1 period2)
+	 (return-from %find-overlapping (reverse result-list)))
+	((not (before period2 period1))
+	 (push period2 result-list))))))
\ No newline at end of file
diff -r 956f4c6f8571 -r cf198383852d implementations/midi/classes.lisp
--- a/implementations/midi/classes.lisp	Thu Jul 26 12:41:09 2007 +0100
+++ b/implementations/midi/classes.lisp	Thu Jul 26 15:47:04 2007 +0100
@@ -7,6 +7,9 @@
    (tempi :initarg :tempi
 	  :initform 'nil
 	  :accessor %midi-tempi)
+   (key-signatures  :initarg :key-signatures
+		    :initform 'nil
+		    :accessor %midi-key-signatures)
    (misc-controllers :initarg :controllers
 		      :initform 'nil
 		      :accessor %midi-misc-controllers)))
diff -r 956f4c6f8571 -r cf198383852d implementations/midi/methods.lisp
--- a/implementations/midi/methods.lisp	Thu Jul 26 12:41:09 2007 +0100
+++ b/implementations/midi/methods.lisp	Thu Jul 26 15:47:04 2007 +0100
@@ -30,6 +30,10 @@
   (%midi-tempi composition))
 (defmethod (setf tempi) (sequence (composition midi-composition))
   (setf (%midi-tempi composition) sequence))
+(defmethod key-signatures ((composition midi-composition))
+  (%midi-key-signatures composition))
+(defmethod (setf key-signatures) (sequence (composition midi-composition))
+  (setf (%midi-key-signatures composition) sequence))
 
 (defgeneric copy-event (event))
 ;; FIXME: This ought to call-next-method and operate on the result,
diff -r 956f4c6f8571 -r cf198383852d implementations/midi/midifile-import.lisp
--- a/implementations/midi/midifile-import.lisp	Thu Jul 26 12:41:09 2007 +0100
+++ b/implementations/midi/midifile-import.lisp	Thu Jul 26 15:47:04 2007 +0100
@@ -19,7 +19,8 @@
   ;; FIXME: assumes controllers are global in scope and location
   (let ((tracks (midi:midifile-tracks midifile))
 	(division (midi:midifile-division midifile))
-	(notes) (time-sigs) (tempi) (misses 0) (track-no -1) (last-time 0))
+	(notes) (time-sigs) (key-sigs) (tempi) (misses 0)
+	(track-no -1) (last-time 0))
     (dolist (track tracks)
       (incf track-no)
       (setf track (sort (copy-seq track)
@@ -79,6 +80,20 @@
 				  :numerator (midi:message-numerator event)
 				  :denominator (expt 2 (midi:message-denominator event)))
 		   time-sigs))
+	    ((typep event 'midi:key-signature-message)
+	     ;; FIXME: Should I make a midi version of this object,
+	     ;; with track/channel? [probably, yes]
+	     (when key-sigs
+	       (setf (duration (car time-sigs))
+		     (- (/ (midi:message-time event)
+			   division)
+			(timepoint (car time-sigs)))))
+	     (push (make-instance 'midi-key-signature
+				  :time (/ (midi:message-time event)
+					   division)
+				  :sharp-count (message-sf event)
+				  :mode (message-mi event))
+		   key-sigs))
 	    ((typep event 'midi:tempo-message)
 	     (when tempi
 	       (setf (duration (car tempi))
@@ -98,6 +113,8 @@
       (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi)))))
     (when time-sigs
       (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs)))))
+    (when key-sigs
+      (setf (duration (car key-sigs)) (- (/ last-time division) (timepoint (car key-sigs)))))
     ;; make a midi object from notes, etc.
     (let ((composition (make-instance 'midi-composition
 				      :time 0
@@ -109,7 +126,8 @@
 										:interval (/ last-time division)
 										:numerator 4
 										:denominator 4)))
-				      :tempi (sort tempi #'time<))))
+				      :tempi (sort tempi #'time<)
+				      :key-signatures (sort key-signatures #'time<))))
       (sequence:adjust-sequence composition
 				(length notes)
 				:initial-contents (sort notes #'time<)))))