[gsharp-cvs] CVS update: gsharp/play.lisp gsharp/buffer.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp gsharp/system.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Oct 31 01:41:15 UTC 2005
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")
More information about the Gsharp-cvs
mailing list