Mercurial > hg > amuse
changeset 153:74fc4c6cbf6c
Really saved that change this time
darcs-hash:20071114153611-f76cc-8bcc114d41915de8d720c833d450cbf0be508ade.gz
| author | David Lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Wed, 14 Nov 2007 15:36:11 +0000 |
| parents | 3b588c566734 |
| children | edf2322ea33f |
| files | base/methods.lisp implementations/midi/methods.lisp |
| diffstat | 2 files changed, 27 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- a/base/methods.lisp Wed Nov 14 14:25:06 2007 +0000 +++ b/base/methods.lisp Wed Nov 14 15:36:11 2007 +0000 @@ -463,10 +463,23 @@ preserved from the source sequence (except onset and duration, which are calculated afresh)." (declare (ignore length initial-element initial-contents iep icp)) - (let ((new-sequence (call-next-method)) - (start) (finish)) + (let ((new-sequence (call-next-method))) ;; Get timing information - (sequence:dosequence (element new-sequence) + (setf new-sequence (%recompute-standard-composition-period new-sequence)) + (dolist (slotd (sb-mop:class-slots (class-of new-sequence)) new-sequence) + (unless (or (equal (sb-mop:slot-definition-name slotd) 'time) + (equal (sb-mop:slot-definition-name slotd) 'interval)) + (setf (sb-mop:slot-value-using-class (class-of new-sequence) + new-sequence + slotd) + (sb-mop:slot-value-using-class (class-of new-sequence) + o ;; if this isn't the same, we're lost anyway + slotd)))))) + +(defun %recompute-standard-composition-period (composition) + "Find onset and duration times for newly-made composition object." + (let ((start) (finish)) + (sequence:dosequence (element composition) ;; Actually, this next bit is pretty stupid - I know this is ;; ordered, so this bit could be replaced by ;; (setf (timepoint new-sequence) @@ -485,14 +498,13 @@ (setf start 0)) (unless finish (setf finish 0)) - (setf (timepoint new-sequence) start - (duration new-sequence) (- finish start)) - (dolist (slotd (sb-mop:class-slots (class-of new-sequence)) new-sequence) - (unless (or (equal (sb-mop:slot-definition-name slotd) 'time) - (equal (sb-mop:slot-definition-name slotd) 'interval)) - (setf (sb-mop:slot-value-using-class (class-of new-sequence) - new-sequence - slotd) - (sb-mop:slot-value-using-class (class-of new-sequence) - o ;; if this isn't the same, we're lost anyway - slotd)))))) \ No newline at end of file + (setf (timepoint composition) start + (duration composition) (- finish start)) + composition)) + + +(defmethod sequence:adjust-sequence :around ((o standard-composition) length + &key initial-element + (initial-contents nil icp)) + (declare (ignore length o initial-element initial-contents icp)) + (%recompute-standard-composition-period (call-next-method))) \ No newline at end of file