Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv27994
Modified Files: buffer.lisp drawing.lisp gui.lisp packages.lisp system.lisp Added Files: play.lisp Log Message: Extracted midi-related computations to a new file: play.lisp
Renamed notehead-duration to undotted-duration, which better reflects the intention.
Date: Mon Oct 31 02:41:13 2005 Author: rstrandh
Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.9 gsharp/buffer.lisp:1.10 --- gsharp/buffer.lisp:1.9 Thu Aug 5 08:31:57 2004 +++ gsharp/buffer.lisp Mon Oct 31 02:41:13 2005 @@ -237,7 +237,7 @@ ":notehead ~W :rbeams ~W :lbeams ~W :dots ~W :xoffset ~W " notehead rbeams lbeams dots xoffset)))
-(defmethod notehead-duration ((element element)) +(defmethod undotted-duration ((element element)) (ecase (notehead element) (:whole 1) (:half 1/2) @@ -245,7 +245,7 @@ (lbeams element))))))))
(defmethod element-duration ((element element)) - (let ((duration (notehead-duration element))) + (let ((duration (undotted-duration element))) (do ((dot-duration (/ duration 2) (/ dot-duration 2)) (nb-dots (dots element) (1- nb-dots))) ((zerop nb-dots))
Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.11 gsharp/drawing.lisp:1.12 --- gsharp/drawing.lisp:1.11 Fri Sep 2 18:10:03 2005 +++ gsharp/drawing.lisp Mon Oct 31 02:41:13 2005 @@ -633,7 +633,7 @@ (defmethod draw-element (pane (element rest) x &optional (flags t)) (declare (ignore flags)) (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element))) - (score-pane:draw-rest pane (notehead-duration element) x (staff-pos element)) + (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element)) (draw-dots pane (dots element) x (1+ (staff-pos element)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.26 gsharp/gui.lisp:1.27 --- gsharp/gui.lisp:1.26 Fri Oct 28 19:20:19 2005 +++ gsharp/gui.lisp Mon Oct 31 02:41:13 2005 @@ -528,86 +528,15 @@ :menu '(("Buffer" :command com-play-buffer) ("Segment" :command com-play-segment)))
-(defun midi-pitch (note) - (+ (* 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)))) - -(defun measure-durations (slices) - (let ((durations (mapcar (lambda (slice) - (mapcar (lambda (bar) - (reduce #'+ (elements bar) - :key #'element-duration)) - (bars slice))) - slices))) - (loop while durations - collect (reduce #'max (mapcar #'car durations)) - do (setf durations (remove nil (mapcar #'cdr durations)))))) - -(defun events-from-element (element time channel) - (when (typep element 'cluster) - (append (mapcar (lambda (note) - (make-instance 'note-on-message - :time time - :status (+ #x90 channel) - :key (midi-pitch note) :velocity 100)) - (notes element)) - (mapcar (lambda (note) - (make-instance 'note-off-message - :time (+ time (* 128 (element-duration element))) - :status (+ #x80 channel) - :key (midi-pitch note) :velocity 100)) - (notes element))))) - -(defun events-from-bar (bar time channel) - (mapcan (lambda (element) - (prog1 (events-from-element element time channel) - (incf time (* 128 (element-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 (* 128 duration)))) - (bars slice) durations)))) - (define-gsharp-command (com-play-segment :name t) () - (let* ((slices (mapcar #'body (layers (car (segments (buffer *application-frame*)))))) - (durations (measure-durations slices)) - (tracks (loop for slice in slices - for i from 0 - collect (track-from-slice slice i durations))) - (midifile (make-instance 'midifile - :format 1 - :division 25 - :tracks tracks))) - (write-midi-file midifile "test.mid") - #+cmu - (ext:run-program "timidity" '("test.mid")) - #+sbcl - (sb-ext:run-program "timidity" '("test.mid") :search t) - #-(or cmu sbcl) - (error "write compatibility layer for RUN-PROGRAM"))) + (play-segment (segment (cursor *application-frame*))))
(define-gsharp-command (com-play-layer :name t) () - (let* ((slice (body (layer (cursor *application-frame*)))) - (durations (measure-durations (list slice))) - (tracks (list (track-from-slice slice 0 durations))) - (midifile (make-instance 'midifile - :format 1 - :division 25 - :tracks tracks))) - (write-midi-file midifile "test.mid") - #+cmu - (ext:run-program "timidity" '("test.mid")) - #+sbcl - (sb-ext:run-program "timidity" '("test.mid") :search t) - #-(or cmu sbcl) - (error "write compatibility layer for RUN-PROGRAM"))) + (play-layer (layer (cursor *application-frame*)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; main entry point
(defun run-gsharp (&key (width 900) (height 600)) (let* ((buffer (make-initialized-buffer)) @@ -621,21 +550,6 @@ :width width :height height))) (setf (staves (car (layers (car (segments buffer))))) (list staff)) (run-frame-top-level *application-frame*)))) - -;; (defun run-gsharp () -;; (loop for port in climi::*all-ports* -;; do (destroy-port port)) -;; (setq climi::*all-ports* nil) -;; (let* ((buffer (make-initialized-buffer)) -;; (staff (car (staves buffer))) -;; (input-state (make-input-state)) -;; (cursor (make-initial-cursor buffer))) -;; (setf *application-frame* (make-application-frame 'gsharp -;; :buffer buffer -;; :input-state input-state -;; :cursor cursor) -;; (staves (car (layers (car (segments buffer))))) (list staff))) -;; (run-frame-top-level *application-frame*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;
Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.11 gsharp/packages.lisp:1.12 --- gsharp/packages.lisp:1.11 Thu Oct 13 11:05:04 2005 +++ gsharp/packages.lisp Mon Oct 31 02:41:13 2005 @@ -66,7 +66,7 @@ #:rename-staff #:add-staff-to-layer #:remove-staff-from-layer - #:stem-direction #:stem-length #:notehead-duration #:element-duration + #:stem-direction #:stem-length #:undotted-duration #:element-duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream #:line-width #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char @@ -202,10 +202,18 @@ #:header #:header-type #:unknown-event #:status #:data-byte))
+(defpackage :gsharp-play + (:use :common-lisp :midi :gsharp-buffer) + (:shadowing-import-from :gsharp-buffer #:rest) + (:export #:play-layer + #:play-segment + #:play-buffer)) + (defpackage :gsharp (:use :clim :clim-lisp :gsharp-utilities :esa :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering - :gsharp-measure :sdl :midi) + :gsharp-measure :sdl :midi + :gsharp-play) (:shadowing-import-from :gsharp-numbering #:number) (:shadowing-import-from :gsharp-buffer #:rest))
Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.7 gsharp/system.lisp:1.8 --- gsharp/system.lisp:1.7 Mon Jul 25 13:14:38 2005 +++ gsharp/system.lisp Mon Oct 31 02:41:13 2005 @@ -40,4 +40,5 @@ "input-state" "midi" "modes" + "play" "gui")