Mercurial > hg > amuse
changeset 225:6f0881af3403
add composition slot to event (meredith)
Ignore-this: d6b133f7d17684bf3f7c1ccde28c7d8a
darcs-hash:20090828164631-16a00-1a25e46b8142401466f4a6ec7159a10d8e31de40.gz
committer: Jamie Forth <j.forth@gold.ac.uk>
| author | j.forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 24 Feb 2011 11:23:18 +0000 |
| parents | 7afb8cfdcdcf |
| children | 64b795c2ff18 |
| files | implementations/meredith/classes.lisp implementations/meredith/constructors.lisp implementations/meredith/methods.lisp |
| diffstat | 3 files changed, 18 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/meredith/classes.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/implementations/meredith/classes.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -31,6 +31,7 @@ (defclass meredith-event (amuse:chromatic-pitched-event amuse:diatonic-pitched-event amuse:standard-anchored-period + amuse:linked-event meredith-music-object) ((identifier :initarg :identifier :accessor identifier) (tatum-on :initarg :tatum-on :accessor tatum-on)
--- a/implementations/meredith/constructors.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/implementations/meredith/constructors.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -16,7 +16,7 @@ (defun make-meredith-event (&rest args) (apply #'make-instance 'meredith-event args)) -(defun db-event->meredith-event (db-event) +(defun db-event->meredith-event (db-event composition) (destructuring-bind (event-id tatum-on tatum-dur tactus-on tactus-dur crot-on crot-dur tatum-on-ms tatum-dur-ms beat-on-ms @@ -24,6 +24,7 @@ pitch-name midi-note-number cpitch mpitch voice) db-event (make-meredith-event :identifier event-id + :composition composition :tatum-on tatum-on :tatum-dur tatum-dur :tactus-on tactus-on
--- a/implementations/meredith/methods.lisp Thu Feb 24 11:23:18 2011 +0000 +++ b/implementations/meredith/methods.lisp Thu Feb 24 11:23:18 2011 +0000 @@ -22,22 +22,25 @@ (let* ((composition-id (composition-id identifier)) (where-clause [= [composition-id] composition-id]) (description - (car (clsql:select [description] :from [|meredith-compositions|] - :where where-clause :flatp t :field-names nil))) + (car (clsql:select [description] + :from [|meredith-compositions|] + :where where-clause + :flatp t + :field-names nil + :database *amuse-database*))) + (composition (make-meredith-composition + :identifier identifier + :description description)) (db-events (apply #'clsql:select (append *event-attributes* (list :from [|meredith-events|] :order-by '(([event-id] :asc)) - :where where-clause)))) - (events nil)) - (dolist (e db-events) - (push (db-event->meredith-event e) events)) - (let* ((composition - (make-meredith-composition :identifier identifier - :description description))) - (sequence:adjust-sequence composition (length events) - :initial-contents (nreverse events)) - composition)) + :where where-clause + :database *amuse-database*)))) + (events (loop for e in db-events + collect (db-event->meredith-event e composition)))) + (sequence:adjust-sequence composition (length events) + :initial-contents events)) #.(clsql:locally-disable-sql-reader-syntax)) (defmethod copy-event (event)