# HG changeset patch # User David Lewis # Date 1176904209 -3600 # Node ID 81b4228e26f5f0cfcc829230b917212166bea95a # Parent d1010755f507e5135f9df9d75b9be4fe8d1b10f6 Primarily corrections to large push earlier, including one missed file darcs-hash:20070418135009-f76cc-011412bf4b5a6bb20bd43b41a8a145f69e941926.gz diff -r d1010755f507 -r 81b4228e26f5 base/methods.lisp --- 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)) diff -r d1010755f507 -r 81b4228e26f5 implementations/midi/methods.lisp --- /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 diff -r d1010755f507 -r 81b4228e26f5 utils/harmony/chord-labelling.lisp --- 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