Mercurial > hg > amuse
changeset 53:ce4a90427366
implementations/mtp/: add interface to datasets
darcs-hash:20070621120721-c0ce4-54d29dd03ab4d7d61c70ed808d0fd3277687929e.gz
| author | Marcus Pearce <m.pearce@gold.ac.uk> |
|---|---|
| date | Thu, 21 Jun 2007 13:07:21 +0100 |
| parents | e0acd4c37121 |
| children | df1482ef96fe |
| files | implementations/mtp/classes.lisp implementations/mtp/constructors.lisp implementations/mtp/methods.lisp implementations/mtp/package.lisp |
| diffstat | 4 files changed, 49 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/mtp/classes.lisp Wed Jun 20 17:05:15 2007 +0100 +++ b/implementations/mtp/classes.lisp Thu Jun 21 13:07:21 2007 +0100 @@ -1,9 +1,18 @@ (cl:in-package #:amuse-mtp) +(defclass mtp-dataset-identifier (identifier) + ((dataset-id :initarg :dataset-id :accessor dataset-id))) + (defclass mtp-composition-identifier (identifier) ((dataset-id :initarg :dataset-id :accessor dataset-id) (composition-id :initarg :composition-id :accessor composition-id))) +(defclass mtp-dataset (amuse::list-slot-sequence) + ((dataset-id :initarg :dataset-id :accessor dataset-id) + (description :initarg :description :accessor description) + (timebase :initarg :timebase :accessor dataset-timebase) + (midc :initarg :midc :accessor dataset-midc))) + (defclass mtp-composition (amuse:composition) ((dataset-id :initarg :dataset-id :accessor dataset-id) (composition-id :initarg :composition-id :accessor composition-id) @@ -13,8 +22,8 @@ ((dataset-id :initarg :dataset-id :accessor dataset-id) (composition-id :initarg :composition-id :accessor composition-id) (event-id :initarg :event-id :accessor event-id) - ;;(onset :initarg :onset :accessor %mtp-onset) - (timepoint ...) - ;;(dur :initarg :dur :accessor %mtp-accidental) - (duration ...) + ;;(onset :initarg :onset :accessor %mtp-onset) - (amuse:timepoint ...) + ;;(dur :initarg :dur :accessor %mtp-accidental) - (amuse:duration ...) (deltast :initarg :deltast :accessor %mtp-deltast) (cpitch :initarg :cpitch :accessor %mtp-cpitch) (mpitch :initarg :mpitch :accessor %mtp-mpitch)
--- a/implementations/mtp/constructors.lisp Wed Jun 20 17:05:15 2007 +0100 +++ b/implementations/mtp/constructors.lisp Thu Jun 21 13:07:21 2007 +0100 @@ -1,9 +1,15 @@ (cl:in-package #:amuse-mtp) +(defun make-mtp-dataset-identifier (dataset-id) + (make-instance 'mtp-dataset-identifier :dataset-id dataset-id)) + (defun make-mtp-composition-identifier (dataset-id composition-id) (make-instance 'mtp-composition-identifier :dataset-id dataset-id :composition-id composition-id)) +(defun make-mtp-dataset (&rest args) + (apply #'make-instance 'mtp-dataset args)) + (defun make-mtp-composition (&rest args) (apply #'make-instance 'mtp-composition args))
--- a/implementations/mtp/methods.lisp Wed Jun 20 17:05:15 2007 +0100 +++ b/implementations/mtp/methods.lisp Thu Jun 21 13:07:21 2007 +0100 @@ -4,6 +4,30 @@ #.(clsql:locally-enable-sql-reader-syntax) +(defgeneric get-dataset (identifer)) + +(defmethod get-dataset ((identifier mtp-dataset-identifier)) + (let* ((dataset-id (dataset-id identifier)) + (where-clause [= [dataset-id] dataset-id]) + (data (clsql:select [*] :from [mtp-dataset] :where where-clause)) + (dataset (make-mtp-dataset :dataset-id (first data) + :description (second data) + :timebase (third data) + :midc (fourth data))) + (compositions nil) + (composition-count + (1+ + (car + (clsql:select [max [composition-id]] :from [mtp-composition] + :where where-clause :flatp t :field-names nil))))) + (dotimes (composition-id composition-count) + (push (get-composition + (make-mtp-composition-identifier dataset-id composition-id)) + compositions)) + (sequence:adjust-sequence dataset (length compositions) + :initial-contents (nreverse compositions)) + dataset)) + (defmethod get-composition ((identifier mtp-composition-identifier)) (let* ((dataset-id (dataset-id identifier)) (composition-id (composition-id identifier))
--- a/implementations/mtp/package.lisp Wed Jun 20 17:05:15 2007 +0100 +++ b/implementations/mtp/package.lisp Thu Jun 21 13:07:21 2007 +0100 @@ -1,3 +1,10 @@ (cl:defpackage #:amuse-mtp (:use #:common-lisp #:amuse #:amuse-utils) - (:export #:make-mtp-composition-identifier)) + (:export + ;; classes + #:mtp-dataset + ;; accessors + #:get-dataset + ;; identifier constructors + #:make-mtp-composition-identifier + #:make-mtp-dataset-identifier))