Mercurial > hg > amuse
changeset 270:90827cefc9df
Add timebase to compositions for mtp backend.
| author | Marcus Pearce <m.pearce@gold.ac.uk> |
|---|---|
| date | Wed, 09 Feb 2011 17:06:12 +0000 |
| parents | 12c0209cdcb8 |
| children | 5d408226bf0b |
| files | implementations/mtp/classes.lisp implementations/mtp/methods.lisp |
| diffstat | 2 files changed, 32 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/mtp/classes.lisp Thu Jan 27 12:27:06 2011 +0000 +++ b/implementations/mtp/classes.lisp Wed Feb 09 17:06:12 2011 +0000 @@ -35,6 +35,7 @@ (defclass mtp-composition (amuse:standard-composition mtp-music-object) ((dataset-id :initarg :dataset-id :accessor dataset-id) (composition-id :initarg :composition-id :accessor composition-id) + (timebase :initarg :timebase :accessor composition-timebase) (description :initarg :description :accessor description))) (defclass mtp-monody (amuse:standard-monody mtp-composition)
--- a/implementations/mtp/methods.lisp Thu Jan 27 12:27:06 2011 +0000 +++ b/implementations/mtp/methods.lisp Wed Feb 09 17:06:12 2011 +0000 @@ -15,7 +15,7 @@ (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)) @@ -33,8 +33,10 @@ (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))) + (print (list composition-id description)) ;; for each db-event (do* ((dbes db-events (cdr dbes)) (dbe (car dbes) (car dbes)) @@ -42,13 +44,14 @@ ((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) @@ -67,6 +70,9 @@ (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] @@ -74,12 +80,13 @@ :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) @@ -88,11 +95,12 @@ #.(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 ornament)) + (time-slots '(amuse::time amuse::interval deltast barlength bioi)) (mtp-event (make-mtp-event :dataset-id (first db-event) :composition-id (second db-event) @@ -100,8 +108,16 @@ (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." + (let ((multiplier (/ 96 timebase))) + (* value multiplier))) + ;;; Monodies (defmethod monody ((identifier mtp-composition-identifier)) @@ -113,6 +129,7 @@ :dataset-id (dataset-id c) :composition-id (composition-id c) :description (description c) + :timebase (composition-timebase c) :time 0 :interval (duration c))) (events nil) @@ -127,26 +144,22 @@ :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))))