/
rtmidi.xtm
219 lines (173 loc) · 7.64 KB
/
rtmidi.xtm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
;;; rtmidi.xtm -- MIDI support for Extempore
;; Author: Ben Swift
;; Keywords: extempore
;; Required dylibs: rtmidi
;;; Commentary:
;; The rtmidi library is a cross-platform MIDI library by Gary P.
;; Scavone.
;; Source and documentation for the rtmidi library is available at
;; http://music.mcgill.ca/~gary/rtmidi/
;; Because rtmidi is a C++ library (and Extempore can only bind C libs
;; at this stage), there is a project called CRtMidi which wraps
;; (part) of the rtmidi API in a C interface. This interface is then
;; bound dynamically in xtlang---that's what this file is for.
;; to compile:
;; clang++ -dynamiclib -Wall -D__MACOSX_CORE__ -o librtmidi.dylib RtMidi-C-Api.cpp -framework CoreMIDI -framework CoreAudio -framework CoreFoundation
;;; Code:
(define librtmidi
(let ((platform (sys:platform)))
(cond ((string=? platform "Linux") (sys:open-dylib "librtmidi.so"))
((string=? platform "Windows") (sys:open-dylib "librtmidi.dll"))
((string=? platform "OSX") (sys:open-dylib "librtmidi.dylib"))
(else (print "Unknown platform: " platform)))))
(if (not librtmidi)
(print-error "Could not load librtmidi dynamic library"))
;; bindings (see RtMidi.h)
;; UNSPECIFIED, /* Search for a working compiled API. */
;; MACOSX_CORE, /* Macintosh OS-X Core Midi API. */
;; LINUX_ALSA, /* The Advanced Linux Sound Architecture API. */
;; UNIX_JACK, /* The Jack Low-Latency MIDI Server API. */
;; WINDOWS_MM, /* The Microsoft Multimedia MIDI API. */
;; WINDOWS_KS, /* The Microsoft Kernel Streaming MIDI API. */
;; RTMIDI_DUMMY /* A compilable but non-functional API. */
(bind-val RTMIDI_NOERROR i32 0)
(bind-val RTMIDI_ERROR i32 1)
(define *midi-note-off* 8) ;; key, velocity
(define *midi-note-on* 9) ;; key, velocity
(define *midi-aftertouch* 10) ;; key, touch
(define *midi-continuous-controller* 11) ;; controller, value
(define *midi-patch-change* 12) ;;
(define *midi-channel-pressure* 13) ;;
(define *midi-pitch-bend* 14) ;; lsb (7 bits), msb (7 bits)
(bind-val MIDI_NOTE_OFF i8 *midi-note-off*)
(bind-val MIDI_NOTE_ON i8 *midi-note-on*)
(bind-val MIDI_AFTERTOUCH i8 *midi-aftertouch*)
(bind-val MIDI_CONTINUOUS_CONTROLLER i8 *midi-continuous-controller*)
(bind-val MIDI_PATCH_CHANGE i8 *midi-patch-change*)
(bind-val MIDI_CHANNEL_PRESSURE i8 *midi-channel-pressure*)
(bind-val MIDI_PITCH_BEND i8 *midi-pitch-bend*)
;; API enums
(bind-val UNSPECIFIED i32 0)
(bind-val MACOSX_CORE i32 1)
(bind-val LINUX_ALSA i32 2)
(bind-val UNIX_JACK i32 3)
(bind-val WINDOWS_MM i32 4)
(bind-val WINDOWS_KS i32 5)
(bind-val RTMIDI_DUMMY i32 6)
(bind-type midi_in_device <i8*>)
(bind-type midi_out_device <i8*>)
(bind-alias midi_callback [i8*,double,i64,i8*]*)
;; midi input
(bind-lib librtmidi newMidiInDevice [i32,midi_in_device*,i32,i8*]*)
(bind-lib librtmidi deleteMidiInDevice [i32,midi_in_device*]*)
(bind-lib librtmidi getInCurrentApi [i64,midi_in_device*]*)
(bind-lib librtmidi getInPortCount [i64,midi_in_device*]*)
(bind-lib librtmidi getInPortName [i8*,midi_in_device*,i64]*)
(bind-lib librtmidi openInPort [i32,midi_in_device*,i64,i8*]*)
(bind-lib librtmidi openInVirtualPort [i32,midi_in_device*,i8*]*)
(bind-lib librtmidi closeInPort [i32,midi_in_device*]*)
(bind-lib librtmidi setCallback [i32,midi_in_device*,i8*]*)
(bind-lib librtmidi cancelCallback [i32,midi_in_device*]*)
;; midi output
(bind-lib librtmidi newMidiOutDevice [i32,midi_out_device*,i32,i8*]*)
(bind-lib librtmidi deleteMidiOutDevice [i32,midi_out_device*]*)
(bind-lib librtmidi getOutCurrentApi [i64,midi_out_device*]*)
(bind-lib librtmidi getOutPortCount [i64,midi_out_device*]*)
(bind-lib librtmidi getOutPortName [i8*,midi_out_device*,i64]*)
(bind-lib librtmidi openOutPort [i32,midi_out_device*,i64,i8*]*)
(bind-lib librtmidi openOutVirtualPort [i32,midi_out_device*,i8*]*)
(bind-lib librtmidi closeOutPort [i32,midi_out_device*]*)
(bind-lib librtmidi sendMessage [i32,midi_out_device*,i64,i8*]*)
;; poly'ing
(bind-poly newMidiDevice newMidiInDevice)
(bind-poly newMidiDevice newMidiOutDevice)
(bind-poly deleteMidiDevice deleteMidiInDevice)
(bind-poly deleteMidiDevice deleteMidiOutDevice)
(bind-poly getCurrentApi getInCurrentApi)
(bind-poly getCurrentApi getOutCurrentApi)
(bind-poly getPortCount getInPortCount)
(bind-poly getPortCount getOutPortCount)
(bind-poly getPortName getInPortName)
(bind-poly getPortName getOutPortName)
(bind-poly openPort openInPort)
(bind-poly openPort openOutPort)
(bind-poly openVirtualPort openInVirtualPort)
(bind-poly openVirtualPort openOutVirtualPort)
(bind-poly closePort closeInPort)
(bind-poly closePort closeOutPort)
;; set up some input/output ports
(bind-func query_in_ports
(lambda (dev:midi_in_device*)
(let ((num_ports (getPortCount dev))
(i:i64 0))
(printf "--Input ports--\n")
(dotimes (i num_ports)
(printf "Port %lld: %s\n" i (getPortName dev i)))
(printf "\n")
void)))
(bind-func query_out_ports
(lambda (dev:midi_out_device*)
(let ((num_ports (getPortCount dev))
(i:i64 0))
(printf "--Output ports--\n")
(dotimes (i num_ports)
(printf "Port %lld: %s\n" i (getPortName dev i)))
(printf "\n")
void)))
(bind-poly query_ports query_in_ports)
(bind-poly query_ports query_out_ports)
(bind-func midi_in
(let ((device:midi_in_device* (zalloc)))
(newMidiDevice device UNSPECIFIED "Extempore Virtual Midi Input")
(openVirtualPort device "Extempore Input")
(lambda ()
device)))
(bind-func midi_out
(let ((device:midi_out_device* (zalloc)))
(newMidiOutDevice device UNSPECIFIED "Extempore Midi Output")
;; (openVirtualPort device "Ben Port")
(openPort device 0 "Extempore Output") ;; needs to be correct channel
(lambda ()
device)))
(query_in_ports (midi_in))
(query_out_ports (midi_out))
;; testing
(bind-func midi_dump
(let ((type:i8 0) (chan:i8 0) (a:i8 0) (b:i8 0))
(lambda (time:double len:i64 msg:i8*)
(set! type (>> (pref msg 0) 4))
(set! chan (& (pref msg 0) 15))
(set! a (pref msg 1))
(set! b (pref msg 2))
(printf "time = %f\ntype = %u\nchan = %u\na = %u\nb = %u\n---------------\n"
time (i8toi32 type) (i8toi32 chan) (i8toi32 a) (i8toi32 b))
void)))
(bind-func register_midi_callback
(lambda ()
(setCallback (midi_in) (llvm_get_function_ptr "midi_dump_native"))))
;; (register_midi_callback)
;; (cancelCallback (midi_in))
(bind-func send_midi
(lambda (dev:midi_out_device* type chan a b)
(let ((msg:i8* (salloc 3)))
(pfill! msg (+ (<< type 4) chan) a b)
(sendMessage dev 3 msg))))
;; (send_midi (midi_out) *midi-note-on* 0 60 80)
;; (send_midi (midi_out) *midi-note-off* 0 60 80)
(define *midi-chan* 0)
(define play-midi ;; with *midi-chan* as a scheme global
(lambda (time dev pitch velocity duration)
(callback time 'send_midi dev *midi-note-on* *midi-chan* pitch velocity)
(callback (+ time duration) 'send_midi dev *midi-note-off* *midi-chan* pitch velocity)))
;; a midi-specific play macro
(macro (playm args)
(if (symbol? (cadr args))
(if (> (length args) 5)
`(play-midi (*metro* beat) ,(cadr args) ,(caddr args) ,(cadddr args) (*metro* 'dur ,(car (cddddr args)))
,(car (cdr (cddddr args))))
`(play-midi (*metro* beat) ,(cadr args) ,(caddr args) ,(cadddr args) (*metro* 'dur ,(car (cddddr args)))))
(if (> (length args) 6)
`(play-midi (*metro* (+ beat ,(cadr args))) ,(caddr args) ,(cadddr args) ,(car (cddddr args))
(*metro* 'dur ,(car (cdr (cddddr args)))) ,(car (cddr (cddddr args))))
`(play-midi (*metro* (+ beat ,(cadr args))) ,(caddr args) ,(cadddr args) ,(car (cddddr args))
(*metro* 'dur ,(car (cdr (cddddr args))))))))