[gsharp-cvs] CVS gsharp

[mjonsson]

Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv24656

Modified Files:
	gui.lisp play.lisp 
Log Message:
Implemented play-buffer and made play-layer available in play menu

--- /project/gsharp/cvsroot/gsharp/gui.lisp	2007/09/18 21:19:03	1.87
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2007/10/27 02:10:55	1.88
@@ -534,7 +534,11 @@
  'play-command-table
  :errorp nil
  :menu '(("Buffer" :command com-play-buffer)
-         ("Segment" :command com-play-segment)))
+         ("Segment" :command com-play-segment)
+         ("Layer" :command com-play-layer)))
+
+(define-gsharp-command (com-play-buffer :name t) ()
+  (play-buffer (buffer (current-cursor))))
 
 (define-gsharp-command (com-play-segment :name t) ()
   (play-segment (segment (current-cursor))))
--- /project/gsharp/cvsroot/gsharp/play.lisp	2007/10/20 18:41:25	1.10
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2007/10/27 02:10:55	1.11
@@ -19,12 +19,12 @@
 
 (defun measure-durations (slices)
   (let ((durations (mapcar (lambda (slice)
-			     (mapcar #'duration
-				     (bars slice)))
-			   slices)))
+                             (mapcar #'duration
+                                     (bars slice)))
+                           slices)))
     (loop while durations
-	  collect (reduce #'max durations :key #'car)
-	  do (setf durations (remove nil (mapcar #'cdr durations))))))
+       collect (reduce #'max durations :key #'car)
+       do (setf durations (remove nil (mapcar #'cdr durations))))))
 
 (defun average (list &key (key #'identity))
   (let ((sum 0)
@@ -68,14 +68,14 @@
 	      (incf time (* *tempo* (duration element)))))
 	  (elements bar)))
 
-(defun track-from-slice (slice channel durations)
-  (cons (make-instance 'program-change-message
-	  :time 0 :status  (+ #xc0 channel) :program 0)
-	(let ((time 0))
-	  (mapcan (lambda (bar duration)
-		    (prog1 (events-from-bar bar time channel)
-		      (incf time (* *tempo* duration))))
-		  (bars slice) durations))))
+(defun track-from-slice (slice channel durations &key (start-time 0))
+	(let ((time start-time))
+    (cons (make-instance 'program-change-message
+                         :time time :status  (+ #xc0 channel) :program 0)
+          (mapcan (lambda (bar duration)
+                    (prog1 (events-from-bar bar time channel)
+                      (incf time (* *tempo* duration))))
+                  (bars slice) durations))))
 
 (define-condition midi-player-failed (gsharp-condition)
   ((midi-player :initarg :midi-player)
@@ -115,20 +115,57 @@
     #-(or cmu sbcl clisp)
     (error "write compatibility layer for RUN-PROGRAM")))
 
-(defun play-segment (segment)
-  (let* ((slices (mapcar #'body (layers segment)))
-	 (durations (measure-durations slices))
-         (*tempo* (tempo segment))
-         (*tuning* (gsharp-buffer:tuning segment))
-	 (tracks (loop for slice in slices
-		       for i from 0
-		       collect (track-from-slice slice i durations))))
-    (play-tracks tracks)))
-
 (defun play-layer (layer)
   (let* ((slice (body layer))
-	 (durations (measure-durations (list slice)))
+         (durations (measure-durations (list slice)))
          (*tempo* (tempo (segment layer)))
          (*tuning* (gsharp-buffer:tuning (segment layer)))
-	 (tracks (list (track-from-slice slice 0 durations))))
-    (play-tracks tracks)))
\ No newline at end of file
+         (tracks (list (track-from-slice slice 0 durations))))
+    (play-tracks tracks)))
+
+(defun segment-tracks (segment &key (start-time 0))
+  (let* ((slices (mapcar #'body (layers segment)))
+         (durations (measure-durations slices))
+         (*tempo* (tempo segment))
+         (*tuning* (gsharp-buffer:tuning segment)))
+    (values (loop
+               for slice in slices
+               for i from 0
+               collect (track-from-slice slice i durations :start-time start-time))
+            (reduce #'+ durations))))
+  
+(defun play-segment (segment)
+  (play-tracks (segment-tracks segment)))
+
+; TODO: There is a short pause between segments?
+(defun play-buffer (buffer)
+  (let* ((time 0)
+         (num-tracks (loop :for segment :in (segments buffer)
+                           :maximize (length (layers segment))))
+         (tracks (loop :for i :from 0 :below num-tracks :collect nil)))
+
+    ; Collect snippets from each segment that should go to different tracks
+    (dolist (segment (segments buffer))
+      (let ((*tempo* (tempo segment))
+            (*tuning* (tuning segment)))
+        (multiple-value-bind (track-addendums segment-duration)
+            (segment-tracks segment :start-time time)
+          (format t "~S" segment-duration)
+
+          (incf time segment-duration)
+
+          (loop :for track-addendum :in track-addendums
+                :for tracks-tail :on tracks                
+                :do (push track-addendum (car tracks-tail))))))
+
+    ; Concatenate each track's snippets
+    (loop :for tracks-tail :on tracks
+       :do (setf (car tracks-tail)
+                 (reduce (lambda (result snippet)
+                           (nconc snippet result))
+                         (car tracks-tail)
+                         :from-end t))) 
+
+    (play-tracks tracks)))
+
+