diff base/methods.lisp @ 230:32b40c50075e

Add some base methods for searching and sorting events.

Ignore-this: 4906722dfd6d1cfb91df8b85591f8b46

darcs-hash:20091020091537-16a00-1efcd0569b9a242be75bf99908b9117dc5946762.gz

committer: Jamie Forth <[e-mail]>

--- a/base/methods.lisp	Thu Feb 24 11:23:18 2011 +0000
+++ b/base/methods.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -568,8 +568,9 @@
         (error 'insufficient-information :operation 'beat-period :datatype (class-of composition)))))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Copying events in time
+;;;========================================================================
+;;; Copying events in time
+;;;========================================================================
 
 (defmethod move-to-first-bar ((composition composition))
   (let ((offset (floor (timepoint (elt composition 0)))))
@@ -580,3 +581,58 @@
 		(- (timepoint event) offset))
        collect event into shifted-events
        finally (return shifted-events))))
+
+
+;;;========================================================================
+;;; Searching for events
+;;;========================================================================
+
+(defmethod find-next-event ((source-event event) &key predicate test
+			    break-test search-list)
+  "Ideally a sorted search list that begins with the first event after
+the source-event should be provided, otherwise, the search will begin
+from the beginning."
+  (unless search-list (setf search-list (composition source-event)))
+  (cond
+    ((and test predicate)
+     (error "Supplied both a test and a predicate."))
+    (test
+     (sequence:dosequence (e search-list nil)
+       (when (and (time> (onset e) (onset source-event))
+		  (funcall test source-event e))
+	 (return e))
+       (when break-test
+	 (when (funcall break-test source-event e)
+	   (return nil)))))
+    (predicate
+     (sequence:dosequence (e search-list nil)
+       (when (and (time> (onset e) (onset source-event))
+		  (funcall predicate e))
+	 (return e))
+       (when break-test
+	 (when (funcall break-test source-event e)
+	   (return nil)))))))
+
+
+;;;========================================================================
+;;; Sorting Compositions
+;;;========================================================================
+
+(defmethod event< ((event1 event) (event2 event) attribute-list)
+  (dolist (attribute attribute-list nil) ;nil if equal
+    (if (< (funcall attribute event1) (funcall attribute event2))
+	(return t)
+	(if (> (funcall attribute event1) (funcall attribute event2))
+	    (return nil)))))
+
+(defun make-event< (attribute-list)
+  (lambda (event1 event2)
+    (funcall #'event< event1 event2 attribute-list)))
+
+(defmethod sort-composition ((composition composition) dimension-spec)
+  (sequence:make-sequence-like composition
+			       (length composition)
+			       :initial-contents
+			       (stable-sort
+				(copy-seq composition)
+				(make-event< dimension-spec))))