diff implementations/gsharp/methods.lisp @ 177:e5de0895d843

Gsharp-output

darcs-hash:20080313112652-40ec0-64241751ae1c0bfc32c3e35deac499132728c5bf.gz

--- a/implementations/gsharp/methods.lisp	Thu Mar 13 11:25:36 2008 +0000
+++ b/implementations/gsharp/methods.lisp	Thu Mar 13 11:26:52 2008 +0000
@@ -58,13 +58,48 @@
 
 (defmethod get-applicable-key-signatures (anchored-period (composition gsharp-composition))
   (let ((keysigs))
-    (sequence::dosequence (event composition (reverse keysigs))
+    (sequence::dosequence (event composition (mapcar #'import-key-signature (reverse keysigs)))
       (cond
         ((overlaps event anchored-period)
-         (unless (member (gsharp::keysig event) keysigs)
-           (push (gsharp::keysig event) keysigs)))
+         (unless (member (gsharp::keysig (note event)) keysigs)
+           (push (gsharp::keysig (note event)) keysigs)))
         ((not (before event anchored-period))
-         (return-from get-applicable-key-signatures (reverse keysigs)))))))
+         (return-from get-applicable-key-signatures (mapcar #'import-key-signature (reverse keysigs))))))))
+
+(defun import-key-signature (gsharp-keysig)
+  ;; FIXME: This is WRONG - shouldn't be using standard key signature,
+  ;; since important detail is lost (very rarely)
+  (make-standard-key-signature-period (- (count :sharp (gsharp::alterations gsharp-keysig))
+                                         (count :flat (gsharp::alterations gsharp-keysig)))
+                                      ()))
 
 (defmethod crotchet ((object gsharp-object))
-  (make-standard-period 1))
\ No newline at end of file
+  (make-standard-period 1))
+
+;;;
+;; Experimental
+
+(defmethod amuse::current-bar ((moment standard-moment)
+                               (composition gsharp-composition))
+  ;; No, I don't know how (or if) these work. But it's a hard problem,
+  ;; so I don't mind cheating.
+  (let ((bar-lengths (gsharp-play::measure-durations
+                      (mapcar #'gsharp-buffer:body
+                              (gsharp-buffer::layers (car (gsharp::segments
+                                                           (amuse-gsharp::buffer composition)))))))
+        (moment-time (timepoint moment)) (now 0))
+    (dolist (bar-duration bar-lengths)
+      (when (> (+ now (* bar-duration 4)) moment-time)
+        (return-from amuse::current-bar
+          (make-standard-anchored-period now (* bar-duration 4))))
+      (incf now (* bar-duration 4)))))
+
+(defmethod get-applicable-clefs (anchored-period (composition gsharp-composition))
+  (let ((clefs))
+    (sequence::dosequence (event composition (mapcar #'import-clef (reverse clefs)))
+      (cond
+        ((overlaps event anchored-period)
+         (unless (member (gsharp::clef (gsharp::staff (note event))) clefs)
+           (push (gsharp::clef (gsharp::staff (note event))) clefs)))
+        ((not (before event anchored-period))
+         (return-from get-applicable-clefs (mapcar #'import-clef (reverse clefs))))))))
\ No newline at end of file