Mercurial > hg > amuse
comparison implementations/meredith/methods.lisp @ 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 | 4eceac78e7c6 |
children | 7412629f5c78 |
comparison
equal
deleted
inserted
replaced
224:7afb8cfdcdcf | 225:6f0881af3403 |
---|---|
20 (defmethod get-composition ((identifier meredith-composition-identifier)) | 20 (defmethod get-composition ((identifier meredith-composition-identifier)) |
21 #.(clsql:locally-enable-sql-reader-syntax) | 21 #.(clsql:locally-enable-sql-reader-syntax) |
22 (let* ((composition-id (composition-id identifier)) | 22 (let* ((composition-id (composition-id identifier)) |
23 (where-clause [= [composition-id] composition-id]) | 23 (where-clause [= [composition-id] composition-id]) |
24 (description | 24 (description |
25 (car (clsql:select [description] :from [|meredith-compositions|] | 25 (car (clsql:select [description] |
26 :where where-clause :flatp t :field-names nil))) | 26 :from [|meredith-compositions|] |
27 :where where-clause | |
28 :flatp t | |
29 :field-names nil | |
30 :database *amuse-database*))) | |
31 (composition (make-meredith-composition | |
32 :identifier identifier | |
33 :description description)) | |
27 (db-events (apply #'clsql:select | 34 (db-events (apply #'clsql:select |
28 (append *event-attributes* | 35 (append *event-attributes* |
29 (list :from [|meredith-events|] | 36 (list :from [|meredith-events|] |
30 :order-by '(([event-id] :asc)) | 37 :order-by '(([event-id] :asc)) |
31 :where where-clause)))) | 38 :where where-clause |
32 (events nil)) | 39 :database *amuse-database*)))) |
33 (dolist (e db-events) | 40 (events (loop for e in db-events |
34 (push (db-event->meredith-event e) events)) | 41 collect (db-event->meredith-event e composition)))) |
35 (let* ((composition | 42 (sequence:adjust-sequence composition (length events) |
36 (make-meredith-composition :identifier identifier | 43 :initial-contents events)) |
37 :description description))) | |
38 (sequence:adjust-sequence composition (length events) | |
39 :initial-contents (nreverse events)) | |
40 composition)) | |
41 #.(clsql:locally-disable-sql-reader-syntax)) | 44 #.(clsql:locally-disable-sql-reader-syntax)) |
42 | 45 |
43 (defmethod copy-event (event) | 46 (defmethod copy-event (event) |
44 (with-slots (identifier tatum-on tatum-dur tactus-on tactus-dur | 47 (with-slots (identifier tatum-on tatum-dur tactus-on tactus-dur |
45 (time amuse::time) | 48 (time amuse::time) |