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

Gsharp-output darcs-hash:20080313112652-40ec0-64241751ae1c0bfc32c3e35deac499132728c5bf.gz
author d.lewis <d.lewis@gold.ac.uk>
date Thu, 13 Mar 2008 11:26:52 +0000
parents f1d0ea63581c
children 22ac5ec1733c
comparison
equal deleted inserted replaced
176:cddf83554c08 177:e5de0895d843
56 (defmethod import-from-identifier (frame (id gsharp-mxml-identifier)) 56 (defmethod import-from-identifier (frame (id gsharp-mxml-identifier))
57 (clim:execute-frame-command frame `(gsharp::com-import-musicxml ,(%gsharp-identifier-pathname id)))) 57 (clim:execute-frame-command frame `(gsharp::com-import-musicxml ,(%gsharp-identifier-pathname id))))
58 58
59 (defmethod get-applicable-key-signatures (anchored-period (composition gsharp-composition)) 59 (defmethod get-applicable-key-signatures (anchored-period (composition gsharp-composition))
60 (let ((keysigs)) 60 (let ((keysigs))
61 (sequence::dosequence (event composition (reverse keysigs)) 61 (sequence::dosequence (event composition (mapcar #'import-key-signature (reverse keysigs)))
62 (cond 62 (cond
63 ((overlaps event anchored-period) 63 ((overlaps event anchored-period)
64 (unless (member (gsharp::keysig event) keysigs) 64 (unless (member (gsharp::keysig (note event)) keysigs)
65 (push (gsharp::keysig event) keysigs))) 65 (push (gsharp::keysig (note event)) keysigs)))
66 ((not (before event anchored-period)) 66 ((not (before event anchored-period))
67 (return-from get-applicable-key-signatures (reverse keysigs))))))) 67 (return-from get-applicable-key-signatures (mapcar #'import-key-signature (reverse keysigs))))))))
68
69 (defun import-key-signature (gsharp-keysig)
70 ;; FIXME: This is WRONG - shouldn't be using standard key signature,
71 ;; since important detail is lost (very rarely)
72 (make-standard-key-signature-period (- (count :sharp (gsharp::alterations gsharp-keysig))
73 (count :flat (gsharp::alterations gsharp-keysig)))
74 ()))
68 75
69 (defmethod crotchet ((object gsharp-object)) 76 (defmethod crotchet ((object gsharp-object))
70 (make-standard-period 1)) 77 (make-standard-period 1))
78
79 ;;;
80 ;; Experimental
81
82 (defmethod amuse::current-bar ((moment standard-moment)
83 (composition gsharp-composition))
84 ;; No, I don't know how (or if) these work. But it's a hard problem,
85 ;; so I don't mind cheating.
86 (let ((bar-lengths (gsharp-play::measure-durations
87 (mapcar #'gsharp-buffer:body
88 (gsharp-buffer::layers (car (gsharp::segments
89 (amuse-gsharp::buffer composition)))))))
90 (moment-time (timepoint moment)) (now 0))
91 (dolist (bar-duration bar-lengths)
92 (when (> (+ now (* bar-duration 4)) moment-time)
93 (return-from amuse::current-bar
94 (make-standard-anchored-period now (* bar-duration 4))))
95 (incf now (* bar-duration 4)))))
96
97 (defmethod get-applicable-clefs (anchored-period (composition gsharp-composition))
98 (let ((clefs))
99 (sequence::dosequence (event composition (mapcar #'import-clef (reverse clefs)))
100 (cond
101 ((overlaps event anchored-period)
102 (unless (member (gsharp::clef (gsharp::staff (note event))) clefs)
103 (push (gsharp::clef (gsharp::staff (note event))) clefs)))
104 ((not (before event anchored-period))
105 (return-from get-applicable-clefs (mapcar #'import-clef (reverse clefs))))))))