Mercurial > hg > amuse
changeset 208:41a5aca81030
add move-to-first-bar method
darcs-hash:20090124002529-16a00-b7802e0488f4e2f0c442d6735845503b50440a25.gz
committer: Jamie Forth <j.forth@gold.ac.uk>
| author | j.forth <j.forth@gold.ac.uk> |
|---|---|
| date | Thu, 24 Feb 2011 11:23:17 +0000 |
| parents | 6ba20759e8f3 |
| children | 1c58a18161b6 |
| files | base/generics.lisp base/methods.lisp base/package.lisp |
| diffstat | 3 files changed, 22 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/base/generics.lisp Wed Feb 16 09:25:15 2011 +0000 +++ b/base/generics.lisp Thu Feb 24 11:23:17 2011 +0000 @@ -454,3 +454,9 @@ ;; (defgeneric get-applicable-clefs (anchored-period constituent)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Copying events in time + +(defgeneric move-to-first-bar (composition)) +
--- a/base/methods.lisp Wed Feb 16 09:25:15 2011 +0000 +++ b/base/methods.lisp Thu Feb 24 11:23:17 2011 +0000 @@ -567,3 +567,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))))