changeset 156:cc7724248043

trim-enclosing-silence

darcs-hash:20071204150055-1f211-d8ec6f8099926a2abe9a56411c94fb2de5ebbe45.gz

--- 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 

--- 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)))))
-