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))))