# HG changeset patch
# User j.forth <j.forth@gold.ac.uk>
# Date 1298546597 0
# Node ID 41a5aca810300c9f21ca5218675b23104b7bd390
# Parent  6ba20759e8f300aec0a68addc67a0ff2b82feac6
add move-to-first-bar method

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

committer: Jamie Forth <j.forth@gold.ac.uk>

diff -r 6ba20759e8f3 -r 41a5aca81030 base/generics.lisp
--- 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))
+
diff -r 6ba20759e8f3 -r 41a5aca81030 base/methods.lisp
--- 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))))
diff -r 6ba20759e8f3 -r 41a5aca81030 base/package.lisp
--- a/base/package.lisp	Wed Feb 16 09:25:15 2011 +0000
+++ b/base/package.lisp	Thu Feb 24 11:23:17 2011 +0000
@@ -154,4 +154,7 @@
 	   #:use-whole-bar
 	   #:use-crotchet-beat
 	   #:guess
+
+	   #:%list-slot-sequence-data
+	   #:move-to-first-bar
 	   ))