diff implementations/mtp/methods.lisp @ 69:873d7546d2fe

implementations/mtp/: GET-APPLICABLE-{TIME-SIGNATURES,KEY-SIGNATURES,TEMPI} darcs-hash:20070706111027-c0ce4-fc8f6939653f481a981547cbcc0219e9202663b1.gz
author Marcus Pearce <m.pearce@gold.ac.uk>
date Fri, 06 Jul 2007 12:10:27 +0100
parents 95dce8c7f08c
children 19a4ad162cf9
line wrap: on
line diff
--- a/implementations/mtp/methods.lisp	Fri Jul 06 10:41:45 2007 +0100
+++ b/implementations/mtp/methods.lisp	Fri Jul 06 12:10:27 2007 +0100
@@ -90,14 +90,6 @@
 
 ;;; Constituents from compositions: time-signatures 
 
-(defgeneric time-signature (event))
-(defmethod time-signature ((e mtp-event))
-  (let ((pulses (%mtp-pulses e))
-        (barlength (%mtp-barlength e))
-        (timebase (timebase-for-event e)))
-    (make-basic-time-signature pulses (/ timebase (/ barlength pulses)) 
-                               (timepoint e) nil)))
-
 #.(clsql:locally-enable-sql-reader-syntax)
 (defun timebase-for-event (event)
   (car (clsql:select [timebase] :from [mtp-dataset]
@@ -107,12 +99,23 @@
                      :field-names nil)))
 #.(clsql:restore-sql-reader-syntax-state) 
 
+(defmethod get-applicable-time-signatures ((e mtp-event) c)
+  (declare (ignore c))
+  (let ((pulses (%mtp-pulses e))
+        (barlength (%mtp-barlength e))
+        (timebase (timebase-for-event e)))
+    (list 
+     (amuse:make-basic-time-signature pulses 
+                                      (/ timebase (/ barlength pulses))
+                                      (timepoint e) 
+                                      (duration e)))))
+
 (defmethod time-signatures ((c mtp-composition))
   (let ((results nil)
         (interval 0) 
         (current nil))
     (sequence:dosequence (event c)
-      (let ((ts (time-signature event)))
+      (let ((ts (car (get-applicable-time-signatures event c)))
         (when (and (%mtp-barlength event)
                    (%mtp-pulses event)
                    (or (null current)
@@ -131,20 +134,21 @@
 
 ;;; Constituents from compositions: key-signatures 
 
-(defgeneric key-signature (event))
-(defmethod key-signature ((e mtp-event))
-  (let* ((keysig (%mtp-keysig e))
+(defmethod get-applicable-key-signatures ((e mtp-event) c)
+  (declare (ignore c))
+  (let* ((sharps (%mtp-keysig e))
          (mode (%mtp-mode e))
-         (midi-mode (and mode (if (= mode 0) 0 1)))
-         (onset (timepoint e)))
-    (amuse:make-midi-key-signature keysig midi-mode onset nil)))
+         (midi-mode (and mode (if (= mode 0) 0 1))))
+    (list (amuse:make-midi-key-signature sharps midi-mode 
+                                         (timepoint e) 
+                                         (duration e)))))
 
 (defmethod key-signatures ((c mtp-composition))
   (let ((results nil)
         (interval 0) 
         (current nil))
     (sequence:dosequence (event c)
-      (let ((ks (key-signature event)))
+      (let ((ks (car (get-applicable-key-signatures event c))))
         (when (and (%mtp-keysig event)
                    (%mtp-mode event)
                    (or (null current)
@@ -163,6 +167,12 @@
 
 ;;; Constituents from compositions: tempi  
 
+(defmethod get-applicable-tempi ((e mtp-event) c)
+  (declare (ignore c))
+  (list (amuse:make-tempo (%mtp-tempo event) 
+                          (timepoint event) 
+                          (duration event))))
+
 (defmethod tempi ((c mtp-composition)) 
   (let ((results nil)
         (interval 0) 
@@ -174,9 +184,7 @@
         (unless (null current) 
           (setf (duration current) interval)
           (push current results))
-        (let ((new (amuse:make-tempo (%mtp-tempo event)
-                                     (timepoint event) 
-                                     nil)))
+        (let ((new (car (get-applicable-tempi event c))))
           (setf interval 0
                 current new)))
       (incf interval (%mtp-deltast event))