changeset 276:3180b03d436a

add move-to-first-bar method

darcs-hash:20090124002529-16a00-b7802e0488f4e2f0c442d6735845503b50440a25.gz

--- a/base/generics.lisp	Mon Jan 05 15:03:55 2009 +0000
+++ b/base/generics.lisp	Sat Jan 24 00:25:29 2009 +0000
@@ -455,3 +455,9 @@
 ;;
 
 (defgeneric get-applicable-clefs (anchored-period constituent))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Copying events in time
+
+(defgeneric move-to-first-bar (composition))
+

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

--- a/base/package.lisp	Mon Jan 05 15:03:55 2009 +0000
+++ b/base/package.lisp	Sat Jan 24 00:25:29 2009 +0000
@@ -154,4 +154,7 @@
 	   #:use-whole-bar
 	   #:use-crotchet-beat
 	   #:guess
+
+	   #:%list-slot-sequence-data
+	   #:move-to-first-bar
 	   ))