Index: buffer.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/buffer.lisp,v
retrieving revision 1.35
diff -u -r1.35 buffer.lisp
--- buffer.lisp	28 Feb 2006 23:42:12 -0000	1.35
+++ buffer.lisp	1 Mar 2006 10:36:06 -0000
@@ -947,7 +976,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))
@@ -959,7 +989,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))
Index: gui.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/gui.lisp,v
retrieving revision 1.57
diff -u -r1.57 gui.lisp
--- gui.lisp	1 Mar 2006 00:15:42 -0000	1.57
+++ gui.lisp	1 Mar 2006 10:36:06 -0000
@@ -316,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
Index: packages.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/packages.lisp,v
retrieving revision 1.47
diff -u -r1.47 packages.lisp
--- packages.lisp	1 Mar 2006 00:15:42 -0000	1.47
+++ packages.lisp	1 Mar 2006 10:36:06 -0000
@@ -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
Index: play.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/play.lisp,v
retrieving revision 1.4
diff -u -r1.4 play.lisp
--- play.lisp	28 Feb 2006 23:49:18 -0000	1.4
+++ play.lisp	1 Mar 2006 10:36:06 -0000
@@ -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)))
