comparison implementations/mtp/methods.lisp @ 96:fade42e8a087

implementations/mtp/: implement CROTCHET

darcs-hash:20070724131529-c0ce4-5c6b749757ff12c1d2c878b95d18465bedc58102.gz

      :initial-contents (sort events #'< :key #'amuse:timepoint))
     monody))
 
 ;;; Constituents from compositions: time-signatures 
 
-(defgeneric timebase (object))
-
-(defmethod timebase ((dataset mtp-dataset))
-  (dataset-timebase dataset))
+(defmethod crotchet ((dataset mtp-dataset))
+  (amuse:make-floating-period 
+   (/ (dataset-timebase dataset) 4)))
 
 #.(clsql:locally-enable-sql-reader-syntax)
-(defmethod timebase ((composition mtp-composition))
-  (car (clsql:select [timebase] :from [mtp-dataset]
-                     :where [= [dataset-id] 
-                               (dataset-id composition)]
-                     :flatp t 
-                     :field-names nil)))
-(defmethod timebase ((event mtp-event))
-  (car (clsql:select [timebase] :from [mtp-dataset]
-                     :where [= [dataset-id] 
-                               (dataset-id event)]
-                     :flatp t 
-                     :field-names nil)))
+(defmethod crotchet ((composition mtp-composition))
+  (let ((timebase 
+         (car (clsql:select [timebase] :from [mtp-dataset]
+                            :where [= [dataset-id] 
+                                      (dataset-id composition)]
+                            :flatp t 
+                            :field-names nil))))
+    (amuse:make-floating-period (/ timebase 4))))
+(defmethod crotchet ((event mtp-event))
+  (let ((timebase 
+         (car (clsql:select [timebase] :from [mtp-dataset]
+                            :where [= [dataset-id] 
+                                      (dataset-id event)]
+                            :flatp t 
+                            :field-names nil))))
+    (amuse:make-floating-period (/ timebase 4))))
 #.(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 e)))
+        (timebase (* 4 (duration (crotchet e)))))
     (list 
      (amuse:make-basic-time-signature pulses 
                                       (/ timebase (/ barlength pulses))
                                       (timepoint e) 
                                       (duration e)))))