# HG changeset patch
# User David Lewis <d.lewis@gold.ac.uk>
# Date 1185440065 -3600
# Node ID c5f04eb31071934f1bfaf6af99966a30f5857f73
# Parent  ad9cca28fecfff68e765f317e91022c46a844858
monody methods for implementations/geerdes

darcs-hash:20070726085425-f76cc-09a061f19b87dfac247358f8c8d66f3b4e5317e6.gz

diff -r ad9cca28fecf -r c5f04eb31071 implementations/geerdes/methods.lisp
--- a/implementations/geerdes/methods.lisp	Wed Jul 25 18:12:18 2007 +0100
+++ b/implementations/geerdes/methods.lisp	Thu Jul 26 09:54:25 2007 +0100
@@ -98,4 +98,49 @@
       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")))
\ No newline at end of file
+    " ORDER BY start")))
+
+(defmethod monody ((composition geerdes-composition))
+  (unless (amuse-geerdes::%monody composition)
+    (setf (amuse-geerdes::%monody composition)
+	  (get-monody composition)))
+  (amuse-geerdes::%monody composition))
+
+(defgeneric get-monody (composition))
+(defmethod get-monody ((composition geerdes-composition))
+  ;;; FIXME: FIXED-[THIS IS DANGEROUS - IT EDITS NOTE LENGTH]
+  ;; FIXME: As a result of this fix, notes no longer eq their monody
+  ;; versions
+  ;;; FIXME: This is a serious issue. Needs to be addressed by
+  ;; a proper implementation of constituent with annotations
+  ;;; From DTM: - Select notes
+  ;; on channel 4
+  (let ((vocal-line (loop for event being the elements of (lead-vocal-part composition)
+		       collect (copy-event event))))
+    (when vocal-line
+      (let* ((comp (make-instance 'geerdes-composition
+				  :file-id (file-id composition)
+				  :time (timepoint composition)
+				  :tempi (tempi composition)
+				  :time-signatures (time-signatures composition)
+				  :interval (duration composition)))
+	     (vocal-composition (sequence:adjust-sequence comp
+							  (length vocal-line)
+							  :initial-contents vocal-line))
+	     (monody (make-instance 'geerdes-monody
+				    :time (timepoint composition)
+				    :file-id (file-id composition)
+				    :tempi (tempi composition)
+				    :time-signatures (time-signatures composition)
+				    :interval (duration composition))) ;; Overly inclusive?
+	     (monody-events (monodificate vocal-composition)))
+	(sequence:adjust-sequence monody (length monody-events)
+				  :initial-contents monody-events)))))
+
+(defgeneric lead-vocal-part (time-ordered-constituent)
+  (:method (toc) (remove-if-not #'lead-vocalp toc)))
+
+(defgeneric lead-vocalp (event)
+  (:method (e) (declare (ignore e)) nil))
+(defmethod lead-vocalp ((event geerdes-pitched-event))
+  (= (midi-channel event) 4))