Mercurial > hg > amuse

changeset 165:f59787f1101e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move get-applicable-x methods from amuse-geerdes to amuse-midi darcs-hash:20080101123930-40ec0-027c40b74a7d44e85a003aea00d5610c053c46ec.gz
author d.lewis <d.lewis@gold.ac.uk>
date Tue, 01 Jan 2008 12:39:30 +0000
parents 27e29dd5978b
children db4acf840bf0
files implementations/midi/methods.lisp
diffstat 1 files changed, 20 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/implementations/midi/methods.lisp	Fri Dec 21 11:48:45 2007 +0000
+++ b/implementations/midi/methods.lisp	Tue Jan 01 12:39:30 2008 +0000
@@ -323,4 +323,23 @@
                   (time+ bar bar-period))
              (prev-bar (onset (car time-sigs))))
             ((time> bar moment) (return-from bar-before prev-bar))
-          (setf prev-bar bar))))))
\ No newline at end of file
+          (setf prev-bar bar))))))
+
+(defmethod get-applicable-time-signatures ((anchored-period anchored-period)
+                                           (composition midi-composition))
+  (%find-overlapping anchored-period (time-signatures composition)))
+(defmethod get-applicable-tempi ((anchored-period anchored-period)
+                                 (composition midi-composition))
+  (%find-overlapping anchored-period (tempi composition)))
+(defmethod get-applicable-key-signatures ((anchored-period anchored-period)
+                                          (composition midi-composition))
+  (%find-overlapping anchored-period (key-signatures composition)))
+
+(defun %find-overlapping (period1 period-list)
+  (let ((result-list))
+    (dolist (period2 period-list result-list)
+      (cond
+        ((time>= period2 (cut-off period1))
+         (return-from %find-overlapping (reverse result-list)))
+        ((time> (cut-off period2) period1)
+         (push period2 result-list))))))
\ No newline at end of file