Mercurial > hg > amuse
changeset 197:22ac5ec1733c
Basic key and time signature support
| author | David Lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Wed, 16 Feb 2011 09:19:12 +0000 |
| parents | 3b36cf79b525 |
| children | 3d4ea9a18040 |
| files | implementations/gsharp/classes.lisp implementations/gsharp/gsharp-import.lisp implementations/gsharp/methods.lisp |
| diffstat | 3 files changed, 121 insertions(+), 39 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/gsharp/classes.lisp Thu Jul 23 11:31:19 2009 +0100 +++ b/implementations/gsharp/classes.lisp Wed Feb 16 09:19:12 2011 +0000 @@ -4,7 +4,13 @@ (defclass gsharp-composition (amuse:standard-composition gsharp-object) ((buffer :initarg :buffer :reader buffer) - (tempi :initarg :tempi :reader tempi))) + (tempi :initarg :tempi :reader tempi) + (key-signatures :initarg :key-signatures + :initform nil + :accessor %gsharp-key-signatures) + (time-signatures :initarg :time-signatures + :initform nil + :accessor %gsharp-time-signatures))) (defclass gsharp-pitched-event (standard-chromatic-pitched-event gsharp-object) ((note :initarg :note :reader note) @@ -25,3 +31,9 @@ () (:documentation "Identifier for MusicXML files for gsharp")) +(defclass gsharp-import-mixin (gsharp-object) + ((gsh-source :initarg :source :accessor gsh-source))) +(defclass gsharp-key-signature-period (standard-key-signature-period gsharp-import-mixin) + ()) +(defclass gsharp-time-signature-period (standard-time-signature-period gsharp-import-mixin) + ()) \ No newline at end of file
--- a/implementations/gsharp/gsharp-import.lisp Thu Jul 23 11:31:19 2009 +0100 +++ b/implementations/gsharp/gsharp-import.lisp Wed Feb 16 09:19:12 2011 +0000 @@ -1,5 +1,10 @@ (in-package "AMUSE-GSHARP") +(defun make-gsharp-composition (events buffer timepoint interval &key tempi key-signatures time-signatures) + (let ((comp (make-instance 'gsharp-composition :buffer buffer :time timepoint :interval interval + :tempi tempi :key-signatures key-signatures :time-signatures time-signatures))) + (sequence:adjust-sequence comp (length events) :initial-contents events))) + (defun last-bar-p (bar) ;; I know most of this file is cut-and-pasted, but this is a ;; particularly horrible example. @@ -36,15 +41,20 @@ sum (gsharp-buffer:duration (gsharp-buffer:cluster n)))) (defun events-from-element (element index time) - (when (typep element 'gsharp-buffer:cluster) - (mapcar (lambda (note) - (make-instance 'gsharp-pitched-event - :note note - :slice-index index - :number (gsharp-play::midi-pitch note) - :time time - :interval (* 4 (compute-duration note)))) - (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element))))) + (typecase element + (gsharp-buffer:cluster + (mapcar (lambda (note) + (make-instance 'gsharp-pitched-event + :note note + :slice-index index + :number (gsharp-play::midi-pitch note) + :time time + :interval (* 4 (compute-duration note)))) + (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element)))) + (gsharp-buffer:key-signature + (list (make-gsharp-key-signature-period element time nil))) + (gsharp-buffer::time-signature + (list (make-gsharp-time-signature-period element time nil))))) (defun events-from-bar (bar index time) (mapcan (lambda (element) @@ -61,25 +71,69 @@ (defun segment-composition (segment) (let* ((slices (mapcar #'gsharp-buffer:body (gsharp-buffer::layers segment))) - (durations (gsharp-play::measure-durations slices)) + (durations (gsharp-play::measure-durations slices)) (gsharp-play::*tuning* (gsharp-buffer:tuning segment)) - (events (loop for slice in slices - for i from 0 - for events = (events-from-slice slice i durations) - then (merge 'list events (events-from-slice slice i durations) 'time<) - finally (return events)))) - (let* ((duration (* 4 (reduce #'+ durations))) - (result (make-instance 'gsharp-composition - :buffer (gsharp-buffer:buffer segment) - ;; FIXME: this will break as soon as - ;; gsharp is made to have a sane - ;; divisions value in play.lisp - ;; instead of 25 - :tempi (list (make-standard-tempo-period (* 128 (/ (* 4 25) (gsharp-buffer:tempo segment))) 0 duration)) - :time 0 - :interval duration))) - (sequence:adjust-sequence result (length events) - :initial-contents events)))) + (key-signatures (get-initial-keysigs segment)) + (time-signatures) + (events (loop for slice in slices + for i from 0 + for events = (events-from-slice slice i durations) + then (merge 'list events (events-from-slice slice i durations) 'time<) + finally (return events))) + (duration (* 4 (reduce #'+ durations)))) + (multiple-value-setq (events key-signatures time-signatures) + (filter-event-list-for-signatures events key-signatures duration)) + + ;; FIXME: TEMPI here will break as soon as gsharp is made to have + ;; a sane divisions value in play.lisp instead of 25 + (make-gsharp-composition events (gsharp::buffer segment) 0 duration + :tempi (list (make-standard-tempo-period (* 128 (/ (* 4 25) (gsharp-buffer:tempo segment))) + 0 duration)) + :key-signatures key-signatures + :time-signatures time-signatures))) + +(defun filter-event-list-for-signatures (events key-signatures duration) + "key-signatures here are initial `staff-level' signatures (what + MusicXML calls attributes). MusicXML also has time sigs in the + attributes, but GSharp converts them to normal elements." + (let ((filtered-events) (time-signatures) + (staves-data (mapcar #'(lambda (k) + (list (gsharp::staff (gsh-source k)) k nil)) + key-signatures))) + (dolist (event events) + (typecase event + (gsharp-pitched-event (push event filtered-events)) + (gsharp-key-signature-period + (if (assoc (gsharp::staff (gsh-source event)) staves-data) + (let ((data (assoc (gsharp::staff (gsh-source event)) staves-data))) + (if (second data) + (setf (duration (second data)) (- (timepoint event) (timepoint (second data))) + (second data) event) + (setf (second data) event))) + (acons (gsharp::staff (gsh-source event)) (list event nil) staves-data)) + (push event key-signatures)) + (gsharp-time-signature-period + (if (assoc (gsharp::staff (gsh-source event)) staves-data) + (let ((data (assoc (gsharp::staff (gsh-source event)) staves-data))) + (if (third data) + (setf (duration (third data)) (- (timepoint event) (timepoint (third data))) + (third data) event) + (setf (third data) event))) + (acons (gsharp::staff (gsh-source event)) (list nil event) staves-data)) + (push event time-signatures)))) + (loop for item in staves-data + when (second item) + do (setf (duration (second item)) duration) + when (third item) + do (setf (duration (third item)) duration)) + (values (reverse filtered-events) (reverse key-signatures) (reverse time-signatures)))) + +(defun get-initial-keysigs (segment) + (let ((staves (remove-duplicates + (loop for layer in (gsharp::layers segment) + nconc (gsharp::staves layer))))) + (loop for staff in staves + collect (make-gsharp-key-signature-period (gsharp::keysig staff) 0 nil)))) #|
--- a/implementations/gsharp/methods.lisp Thu Jul 23 11:31:19 2009 +0100 +++ b/implementations/gsharp/methods.lisp Wed Feb 16 09:19:12 2011 +0000 @@ -1,7 +1,9 @@ (in-package "AMUSE-GSHARP") (defmethod time-signatures ((composition gsharp-composition)) - ()) + (%gsharp-time-signatures composition)) +(defmethod key-signatures ((composition gsharp-composition)) + (%gsharp-key-signatures composition)) (defmethod get-composition ((id gsharp-gsh-identifier)) "Makes a gsharp buffer from .gsh file and generates a composition @@ -56,19 +58,32 @@ (defmethod import-from-identifier (frame (id gsharp-mxml-identifier)) (clim:execute-frame-command frame `(gsharp::com-import-musicxml ,(%gsharp-identifier-pathname id)))) -(defmethod get-applicable-key-signatures (anchored-period (composition gsharp-composition)) - (let ((keysigs)) - (sequence::dosequence (event composition (mapcar #'import-key-signature (reverse keysigs))) - (cond - ((overlaps event anchored-period) - (unless (member (gsharp::keysig (note event)) keysigs) - (push (gsharp::keysig (note event)) keysigs))) - ((not (before event anchored-period)) - (return-from get-applicable-key-signatures (mapcar #'import-key-signature (reverse keysigs)))))))) +(defun make-gsharp-key-signature-period (keysig onset duration) + (make-instance 'gsharp-key-signature-period :source keysig + :sharp-count (- (count :sharp + (gsharp::alterations keysig)) + (count :flat + (gsharp::alterations keysig))) + :time onset :interval duration)) + +(defun make-gsharp-time-signature-period (timesig onset duration) + (let ((component1 (car (gsharp-buffer::time-signature-components timesig)))) + (make-instance 'gsharp-time-signature-period :source timesig + :numerator (if (and (listp component1) + (numberp (car component1))) + (car component1) + nil) + :denominator (if (and (listp component1) + (numberp (cdr component1))) + (cdr component1) + nil) + :time onset :interval duration))) + (defun import-key-signature (gsharp-keysig) ;; FIXME: This is WRONG - shouldn't be using standard key signature, ;; since important detail is lost (very rarely) + #+nil (make-standard-key-signature-period (- (count :sharp (gsharp::alterations gsharp-keysig)) (count :flat (gsharp::alterations gsharp-keysig))) ())) @@ -94,6 +109,7 @@ (make-standard-anchored-period now (* bar-duration 4)))) (incf now (* bar-duration 4))))) +#+nil ;; There is no AMuSE equivalent to a clef. (defmethod get-applicable-clefs (anchored-period (composition gsharp-composition)) (let ((clefs)) (sequence::dosequence (event composition (mapcar #'import-clef (reverse clefs))) @@ -102,4 +118,4 @@ (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 + (return-from get-applicable-clefs (mapcar #'import-clef (reverse clefs))))))))