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