summaryrefslogtreecommitdiffstatshomepage
path: root/3rdparty/portmidi/pm_cl/test-no-cm.lisp
blob: fd8527e6298887825550bd91807789c96d37b614 (plain) (blame)
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
;; 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)