Mercurial > hg > amuse
comparison implementations/mtp/methods.lisp @ 149:a45da9b93b37
implementations/mtp/methods.lisp: fix some bugs in dataset retrieval.
darcs-hash:20071025122256-c0ce4-dc50f52a16aaa6d3d78d961e6a934a5af77b7542.gz
author | Marcus Pearce <m.pearce@gold.ac.uk> |
---|---|
date | Thu, 25 Oct 2007 13:22:56 +0100 |
parents | fd85f52d9f9d |
children | 03be243f9003 |
comparison
equal
deleted
inserted
replaced
148:c8db9d1bd191 | 149:a45da9b93b37 |
---|---|
12 (defgeneric get-dataset (identifer)) | 12 (defgeneric get-dataset (identifer)) |
13 | 13 |
14 (defmethod get-dataset ((identifier mtp-dataset-identifier)) | 14 (defmethod get-dataset ((identifier mtp-dataset-identifier)) |
15 (let* ((dataset-id (dataset-id identifier)) | 15 (let* ((dataset-id (dataset-id identifier)) |
16 (where-clause [= [dataset-id] dataset-id]) | 16 (where-clause [= [dataset-id] dataset-id]) |
17 (db-dataset (clsql:select [*] :from [mtp-dataset] :where where-clause)) | 17 (db-dataset (car (clsql:select [*] :from [mtp-dataset] :where where-clause))) |
18 (db-compositions (clsql:select [composition-id][description] | 18 (db-compositions (clsql:select [composition-id][description] |
19 :from [mtp-composition] | 19 :from [mtp-composition] |
20 :order-by '(([composition-id] :asc)) | 20 :order-by '(([composition-id] :asc)) |
21 :where where-clause)) | 21 :where where-clause)) |
22 (db-events (apply #'clsql:select | 22 (db-events (apply #'clsql:select |
31 :midc (fourth db-dataset))) | 31 :midc (fourth db-dataset))) |
32 (compositions nil) | 32 (compositions nil) |
33 (events nil)) | 33 (events nil)) |
34 ;; for each db-composition | 34 ;; for each db-composition |
35 (dolist (dbc db-compositions) | 35 (dolist (dbc db-compositions) |
36 (let ((composition-id (first dbc)) | 36 (let ((composition-id (car dbc)) |
37 (description (second dbc))) | 37 (description (car dbc))) |
38 ;; for each db-event | 38 ;; for each db-event |
39 (do* ((dbes db-events (cdr dbes)) | 39 (do* ((dbes db-events (cdr dbes)) |
40 (dbe (car dbes) (car dbes)) | 40 (dbe (car dbes) (car dbes)) |
41 (cid (second dbe) (second dbe))) | 41 (cid (second dbe) (second dbe))) |
42 ((or (null dbes) (not (= cid composition-id))) | 42 ((or (null dbes) (not (= cid composition-id))) |
43 (setf db-events dbes)) | 43 (setf db-events dbes)) |
44 (when dbe | 44 (when dbe |
45 (push (db-event->mtp-event dbe) events))) | 45 (push (db-event->mtp-event dbe) events))) |
46 (let* ((interval (+ (timepoint (car events)) (duration (car events)))) | 46 (when events |
47 (composition | 47 (let* ((interval (+ (timepoint (car events)) (duration (car events)))) |
48 (make-mtp-composition :dataset-id dataset-id | 48 (composition |
49 :composition-id composition-id | 49 (make-mtp-composition :dataset-id dataset-id |
50 :description description | 50 :composition-id composition-id |
51 :time 0 | 51 :description description |
52 :interval interval))) | 52 :time 0 |
53 (sequence:adjust-sequence composition (length events) | 53 :interval interval))) |
54 :initial-contents (nreverse events)) | 54 (sequence:adjust-sequence composition (length events) |
55 (setf events nil) | 55 :initial-contents (nreverse events)) |
56 (push composition compositions)))) | 56 (setf events nil) |
57 (push composition compositions))))) | |
57 (sequence:adjust-sequence dataset (length compositions) | 58 (sequence:adjust-sequence dataset (length compositions) |
58 :initial-contents (nreverse compositions)) | 59 :initial-contents (nreverse compositions)) |
59 dataset)) | 60 dataset)) |
60 | 61 |
61 (defmethod get-composition ((identifier mtp-composition-identifier)) | 62 (defmethod get-composition ((identifier mtp-composition-identifier)) |