changeset 34:81b4228e26f5

Primarily corrections to large push earlier, including one missed file

darcs-hash:20070418135009-f76cc-011412bf4b5a6bb20bd43b41a8a145f69e941926.gz

--- a/base/methods.lisp	Fri Apr 13 11:09:09 2007 +0100
+++ b/base/methods.lisp	Wed Apr 18 14:50:09 2007 +0100
@@ -113,7 +113,7 @@
 (defmethod pitch+ ((object1 pitch-designator)
 		   (object2 pitch-interval)) ; or should I check the
 					     ; pitch/interval types?
-  (make-chromatic-pitch (+ (chromatic-pitch object1)
+  (make-chromatic-pitch (+ (midi-pitch-number object1)
 			   (span object2))))
 
 (defmethod pitch+  ((object1 pitch-interval)
@@ -127,12 +127,12 @@
 
 (defmethod pitch- ((object1 pitch-designator)
 		   (object2 pitch-designator))
-  (make-pitch-interval (- (chromatic-pitch object1)
-			  (chromatic-pitch object2))))
+  (make-pitch-interval (- (midi-pitch-number object1)
+			  (midi-pitch-number object2))))
 
 (defmethod pitch- ((object1 pitch-designator)
 		   (object2 pitch-interval))
-  (make-chromatic-pitch (- (chromatic-pitch object1)
+  (make-chromatic-pitch (- (midi-pitch-number object1)
 			   (span object2))))
 
 (defmethod pitch- ((object1 pitch-interval)
@@ -147,13 +147,13 @@
 
 (defmethod pitch> ((object1 pitch-designator)
 		   (object2 pitch-designator))
-  (> (chromatic-pitch object1)
-     (chromatic-pitch object2)))
+  (> (midi-pitch-number object1)
+     (midi-pitch-number object2)))
 
 (defmethod pitch= ((object1 pitch-designator)
 		   (object2 pitch-designator))
-  (= (chromatic-pitch object1)
-     (chromatic-pitch object2)))
+  (= (midi-pitch-number object1)
+     (midi-pitch-number object2)))
 
 (defmethod interval> ((object1 pitch-interval)
 		   (object2 pitch-interval))

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi/methods.lisp	Wed Apr 18 14:50:09 2007 +0100
@@ -0,0 +1,112 @@
+(cl:in-package #:amuse-midi)
+
+(defgeneric midi-channel (midi-message))
+(defmethod midi-channel ((midi-message midi-message))
+  (%midi-message-channel midi-message))
+
+(defgeneric midi-track (midi-message))
+(defmethod midi-track ((midi-message midi-message))
+  (%midi-message-track midi-message))
+
+(defgeneric midi-velocity (event))
+(defmethod midi-velocity ((event midi-pitched-event))
+  (%midi-pitched-event-velocity event))
+(defmethod midi-velocity ((event midi-percussive-event))
+  (%midi-percussive-event-velocity event))
+
+(defgeneric midi-patch (event))
+(defmethod midi-patch ((event midi-pitched-event))
+  (%midi-pitched-event-patch event))
+
+(defgeneric midi-drum-sound (event))
+(defmethod midi-drum-sound ((event midi-percussive-event))
+  (%midi-percussive-event-sound event))
+
+(defmethod time-signatures ((composition midi-composition))
+  (%midi-time-signatures composition))
+(defmethod (setf time-signatures) (sequence (composition midi-composition))
+  (setf (%midi-time-signatures composition) sequence))
+(defmethod tempi ((composition midi-composition))
+  (%midi-tempi composition))
+(defmethod (setf tempi) (sequence (composition midi-composition))
+  (setf (%midi-tempi composition) sequence))
+
+(defgeneric copy-event (event))
+;; FIXME: This ought to call-next-method and operate on the result,
+;; rather than calling internals from the other package
+(defmethod copy-event ((event midi-pitched-event))
+  (with-slots (channel track (number amuse::number) (time amuse::time) (interval amuse::interval) velocity patch)
+      event
+    (make-instance 'midi-pitched-event
+		   :channel channel
+		   :track track
+		   :number number
+		   :time time
+		   :interval interval
+		   :velocity velocity
+		   :patch patch)))
+(defmethod copy-event ((event midi-percussive-event)) 
+  (with-slots (channel track (time amuse::time) (interval amuse::interval) velocity patch sound)
+      event
+    (make-instance 'midi-percussive-event
+		   :channel channel 
+		   :track track
+		   :time time
+		   :interval interval
+		   :velocity velocity
+		   :patch patch
+		   :sound sound)))
+
+
+;; Allow derived sequences from remove-if, etc. to preserve other slot
+;; info (timesigs, etc)
+(defmethod sequence:make-sequence-like :around ((o midi-composition) length
+						&key (initial-element nil iep)
+						(initial-contents nil icp))
+  (declare (ignore length initial-element initial-contents)) 
+  (let ((result (call-next-method)))
+    (cond
+      ((or iep icp)
+       (setf (timepoint result) (timepoint (elt result 0))
+	     (duration result) (- (timepoint
+				   (loop for e being the elements of result
+				      maximize (cut-off e)))
+				  (timepoint (elt result 0)))))
+      (t (setf (timepoint result) 0
+	       (duration result) 0)))
+    (with-slots (time-signatures tempi misc-controllers)
+	o
+      (setf (%midi-time-signatures result) time-signatures
+	    (%midi-tempi result) tempi
+	    (%midi-misc-controllers result) misc-controllers))
+    result))
+
+
+;; useful little function
+
+(defun microsecond-per-crotchet-to-bpm (mu-per-c)
+  (/ 60000000 mu-per-c))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; MIDI playback methods
+
+(defmethod get-patch-for-midi ((event midi-pitched-event))
+  ;; FIXME
+  (midi-patch event))
+
+(defmethod get-channel-for-midi ((event midi-message))
+  ;; FIXME 1- ??? I'm only doing this because of the Geerdes
+  ;; database. Looks like a recipe for disaster. Think should probably
+  ;; enforce 0-15.
+  (1- (midi-channel event)))
+
+(defmethod get-velocity-for-midi ((event midi-message))
+  ;; FIXME: under-exclusive specialisation. Does this matter?
+  (midi-velocity event))
+
+(defmethod get-pitch-for-midi ((event midi-percussive-event))
+  (midi-drum-sound event))
+
+(defmethod get-pitch-for-midi ((event midi-pitched-event))
+  (midi-pitch-number event))
\ No newline at end of file

--- a/utils/harmony/chord-labelling.lisp	Fri Apr 13 11:09:09 2007 +0100
+++ b/utils/harmony/chord-labelling.lisp	Wed Apr 18 14:50:09 2007 +0100
@@ -25,7 +25,7 @@
 ;;
 
 ;; FIXME: this is in the wrong place
-(defparameter *keys* (make-array 12 :initial-contents '(:c :c# :d :eb :e :f :f# :g :g# :a :bb :b)))
+(defparameter *keys* (make-array 12 :initial-contents '(:c :c# :d :eb :e :f :f# :g :ab :a :bb :b)))
 
 (defparameter *path-options*
   ;; Each of these is a set of division-of-the-bar options for each