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