Mercurial > hg > amuse

changeset 64:c8f1b0ab0007

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
midi-output is now in tools darcs-hash:20070628144900-f76cc-f96cd99afbd2d9cf3274717ade3578e4c97559e8.gz
author David Lewis <d.lewis@gold.ac.uk>
date Thu, 28 Jun 2007 15:49:00 +0100
parents 32314fefc706
children 5b02163ade2a
files amuse.asd implementations/midi/package.lisp tools/midi-output.lisp tools/package.lisp utils/midi-output.lisp utils/package.lisp
diffstat 6 files changed, 173 insertions(+), 167 deletions(-) [+]
line wrap: on
line diff
--- a/amuse.asd	Thu Jun 28 14:53:53 2007 +0100
+++ b/amuse.asd	Thu Jun 28 15:49:00 2007 +0100
@@ -17,8 +17,11 @@
             :components
             ((:file "package")
              (:file "utils" :depends-on ("package"))
-	     (:file "n-grams" :depends-on ("package"))
-	     (:file "midi-output" :depends-on ("package" "utils"))))
+	     (:file "n-grams" :depends-on ("package"))))
+   (:module tools            
+            :components
+	    ((:file "package")
+	     (:file "midi-output" :depends-on ("package"))))
    (:module implementations
             :components 
             ((:module midi
--- a/implementations/midi/package.lisp	Thu Jun 28 14:53:53 2007 +0100
+++ b/implementations/midi/package.lisp	Thu Jun 28 15:49:00 2007 +0100
@@ -1,5 +1,5 @@
 (cl:defpackage #:amuse-midi 
-  (:use #:common-lisp #:amuse #:amuse-utils)
+  (:use #:common-lisp #:amuse #:amuse-utils #:amuse-tools)
   (:export #:midi-composition
 	   #:midi-pitched-event
            #:midi-percussive-event
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/midi-output.lisp	Thu Jun 28 15:49:00 2007 +0100
@@ -0,0 +1,155 @@
+;; Make midifiles from basic amuse objects methods here can be
+;; overridden for more specific types
+;; 
+
+;; FIXME: Need to push some structures from geerdes to make this work.
+
+(in-package #:amuse-tools)
+
+(defgeneric play (music)
+  (:method (m) (play-midifile (make-midi m))))
+(defmethod play ((music composition))
+  (play-midifile (make-midi music)))
+
+(defun play-midifile (midifile)
+  ;; coremidi is easy as an alternative, but we'll probably want midi
+  ;; file export anyway, so it makes some sense to focus our efforts
+  ;; on this first. That said, is there a CoreAudio midi file player
+  ;; routine?
+  (midi:write-midi-file midifile "tmp.mid")
+  #+darwin
+  (when (sb-impl::find-executable-in-search-path "open")
+    (asdf:run-shell-command "open tmp.mid")
+    (return-from play-midifile T))
+  (when (sb-impl::find-executable-in-search-path "timidity")
+    (asdf:run-shell-command "timidity tmp.mid")
+    (return-from play-midifile T)))
+
+(defgeneric make-midi (sequence))
+(defmethod make-midi ((sequence sequence))
+  ;; Make a midifile object. Collects global midi messages (that
+  ;; require a sequence) and event-based messages (that don't).
+  ;; FIXME: Something about this strikes me as very stupid. Must
+  ;; revisit
+  ;; FIXME: Only making type 0. Is this a problem?
+  (let* ((events (event-sequence-messages sequence))
+	 (globals (global-messages sequence))
+	 (patches (patch-messages sequence)))
+    (make-midifile-from-messages (nconc events globals patches)
+				 :type 0)))
+
+(defun make-midifile-from-messages (events &key (type 0))
+  ;; FIXME: clearly broken if type 1
+  ;; First have to get rid of all fractional times and choose a
+  ;; timebase
+  (let* ((timebase (apply #'lcm (mapcar #'(lambda (x)
+					    (denominator
+					     (midi:message-time x)))
+					events))))
+    (when (< timebase 4)
+      (setf timebase (* 4 timebase)))
+    (loop for e in events
+       do (setf (midi:message-time e) (* timebase
+					 (midi:message-time e))))
+    (make-instance 'midi:midifile
+		   :format type
+		   :division timebase
+		   :tracks (list (sort-midi-messages-for-output events)))))
+
+(defun sort-midi-messages-for-output (messages)
+  (sort messages #'(lambda (x y) (or (< (midi:message-time x)
+					(midi:message-time y))
+				     (and (= (midi:message-time x)
+					     (midi:message-time y))
+					  (< (midi::message-status x)
+					     (midi::message-status y)))))))
+
+(defun event-sequence-messages (sequence)
+  (let ((midinotes))
+    (sequence:dosequence (event sequence midinotes)
+      (let ((messages (event-messages event)))
+	(dolist (message messages)
+	  (push message midinotes))))))
+
+(defun patch-messages (sequence)
+  (let ((patches (make-array 16 :initial-element nil))
+	(patch-list)
+	(channel 0)
+	(patch 0))
+    (sequence:dosequence (event sequence patch-list)
+      (setf channel (get-channel-for-midi event)
+	    patch (get-patch-for-midi event))
+      (when (or (not (aref patches channel))
+		(not (= (aref patches channel)
+			patch)))
+	(push (make-instance 'midi:program-change-message
+			     :program patch
+			     :time (timepoint event)
+			     :status (+ channel 192))
+	      patch-list)
+	(setf (aref patches channel) patch)))))
+		
+
+(defgeneric global-messages (sequence)
+  (:method (s) (declare (ignore s)) nil))
+(defmethod global-messages ((sequence composition))
+  ;; FIXME: missing plenty of other messages
+  ;; FIXME: messy
+  (let ((tempi (tempi sequence))
+	(temp)
+	(time-sigs (time-signatures sequence))
+	(events))
+    (dolist (tempo tempi)
+      (setf temp (tempo-message tempo))
+      (when temp
+	(push temp events)))
+    (dolist (time-sig time-sigs events)
+      (setf temp (time-sig-message time-sig))
+      (when temp
+	(push temp events)))))
+
+(defgeneric tempo-message (tempo)
+  (:method (tp)
+    (progn
+      (let ((speed (make-instance 'midi:tempo-message
+				  :time (timepoint tp)
+				  :status 255)))
+	(setf (slot-value speed 'midi::tempo) (microseconds-per-crotchet tp))
+	speed))))
+
+(defgeneric time-sig-message (time-sig)
+  (:method (ts) (declare (ignore ts)) nil))
+
+(defgeneric event-messages (event)
+  (:method (e) (declare (ignore e)) nil))
+(defmethod event-messages ((event pitched-event))
+  (list (make-instance 'midi:note-on-message
+		       :status (+ (get-channel-for-midi event) 144)
+		       :key (midi-pitch-number event)
+		       :velocity (get-velocity-for-midi event)
+		       :time (timepoint event))
+	(make-instance 'midi:note-off-message
+		       :status (+ (get-channel-for-midi event) 128)
+		       :key (midi-pitch-number event)
+		       :velocity (get-velocity-for-midi event)
+		       :time (timepoint (cut-off event)))))
+
+(defmethod event-messages ((event percussive-event))
+  (list (make-instance 'midi:note-on-message
+		       :status 153
+		       :key (get-pitch-for-midi event)
+		       :velocity (get-velocity-for-midi event)
+		       :time (timepoint event))
+	(make-instance 'midi:note-off-message
+		       :status 137
+		       :key (get-pitch-for-midi event)
+		       :velocity (get-velocity-for-midi event)
+		       :time (timepoint (cut-off event)))))
+
+(defgeneric get-pitch-for-midi (event))
+(defgeneric get-velocity-for-midi (event)
+  (:method (e) (declare (ignore e)) 100))
+(defgeneric get-patch-for-midi (event)
+  (:method (e) (declare (ignore e)) 0))
+(defgeneric get-channel-for-midi (event)
+  (:method (e) (declare (ignore e)) 0))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/package.lisp	Thu Jun 28 15:49:00 2007 +0100
@@ -0,0 +1,12 @@
+(cl:defpackage #:amuse-tools
+  (:use #:common-lisp #:amuse #:amuse-utils #:midi)
+  (:export #:play
+	   #:make-midi
+	   #:global-messages
+	   #:tempo-message
+	   #:event-messages
+	   #:get-patch-for-midi
+	   #:get-channel-for-midi
+	   #:get-pitch-for-midi
+	   #:get-velocity-for-midi
+	   ))
--- a/utils/midi-output.lisp	Thu Jun 28 14:53:53 2007 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,155 +0,0 @@
-;; Make midifiles from basic amuse objects methods here can be
-;; overridden for more specific types
-;; 
-
-;; FIXME: Need to push some structures from geerdes to make this work.
-
-(in-package #:amuse-utils)
-
-(defgeneric play (music)
-  (:method (m) (play-midifile (make-midi m))))
-(defmethod play ((music composition))
-  (play-midifile (make-midi music)))
-
-(defun play-midifile (midifile)
-  ;; coremidi is easy as an alternative, but we'll probably want midi
-  ;; file export anyway, so it makes some sense to focus our efforts
-  ;; on this first. That said, is there a CoreAudio midi file player
-  ;; routine?
-  (midi:write-midi-file midifile "tmp.mid")
-  #+darwin
-  (when (sb-impl::find-executable-in-search-path "open")
-    (asdf:run-shell-command "open tmp.mid")
-    (return-from play-midifile T))
-  (when (sb-impl::find-executable-in-search-path "timidity")
-    (asdf:run-shell-command "timidity tmp.mid")
-    (return-from play-midifile T)))
-
-(defgeneric make-midi (sequence))
-(defmethod make-midi ((sequence sequence))
-  ;; Make a midifile object. Collects global midi messages (that
-  ;; require a sequence) and event-based messages (that don't).
-  ;; FIXME: Something about this strikes me as very stupid. Must
-  ;; revisit
-  ;; FIXME: Only making type 0. Is this a problem?
-  (let* ((events (event-sequence-messages sequence))
-	 (globals (global-messages sequence))
-	 (patches (patch-messages sequence)))
-    (make-midifile-from-messages (nconc events globals patches)
-				 :type 0)))
-
-(defun make-midifile-from-messages (events &key (type 0))
-  ;; FIXME: clearly broken if type 1
-  ;; First have to get rid of all fractional times and choose a
-  ;; timebase
-  (let* ((timebase (apply #'lcm (mapcar #'(lambda (x)
-					    (denominator
-					     (midi:message-time x)))
-					events))))
-    (when (< timebase 4)
-      (setf timebase (* 4 timebase)))
-    (loop for e in events
-       do (setf (midi:message-time e) (* timebase
-					 (midi:message-time e))))
-    (make-instance 'midi:midifile
-		   :format type
-		   :division timebase
-		   :tracks (list (sort-midi-messages-for-output events)))))
-
-(defun sort-midi-messages-for-output (messages)
-  (sort messages #'(lambda (x y) (or (< (midi:message-time x)
-					(midi:message-time y))
-				     (and (= (midi:message-time x)
-					     (midi:message-time y))
-					  (< (midi::message-status x)
-					     (midi::message-status y)))))))
-
-(defun event-sequence-messages (sequence)
-  (let ((midinotes))
-    (sequence:dosequence (event sequence midinotes)
-      (let ((messages (event-messages event)))
-	(dolist (message messages)
-	  (push message midinotes))))))
-
-(defun patch-messages (sequence)
-  (let ((patches (make-array 16 :initial-element nil))
-	(patch-list)
-	(channel 0)
-	(patch 0))
-    (sequence:dosequence (event sequence patch-list)
-      (setf channel (get-channel-for-midi event)
-	    patch (get-patch-for-midi event))
-      (when (or (not (aref patches channel))
-		(not (= (aref patches channel)
-			patch)))
-	(push (make-instance 'midi:program-change-message
-			     :program patch
-			     :time (timepoint event)
-			     :status (+ channel 192))
-	      patch-list)
-	(setf (aref patches channel) patch)))))
-		
-
-(defgeneric global-messages (sequence)
-  (:method (s) (declare (ignore s)) nil))
-(defmethod global-messages ((sequence composition))
-  ;; FIXME: missing plenty of other messages
-  ;; FIXME: messy
-  (let ((tempi (tempi sequence))
-	(temp)
-	(time-sigs (time-signatures sequence))
-	(events))
-    (dolist (tempo tempi)
-      (setf temp (tempo-message tempo))
-      (when temp
-	(push temp events)))
-    (dolist (time-sig time-sigs events)
-      (setf temp (time-sig-message time-sig))
-      (when temp
-	(push temp events)))))
-
-(defgeneric tempo-message (tempo)
-  (:method (tp)
-    (progn
-      (let ((speed (make-instance 'midi:tempo-message
-				  :time (timepoint tp)
-				  :status 255)))
-	(setf (slot-value speed 'midi::tempo) (microseconds-per-crotchet tp))
-	speed))))
-
-(defgeneric time-sig-message (time-sig)
-  (:method (ts) (declare (ignore ts)) nil))
-
-(defgeneric event-messages (event)
-  (:method (e) (declare (ignore e)) nil))
-(defmethod event-messages ((event pitched-event))
-  (list (make-instance 'midi:note-on-message
-		       :status (+ (get-channel-for-midi event) 144)
-		       :key (midi-pitch-number event)
-		       :velocity (get-velocity-for-midi event)
-		       :time (timepoint event))
-	(make-instance 'midi:note-off-message
-		       :status (+ (get-channel-for-midi event) 128)
-		       :key (midi-pitch-number event)
-		       :velocity (get-velocity-for-midi event)
-		       :time (timepoint (cut-off event)))))
-
-(defmethod event-messages ((event percussive-event))
-  (list (make-instance 'midi:note-on-message
-		       :status 153
-		       :key (get-pitch-for-midi event)
-		       :velocity (get-velocity-for-midi event)
-		       :time (timepoint event))
-	(make-instance 'midi:note-off-message
-		       :status 137
-		       :key (get-pitch-for-midi event)
-		       :velocity (get-velocity-for-midi event)
-		       :time (timepoint (cut-off event)))))
-
-(defgeneric get-pitch-for-midi (event))
-(defgeneric get-velocity-for-midi (event)
-  (:method (e) (declare (ignore e)) 100))
-(defgeneric get-patch-for-midi (event)
-  (:method (e) (declare (ignore e)) 0))
-(defgeneric get-channel-for-midi (event)
-  (:method (e) (declare (ignore e)) 0))
--- a/utils/package.lisp	Thu Jun 28 14:53:53 2007 +0100
+++ b/utils/package.lisp	Thu Jun 28 15:49:00 2007 +0100
@@ -7,15 +7,6 @@
 	   #:bass-note
 	   #:crotchets-in-a-bar
 	   #:sounding-events
-	   #:play
-	   #:make-midi
-	   #:global-messages
-	   #:tempo-message
-	   #:event-messages
-	   #:get-patch-for-midi
-	   #:get-channel-for-midi
-	   #:get-pitch-for-midi
-	   #:get-velocity-for-midi
 	   #:levenshtein-distance
 	   #:beats-to-seconds
 	   #:get-n-grams