Mercurial > hg > amuse
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)))))))) |