comparison implementations/mtp/methods.lisp @ 326:5271a0aa06d6

Add extra event slots for articulation, commas and ornaments to amuse-mtp.

 #.(clsql:locally-enable-sql-reader-syntax)
 
 (defvar *event-attributes* 
   (list [dataset-id] [composition-id] [event-id]
         [onset] [dur] [deltast] [cpitch] [mpitch] [accidental] [keysig] [mode]
-        [barlength] [pulses] [phrase] [tempo] [dyn] [voice]))
+        [barlength] [pulses] [phrase] [tempo] [dyn] [voice] [bioi] 
+        [ornament] [comma] [articulation]))
 
 (defgeneric get-dataset (identifer))
 
 (defmethod get-dataset ((identifier mtp-dataset-identifier))
   (let* ((dataset-id (dataset-id identifier))
          (where-clause [= [dataset-id] dataset-id])
          (db-dataset (car (clsql:select [*] :from [mtp-dataset] :where where-clause)))
-         (db-compositions (clsql:select [composition-id][description] 
+         (db-compositions (clsql:select [composition-id][description][timebase]
                                         :from [mtp-composition] 
                                         :order-by '(([composition-id] :asc))
                                         :where where-clause))
          (db-events (apply #'clsql:select 
                            (append *event-attributes* 

                                     :midc (fourth db-dataset)))
          (compositions nil)
          (events nil))
     ;; for each db-composition 
     (dolist (dbc db-compositions)
-      (let ((composition-id (car dbc))
-            (description (car dbc)))
+      (let ((composition-id (first dbc))
+            (description (second dbc))
+            (timebase (third dbc)))
         ;; for each db-event 
         (do* ((dbes db-events (cdr dbes))
               (dbe (car dbes) (car dbes))
               (cid (second dbe) (second dbe)))
              ((or (null dbes) (not (= cid composition-id)))
               (setf db-events dbes))
           (when dbe
-            (push (db-event->mtp-event dbe) events)))
+            (push (db-event->mtp-event dbe timebase) events)))
         (when events
           (let* ((interval (+ (timepoint (car events)) (duration (car events))))
                  (composition 
                   (make-mtp-composition :dataset-id dataset-id 
                                         :composition-id composition-id
                                         :description description
+                                        :timebase timebase
                                         :time 0
                                         :interval interval)))
             (sequence:adjust-sequence composition (length events)
                                       :initial-contents (nreverse events))
             (setf events nil)

          (where-clause [and [= [dataset-id] dataset-id]
                             [= [composition-id] composition-id]])
          (description 
           (car (clsql:select [description] :from [mtp-composition] 
                              :where where-clause :flatp t :field-names nil)))
+         (timebase 
+          (car (clsql:select [timebase] :from [mtp-composition] 
+                             :where where-clause :flatp t :field-names nil)))
          (db-events (apply #'clsql:select 
                            (append *event-attributes* 
                                    (list :from [mtp-event] 
                                          :order-by '(([event-id] :asc))
                                          :where where-clause))))
          (events nil))
     (dolist (e db-events)
-      (push (db-event->mtp-event e) events))
+      (push (db-event->mtp-event e timebase) events))
     (let* ((interval (+ (timepoint (car events)) (duration (car events))))
            (composition 
             (make-mtp-composition :dataset-id dataset-id 
                                   :composition-id composition-id
                                   :description description
+                                  :timebase timebase
                                   :time 0
                                   :interval interval)))
       (sequence:adjust-sequence composition (length events)
                                 :initial-contents (nreverse events))
       composition)))
 
 #.(clsql:restore-sql-reader-syntax-state) 
 
-(defun db-event->mtp-event (db-event)
+(defun db-event->mtp-event (db-event timebase)
   (let* ((slots ; the order must match *event-attributes*
           '(amuse::time amuse::interval deltast cpitch mpitch accidental 
-            keysig mode barlength pulses phrase tempo dyn voice bioi))
+            keysig mode barlength pulses phrase tempo dyn voice bioi 
+            ornament comma articulation))
+         (time-slots '(amuse::time amuse::interval deltast barlength bioi))
          (mtp-event
           (make-mtp-event :dataset-id (first db-event)
                           :composition-id (second db-event)
                           :event-id (third db-event))))
     (do* ((slts slots (cdr slts))
           (db-atts (nthcdr 3 db-event) (cdr db-atts)))
          ((null slts) mtp-event)
-      (setf (slot-value mtp-event (car slts)) (car db-atts)))))
+      (if (member (car slts) time-slots :test #'eql)
+          (setf (slot-value mtp-event (car slts)) (convert-time-slot (car db-atts) timebase))
+          (setf (slot-value mtp-event (car slts)) (car db-atts))))))
+
+(defun convert-time-slot (value timebase)
+  "Convert native representation of time into a representation where
+    a crotchet has a value of 96."
+  (if (or (null value) (null timebase))
+      nil
+      (let ((multiplier (/ 96 timebase)))
+        (* value multiplier))))
 
 ;;; Monodies 
 
 (defmethod monody ((identifier mtp-composition-identifier))
   (monody (get-composition identifier)))

   ;; using the voice of the first event in the piece
   (let ((monody (make-instance 'mtp-monody 
                                :dataset-id (dataset-id c)
                                :composition-id (composition-id c)
                                :description (description c)
+                               :timebase (composition-timebase c)
                                :time 0 
                                :interval (duration c)))
         (events nil)
         (monody-voice nil))
     (sequence:dosequence (event c)

     (sequence:adjust-sequence 
      monody (length events)
      :initial-contents (sort events #'< :key #'amuse:timepoint))
     monody))
 
+
 ;;; Constituents from compositions: time-signatures 
 
 (defmethod crotchet ((dataset mtp-dataset))
   (amuse:make-standard-period 
    (/ (dataset-timebase dataset) 4)))
 
+(defmethod crotchet ((composition mtp-composition))
+  (amuse:make-standard-period 
+   (/ (composition-timebase composition) 4)))
+
 #.(clsql:locally-enable-sql-reader-syntax)
-(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-standard-period (/ timebase 4))))
 (defmethod crotchet ((event mtp-event))
   (let ((timebase 
-         (car (clsql:select [timebase] :from [mtp-dataset]
-                            :where [= [dataset-id] 
-                                      (dataset-id event)]
+         (car (clsql:select [timebase] :from [mtp-composition]
+                            :where [and [= [dataset-id] (dataset-id event)] [= [composition-id] (composition-id event)]]
                             :flatp t 
                             :field-names nil))))
     (amuse:make-standard-period (/ timebase 4))))
 #.(clsql:restore-sql-reader-syntax-state)