blob: fc7d4c2784e81d28e65f15572e8d896b42fc350a (
plain)
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
|
(define-module (guile-midi control)
#:use-module (ice-9 threads)
#:use-module (ice-9 binary-ports)
#:export (make-midi-port
midi-cc-value
send-midi-note))
(define (make-midi-port device-name listen-channel)
(let ((cc-vals (make-array 0 128))
(midi-port (open-file device-name "r+0b")))
;; Send a note off command
(define (send-noteoff note)
(put-u8 midi-port
(+ #b10000000 listen-channel))
(put-u8 midi-port note)
(put-u8 midi-port 0))
;; Send a note on command
(define (send-note note velocity)
(put-u8 midi-port
(+ #b10010000 listen-channel))
(put-u8 midi-port note)
(put-u8 midi-port velocity))
;; Get a CC value
(define (get-cc-value controller-number)
(array-ref cc-vals
controller-number))
(define (run-midi)
(let again ()
(letrec* ((status-byte (get-u8 midi-port))
(channel (bit-extract status-byte 0 4))
(command (bit-extract status-byte 4 8)))
(when (eq? channel listen-channel)
(case command
;; Note on
((9) (let ((note (get-u8 midi-port))
(vel (get-u8 midi-port)))
(display "Note = ")
(display (number->string note 16))
(display " velocity = ")
(display vel)
(newline)))
;; Control value
((11) (let* ((controller-number (get-u8 midi-port))
(value (get-u8 midi-port)))
(array-set! cc-vals
value
controller-number)))))
(again))))
;; Clear out any LEDs by first sending note-on with velocity zero
(for-each (lambda (n)
(send-note n 0))
(iota 128 0))
;; ... and subsequently sending note-off
(for-each (lambda (n)
(send-noteoff n))
(iota 128 0))
(make-thread run-midi)
(lambda args
(apply
(case (car args)
((get-cc-value) get-cc-value)
((send-note) send-note))
(cdr args)))))
(define-syntax midi-cc-value
(lambda (x)
(syntax-case x ()
((_ port controller-number)
#'(port 'get-cc-value controller-number)))))
(define-syntax send-midi-note
(lambda (x)
(syntax-case x ()
((_ port note velocity)
#'(port 'send-note note velocity))
((_ port note)
#'(port 'send-note note 127)))))
|
