Mercurial > hg > amuse
diff base/methods.lisp @ 276:3180b03d436a
add move-to-first-bar method
darcs-hash:20090124002529-16a00-b7802e0488f4e2f0c442d6735845503b50440a25.gz
author | j.forth <j.forth@gold.ac.uk> |
---|---|
date | Sat, 24 Jan 2009 00:25:29 +0000 |
parents | aa2b33f83ac6 |
children | e52b6eb30408 |
line wrap: on
line diff
--- a/base/methods.lisp Mon Jan 05 15:03:55 2009 +0000 +++ b/base/methods.lisp Sat Jan 24 00:25:29 2009 +0000 @@ -563,3 +563,16 @@ ;; of an implementation's author to solve that. (error 'insufficient-information :operation 'beat-period :datatype (class-of composition))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Copying events in time + +(defmethod move-to-first-bar ((composition composition)) + (let ((offset (floor (timepoint (car composition))))) + (loop + for event in (%list-slot-sequence-data) + do (setf event (copy-event event)) + do (setf (timepoint event) + (- (timepoint event) offset)) + collect event into shifted-events + finally (return shifted-events))))