comparison implementations/geerdes/methods.lisp @ 211:e2839225f6fb

integrate db-admin into geerdes

Ignore-this: 442285f4febbcd5d390a49d8c8b69e00

darcs-hash:20090522211215-16a00-0e6571178e720d2cf648e09486ec2bb160950355.gz

committer: Jamie Forth <[e-mail]>

 (defmethod (setf file-id) (value (object geerdes-composition))
   (setf (%db-file-id object) value))
 (defmethod (setf file-id) (value (object geerdes-identifier-file-id))
   (setf (slot-value object 'file-id) value))
 
+;; Specialised constructors
+
+(defmethod make-composition-identifier ((package (eql *package*))
+					composition-id)
+  (g-id-file-id composition-id))
+
 ;; Composition 
 
 (defmethod get-composition ((identifier geerdes-identifier))
   (let* ((composition (get-geerdes-composition identifier)))
     (%initialise-notes composition)

   (let* ((cat-id (cat-id identifier))
 	 (file-info (car (clsql:select [id] [timebase]
 				       :from [midi_file]
 				       :where [= [cat_id] cat-id]
 				       :flatp t
-				       :result-types :auto)))
+				       :result-types :auto
+				       :database *amuse-database*)))
 	 (timebase (second file-info))
 	 (file-id (first file-info))
 	 (composition (make-instance 'geerdes-composition
 				     :id identifier
 				     :file-id file-id

 				     :midi-timebase timebase)))
     (setf (%midi-events composition) (get-db-events file-id)
 	  (%midi-constituents composition) (get-db-constituents file-id))
   #.(clsql:restore-sql-reader-syntax-state)
   composition))
+
 (defmethod get-geerdes-composition ((identifier geerdes-identifier-file-id))
   #.(clsql:locally-enable-sql-reader-syntax)
   (let* ((file-id (file-id identifier))
 	 (file-info (car (clsql:select [cat_id] [timebase]
 				       :from [midi_file]
 				       :where [= [id] file-id]
 				       :flatp t
-				       :result-types :auto)))
+				       :result-types :auto
+				       :database *amuse-database*)))
 	 (timebase (second file-info))
 	 (cat-id (first file-info))
 	 (composition (make-instance 'geerdes-composition
 				     :id identifier
 				     :cat-id cat-id

   (clsql:query
    (concatenate 'string "
     SELECT track, channel, start, duration, patch, pitch, velocity, id, event_id, mel_duration
     FROM midi_event LEFT JOIN derived_midi_monody ON (id=event_id)
     WHERE file_id=" (princ-to-string file-id)
-    " ORDER BY start")))
+    " ORDER BY start")
+   :database *amuse-database*))
+
 (defun get-db-constituents (file-id)
   (clsql:query (concatenate 'string "
     SELECT track, channel, start, duration,
       param.num, param.value, pb.value, tp.value, ts.num, ts.denom
     FROM midi_constituent c
       LEFT JOIN midi_pb pb ON (id=pb.constituent_id)
       LEFT JOIN midi_tempo tp ON (id=tp.constituent_id)
       LEFT JOIN midi_timesig ts ON (id=ts.constituent_id)
       LEFT JOIN midi_param param ON (id=param.constituent_id)
     WHERE c.file_id=" (princ-to-string file-id)
-    " ORDER BY start")))
+    " ORDER BY start")
+	       :database *amuse-database*))
 
 (defmethod monody ((composition geerdes-composition))
   (unless (amuse-geerdes::%monody composition)
     (setf (amuse-geerdes::%monody composition)
 	  (get-monody composition)))

 (defmethod lead-vocalp ((event geerdes-pitched-event))
   (= (midi-channel event) 4))
 
 (defmethod crotchet ((object geerdes-object))
   (make-standard-period 1))
-