-
Notifications
You must be signed in to change notification settings - Fork 0
/
test-no-cm.lisp
112 lines (102 loc) · 3.25 KB
/
test-no-cm.lisp
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
;; this is a half-baked sequence of PortMidi calls to test the interface
;; No calls to Common Music are made, hence test-no-cm.lisp
; setup cffi if it has not been done already
(if (not (boundp '*clpath*))
(load "setup-pm.lisp"))
(defun println (s) (print s) (terpri))
;; initialize portmidi lib
(pm:portmidi)
;; timer testing
(pt:Start )
(pt:Started)
(format t "time is ~A, type something~%" (pt:Time))
(read)
(format t "time is ~A, type something~%" (pt:Time))
(read)
(pt:Time)
(format t "time is ~A, type something~%" (pt:Time))
;; device testing
(pm:CountDevices)
(pprint (pm:GetDeviceInfo ))
(defparameter inid (pm:GetDefaultInputDeviceID ))
(pm:GetDeviceInfo inid)
(defparameter outid (pm:GetDefaultOutputDeviceID ))
(pm:GetDeviceInfo outid)
;; output testing
(defparameter outid 4) ; 4 = my SimpleSynth
(defparameter outdev (pm:OpenOutput outid 100 1000))
(pm:getDeviceInfo outid) ; :OPEN should be T
;; message tests
(defun pm (m &optional (s t))
(format s "#<message :op ~2,'0x :ch ~2,'0d :data1 ~3,'0d :data2 ~3,'0d>"
(ash (logand (pm:Message.status m) #xf0) -4)
(logand (pm:Message.status m) #x0f)
(pm:Message.data1 m)
(pm:Message.data2 m)))
(defparameter on (pm:message #b10010000 60 64))
(terpri)
(pm on)
(pm:Message.status on)
(logand (ash (pm:Message.status on) -4) #x0f)
(pm:Message.data1 on)
(pm:Message.data2 on)
(pm:WriteShort outdev (+ (pm:time) 100) on)
(defparameter off (pm:message #b10000000 60 64))
(terpri)
(pm off)
(terpri)
(println "type something for note off")
(read)
(pm:WriteShort outdev (+ (pm:time) 100) off)
(println "type something to close output device")
(read)
(pm:Close outdev)
;; event buffer testing
(defparameter buff (pm:EventBufferNew 8))
(loop for i below 8 for x = (pm:EventBufferElt buff i)
;; set buffer events
do
(pm:Event.message x (pm:message #b1001000 (+ 60 i) (+ 100 i)))
(pm:Event.timestamp x (* 1000 i)))
(loop for i below 8 for x = (pm:EventBufferElt buff i)
;; check buffer contents
collect (list (pm:Event.timestamp x)
(pm:Message.data1 (pm:Event.message x))
(pm:Message.data2 (pm:Event.message x))))
(pm:EventBufferFree buff)
;; input testing -- requires external midi keyboard
(println (pm:GetDeviceInfo ))
(defparameter inid 1) ; 1 = my external keyboard
(defparameter indev (pm:OpenInput inid 256))
(pm:GetDeviceInfo inid) ; :OPEN should be T
(pm:SetFilter indev pm:filt-realtime) ; ignore active sensing etc.
(println "poll says:")
(println (pm:Poll indev))
(println "play midi keyboard and type something")
(read)
;;
;; ...play midi keyboard, then ...
;;
(println "poll says")
(println (pm:Poll indev))
(defparameter buff (pm:EventBufferNew 32))
(defparameter num (pm:Read indev buff 32))
(println "pm:Read gets")
(println num)
(println "input messages:")
(pm:EventBufferMap (lambda (a b) b (terpri) (pm a))
buff num)
(pm:Poll indev)
(println "play keyboard, to stop, play middle-C")
;;; recv testing
(defparameter pitch 0)
(loop while (/= pitch 60) do
(let ((n (pm:Read indev buff 1)))
(cond ((= n 1)
(pm:EventBufferMap
(lambda (a b)
b (pm a) (terpri)
(setf pitch (pm:Message.data1 a)))
buff n)))))
(pm:EventBufferFree buff)
(pm:Close indev)