# HG changeset patch # User d.mullensiefen # Date 1196780455 0 # Node ID cc7724248043095be69025a130c00d71640e0dfb # Parent fc6848dda767a85803335619293e1fb2f2e51768 trim-enclosing-silence darcs-hash:20071204150055-1f211-d8ec6f8099926a2abe9a56411c94fb2de5ebbe45.gz diff -r fc6848dda767 -r cc7724248043 base/generics.lisp --- a/base/generics.lisp Tue Dec 04 14:39:20 2007 +0000 +++ b/base/generics.lisp Tue Dec 04 15:00:55 2007 +0000 @@ -394,6 +394,12 @@ (:documentation "Returns ANCHORED-PERIOD of subclass appropriate to the class of value. Probably guessed.")) +(defgeneric trim-enclosing-silence (composition) + (:documentation "Returns a composition of the same type as + composition provided, with leading and following silences/rests + removed, but preserving all relevant information. Where + relevant, any silence in a bar containing musical material may + be preserved.") ;;; Dynamics ;;; Voice diff -r fc6848dda767 -r cc7724248043 implementations/midi/methods.lisp --- a/implementations/midi/methods.lisp Tue Dec 04 14:39:20 2007 +0000 +++ b/implementations/midi/methods.lisp Tue Dec 04 15:00:55 2007 +0000 @@ -187,45 +187,3 @@ (defmethod crotchet ((object midi-object)) (make-standard-period 1)) - -(defmethod monody ((identifier midifile-identifier)) - (monody (get-composition identifier))) - -;; TODO: improve this naive first-cut at MONODY for midi files which -;; simply selects a track which is both monodic (if any monodic tracks -;; exist) and contains the highest pitch of any monodic track. -(defmethod monody ((c midi-composition)) - (flet ((not-overlapping (track) - (let ((result t) - (track (sort (copy-list track) #'amuse:time<))) - (dotimes (i (1- (length track)) result) - (let ((e1 (elt track i)) - (e2 (elt track (1+ i)))) - (unless (or (before e1 e2) (meets e1 e2)) - (setf result nil))))))) - (let ((tracks (make-hash-table)) - (result nil) - (max-pitch 0)) - (sequence:dosequence (message c) - (let* ((tracknum (amuse-midi:midi-track message)) - (track (gethash tracknum tracks))) - (setf (gethash tracknum tracks) (cons message track)))) - (maphash #'(lambda (k v) - (declare (ignore k)) - (let ((max (apply #'max (mapcar #'midi-pitch-number v)))) - (when (and (not-overlapping v) (> max max-pitch)) - (setf result (sort v #'amuse:time<) - max-pitch max)))) - tracks) - (when result - (let ((monody (make-instance 'midi-monody - :time (amuse:timepoint c) - :interval (amuse:duration c) - :time-signatures (time-signatures c) - :key-signatures (key-signatures c) - :tempi (tempi c) - :controllers (%midi-misc-controllers c)))) - (sequence:adjust-sequence monody (length result) - :initial-contents result) - monody))))) -