[gsharp-cvs] CVS gsharp

[crhodes]

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

Modified Files:
	buffer.lisp gui.lisp packages.lisp play.lisp 
Log Message:
Make the tempo (for playback only, currently) a segment slot; add 
command-line UI for setting it.


--- /project/gsharp/cvsroot/gsharp/buffer.lisp	2006/03/02 09:21:34	1.36
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp	2006/03/02 09:29:44	1.37
@@ -975,7 +975,8 @@
 (defclass segment (gsharp-object)
   ((print-character :allocation :class :initform #\S)
    (buffer :initform nil :initarg :buffer :accessor buffer)
-   (layers :initform '() :initarg :layers :accessor layers)))
+   (layers :initform '() :initarg :layers :accessor layers)
+   (tempo :initform 128 :initarg :tempo :accessor tempo)))
 
 (defmethod initialize-instance :after ((s segment) &rest args &key staff)
   (declare (ignore args))
@@ -987,7 +988,7 @@
 	  do (setf (segment layer) s))))
 
 (defmethod print-gsharp-object :after ((s segment) stream)
-  (format stream "~_:layers ~W " (layers s)))
+  (format stream "~_:layers ~W ~_:tempo ~W " (layers s) (tempo s)))
 
 (defun read-segment-v3 (stream char n)
   (declare (ignore char n))
--- /project/gsharp/cvsroot/gsharp/gui.lisp	2006/03/02 09:21:34	1.58
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2006/03/02 09:29:44	1.59
@@ -315,6 +315,10 @@
 			  cursor)
     (forward-segment cursor)))
 
+(define-gsharp-command (com-set-segment-tempo :name t) ((tempo 'integer :prompt "Tempo"))
+  (let ((segment (segment (current-cursor))))
+    (setf (tempo segment) tempo)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; layer menu
--- /project/gsharp/cvsroot/gsharp/packages.lisp	2006/03/02 09:21:34	1.48
+++ /project/gsharp/cvsroot/gsharp/packages.lisp	2006/03/02 09:29:44	1.49
@@ -183,7 +183,7 @@
 	   #:layer #:lyrics-layer #:melody-layer
 	   #:bars #:nb-bars #:barno #:add-bar #:remove-bar
 	   #:slice #:make-slice
-	   #:segment #:slices #:sliceno
+	   #:segment #:tempo #:slices #:sliceno
 	   #:make-layer-for-staff #:make-bar-for-staff
 	   #:head #:body #:tail #:make-layer #:buffer
 	   #:layers #:nb-layers #:layerno
--- /project/gsharp/cvsroot/gsharp/play.lisp	2006/02/28 23:49:18	1.4
+++ /project/gsharp/cvsroot/gsharp/play.lisp	2006/03/02 09:29:44	1.5
@@ -4,7 +4,13 @@
   (+ (* 12 (+ (floor (pitch note) 7) 1))
      (ecase (mod (pitch note) 7) (0 0) (1 2) (2 4) (3 5) (4 7) (5 9) (6 11))
      (ecase (accidentals note)
-       (:double-flat -2) (:flat -1) (:natural 0) (:sharp 1) (:double-sharp 2))))
+       (:double-flat -2) 
+       (:flat -1) 
+       (:natural 0)
+       (:sharp 1)
+       (:double-sharp 2))))
+
+(defvar *tempo*)
 
 (defun measure-durations (slices)
   (let ((durations (mapcar (lambda (slice)
@@ -27,7 +33,7 @@
 		    (remove-if #'tie-left (notes element)))
 	    (mapcar (lambda (note)
 		      (make-instance 'note-off-message
-				     :time (+ time (* 128 (duration element)))
+				     :time (+ time (* *tempo* (duration element)))
 				     :status (+ #x80 channel)
 				     :key (midi-pitch note) :velocity 100))
 		    (remove-if #'tie-right (notes element))))))
@@ -35,7 +41,7 @@
 (defun events-from-bar (bar time channel)
   (mapcan (lambda (element)
 	    (prog1 (events-from-element element time channel)
-	      (incf time (* 128 (duration element)))))
+	      (incf time (* *tempo* (duration element)))))
 	  (elements bar)))
 
 (defun track-from-slice (slice channel durations)
@@ -44,12 +50,13 @@
 	(let ((time 0))
 	  (mapcan (lambda (bar duration)
 		    (prog1 (events-from-bar bar time channel)
-		      (incf time (* 128 duration))))
+		      (incf time (* *tempo* duration))))
 		  (bars slice) durations))))
 
 (defun play-segment (segment)
   (let* ((slices (mapcar #'body (layers segment)))
 	 (durations (measure-durations slices))
+         (*tempo* (tempo segment))
 	 (tracks (loop for slice in slices
 		       for i from 0
 		       collect (track-from-slice slice i durations)))