comparison 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 <j.forth@gold.ac.uk>
author j.forth <j.forth@gold.ac.uk>
date Thu, 24 Feb 2011 11:23:18 +0000
parents
children
comparison
equal deleted inserted replaced
227:bda591c61b7a 228:16b99fc989aa
1 (cl:in-package #:amuse-midi)
2
3 ;;;========================================================================
4 ;;; Functions that return features given an event.
5 ;;;========================================================================
6
7 (defun midi-event-type (event)
8 "Defines an arbitrary ordering for pitched and percussive events."
9 (if (pitchedp event) 0 1))
10
11 ;;;========================================================================
12 ;;; Predicates for conditioning on event attributes.
13 ;;; Useful for sia-datapoint-specs.
14 ;;;========================================================================
15
16 ;;; midi-drum-sound
17 (defun midi-drum-sound-eql (event sound)
18 (eql (midi-drum-sound event) sound))
19
20 (defun make-midi-drum-sound-eql (sound)
21 (lambda (event)
22 (funcall #'midi-drum-sound-eql event sound)))
23
24 (defun midi-drum-sound-any (event &rest sounds)
25 (loop for sound in sounds
26 do (if (midi-drum-sound-eql event sound)
27 (return t))))
28
29 (defun make-midi-drum-sound-any (&rest sounds)
30 (lambda (event)
31 (apply #'midi-drum-sound-any event sounds)))
32
33 ;;; midi-channel
34 (defun midi-channel-eql (event channel)
35 (eql (midi-channel event) channel))
36
37 (defun make-midi-channel-eql (channel)
38 (lambda (event)
39 (funcall #'midi-channel-eql event channel)))
40
41 (defun midi-channel-any (event &rest channels)
42 (loop for channel in channels
43 do (if (midi-channel-eql event channel)
44 (return t))))
45
46 (defun make-midi-channel-any (&rest channels)
47 (lambda (event)
48 (apply #'midi-channel-any event channels)))
49
50 ;;; midi-track
51 (defun midi-track-eql (event track)
52 (eql (midi-track event) track))
53
54 (defun make-midi-track-eql (track)
55 (lambda (event)
56 (funcall #'midi-track-eql event track)))
57
58 (defun midi-track-any (event &rest tracks)
59 (loop for track in tracks
60 do (if (midi-track-eql event track)
61 (return t))))
62
63 (defun make-midi-track-any (&rest tracks)
64 (lambda (event)
65 (apply #'midi-track-any event tracks)))