# HG changeset patch
# User j.forth <j.forth@gold.ac.uk>
# Date 1298546598 0
# Node ID 6f0881af34032a0d15ce030880351943bef69c6c
# Parent  7afb8cfdcdcf2a685705859912f3125282872aee
add composition slot to event (meredith)

Ignore-this: d6b133f7d17684bf3f7c1ccde28c7d8a

darcs-hash:20090828164631-16a00-1a25e46b8142401466f4a6ec7159a10d8e31de40.gz

committer: Jamie Forth <j.forth@gold.ac.uk>

diff -r 7afb8cfdcdcf -r 6f0881af3403 implementations/meredith/classes.lisp
--- 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)
diff -r 7afb8cfdcdcf -r 6f0881af3403 implementations/meredith/constructors.lisp
--- 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
diff -r 7afb8cfdcdcf -r 6f0881af3403 implementations/meredith/methods.lisp
--- 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)