comparison implementations/midi/midifile-import.lisp @ 36:ad321ce17e3e

Moving some functionality from specialised geerdes area. Also added mcsv output

darcs-hash:20070511120916-f76cc-d6f1b566eea7115c5de1d3aad285c84b304730b7.gz

 			    (or (< (midi:message-time x)
 				   (midi:message-time y))
 				(and (= (midi:message-time x)
 					(midi:message-time y))
 				     (typep x 'midi:note-off-message))))))
-      (let ((ons (make-array '(17 128) :initial-element nil))
+      (let ((ons (make-array '(16 128) :initial-element nil))
 	    (offs) 
-	    (patches (make-array 17 :initial-element 0)))
+	    (patches (make-array 16 :initial-element 0)))
 	(dolist (event track)
 	  (when (> (midi:message-time event) last-time)
 	    (setf last-time (midi:message-time event)))
 	  (cond
 	    ((or (typep event 'midi:note-off-message)
 		 (and (typep event 'midi:note-on-message)
 		      (= (midi:message-velocity event) 0)))
 	     (let ((pitch (midi:message-key event))
-		   (channel (1+ (midi:message-channel event)))
+		   (channel (midi:message-channel event))
 		   (t-off (midi:message-time event)))
 	       (if (aref ons channel pitch)
 		   (push (make-event-from-on-off-pair (aref ons channel pitch)
 						      t-off
 						      division

 		   ;; if there's no matching on, wait until the beat
 		   ;; is done.
 		   (push event offs))))
 	    ((typep event 'midi:note-on-message)
 	     (let ((pitch (midi:message-key event))
-		   (channel (1+ (midi:message-channel event)))
+		   (channel (midi:message-channel event))
 		   (t-off (midi:message-time event)))
 	       (when (aref ons channel pitch)
 		 ;; there's a note already sounding. End it.
 		 (push (make-event-from-on-off-pair (aref ons channel pitch)
 						    t-off

 			(timepoint (car time-sigs)))))
 	     (push (make-instance 'basic-time-signature
 				  :time (/ (midi:message-time event)
 					   division)
 				  :numerator (midi:message-numerator event)
-				  :denominator (midi:message-denominator event))
+				  :denominator (expt 2 (midi:message-denominator event)))
 		   time-sigs))
 	    ((typep event 'midi:tempo-message)
 	     (when tempi
 	       (setf (duration (car tempi))
 		     (- (/ (midi:message-time event)

 				  :time (/ (midi:message-time event)
 					   division)
 				  :bpm (microsecond-per-crotchet-to-bpm (midi:message-tempo event)))
 		   tempi))
 	    ((typep event 'midi:program-change-message)
-	     (setf (aref patches (1+ (midi:message-channel event)))
+	     (setf (aref patches (midi:message-channel event))
 		   (midi:message-program event)))
 	    (t (incf misses))))))
     (when tempi
       (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)))))
     ;; make a midi object from notes, etc.
     (let ((composition (make-instance 'midi-composition
 				      :time 0
 				      :interval (/ last-time division)
-				      :time-signatures (sort time-sigs #'time<)
+				      :time-signatures (if time-sigs
+							   (sort time-sigs #'time<)
+							   (list (make-instance 'basic-time-signature
+										:time 0
+										:interval (/ last-time division)
+										:numerator 4
+										:denominator 4)))
 				      :tempi (sort tempi #'time<))))
       (sequence:adjust-sequence composition
 				(length notes)
 				:initial-contents (sort notes #'time<)))))
 
-(defparameter *short* nil)
-
 (defun make-event-from-on-off-pair (note-on cut-off divisions track patch)
-  (when (< (/ (- cut-off (midi:message-time note-on)) divisions) 1/8)
-    (push (cons note-on cut-off) *short*))
   (cond
     ((or (= (midi:message-channel note-on) 9)
 	 (> patch 111))
      ;; percussive
      (make-instance 'midi-percussive-event