diff implementations/midi/functions.lisp @ 228:16b99fc989aa

Add some basic midi predicate and accessor functions.

Ignore-this: ab60873a92efc7f4c3cd98cdb938dcea

darcs-hash:20090918100419-16a00-bd8423ddea7a4700d7e1c5300e4dafd35113897c.gz

committer: Jamie Forth <[e-mail]>

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/implementations/midi/functions.lisp	Thu Feb 24 11:23:18 2011 +0000
@@ -0,0 +1,65 @@
+(cl:in-package #:amuse-midi)
+
+;;;========================================================================
+;;; Functions that return features given an event.
+;;;========================================================================
+
+(defun midi-event-type (event)
+  "Defines an arbitrary ordering for pitched and percussive events."
+  (if (pitchedp event) 0 1))
+
+;;;========================================================================
+;;; Predicates for conditioning on event attributes.
+;;; Useful for sia-datapoint-specs.
+;;;========================================================================
+
+;;; midi-drum-sound
+(defun midi-drum-sound-eql (event sound)
+  (eql (midi-drum-sound event) sound))
+
+(defun make-midi-drum-sound-eql (sound)
+  (lambda (event)
+    (funcall #'midi-drum-sound-eql event sound)))
+
+(defun midi-drum-sound-any (event &rest sounds)
+  (loop for sound in sounds
+     do (if (midi-drum-sound-eql event sound)
+	    (return t))))
+
+(defun make-midi-drum-sound-any (&rest sounds)
+  (lambda (event)
+    (apply #'midi-drum-sound-any event sounds)))
+
+;;; midi-channel
+(defun midi-channel-eql (event channel)
+  (eql (midi-channel event) channel))
+
+(defun make-midi-channel-eql (channel)
+  (lambda (event)
+    (funcall #'midi-channel-eql event channel)))
+
+(defun midi-channel-any (event &rest channels)
+  (loop for channel in channels
+     do (if (midi-channel-eql event channel)
+	    (return t))))
+
+(defun make-midi-channel-any (&rest channels)
+  (lambda (event)
+    (apply #'midi-channel-any event channels)))
+
+;;; midi-track
+(defun midi-track-eql (event track)
+  (eql (midi-track event) track))
+
+(defun make-midi-track-eql (track)
+  (lambda (event)
+    (funcall #'midi-track-eql event track)))
+
+(defun midi-track-any (event &rest tracks)
+  (loop for track in tracks
+     do (if (midi-track-eql event track)
+	    (return t))))
+
+(defun make-midi-track-any (&rest tracks)
+  (lambda (event)
+    (apply #'midi-track-any event tracks)))