forked from defaultxr/cl-patterns
-
Notifications
You must be signed in to change notification settings - Fork 0
/
alsa-midi.lisp
131 lines (107 loc) · 5.96 KB
/
alsa-midi.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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
(in-package #:cl-patterns)
;; FIX: add bend?
;;; utility functions
(defun alsa-midi-panic (&key channel manually-free)
"Stop all notes on CHANNEL, or all channels if CHANNEL is nil."
(loop :for c :in (or (ensure-list channel) (list 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
:do (if manually-free
(loop :for note :from 0 :upto 127
:do (midihelper:send-event (midihelper:ev-noteoff c note 0)))
(midihelper:send-event (midihelper:ev-cc c 123 0)))))
;;; cc mapping
;; http://nickfever.com/music/midi-cc-list
(defparameter *alsa-midi-channels-instruments* (make-list 16 :initial-element 0))
(defparameter *alsa-midi-cc-table* (make-hash-table)
"Hash table mapping CC numbers to metadata and event key names to CC numbers.")
(defun set-alsa-midi-cc-mapping (cc-number description &optional event-key (mapping 'midi-truncate-clamp))
"Set a mapping for CC-NUMBER. When EVENT-KEY is seen in an event being played by the MIDI backend, its value will be converted using the function specified by MAPPING, and then that value will be set for CC number CC-NUMBER just before the note itself is triggered. DESCRIPTION is a description of what the CC controls."
(setf (gethash cc-number *alsa-midi-cc-table*)
(list cc-number description event-key mapping))
(when event-key
(setf (gethash event-key *alsa-midi-cc-table*)
cc-number)))
(defun get-alsa-midi-auto-cc-mapping (key)
"Return auto-generated CC mapping parameters for a KEY of the format \"C-N\", where N is a valid CC number."
(let ((sym-name (symbol-name key)))
(when (and (>= (length sym-name) 2)
(string= "C-" (subseq sym-name 0 2)))
(let ((num (parse-integer (subseq sym-name 2) :junk-allowed t)))
(when (and (integerp num)
(<= 0 num 127))
(list num (format nil "CC ~s" num) key 'identity))))))
(defun get-alsa-midi-cc-mapping (key)
"Return the CC mapping parameters for a CC number or an event key."
(let ((key-map (or (gethash key *alsa-midi-cc-table*)
(get-alsa-midi-auto-cc-mapping key))))
(if (numberp key-map)
(gethash key-map *alsa-midi-cc-table*)
key-map)))
;; set default cc mappings
(mapc (lambda (x) (apply 'set-alsa-midi-cc-mapping x))
'((1 "Vibrato/Modulation" :vibrato unipolar-1-to-midi)
(8 "Balance" :balance bipolar-1-to-midi)
(10 "Pan" :pan bipolar-1-to-midi)
(71 "Resonance/Timbre" :res unipolar-1-to-midi)
(72 "Release" :release)
(73 "Attack" :attack)
(74 "Cutoff/Brightness" :ffreq frequency-to-midi)
(84 "Portamento amount" :porta)
(91 "Reverb" :reverb)
(92 "Tremolo" :tremolo)
(93 "Chorus" :chorus)
(94 "Phaser" :phaser)))
;;; backend functions
(defmethod start-backend ((backend (eql :alsa-midi)) &key)
(unless (elt (midihelper:inspect-midihelper) 5)
(midihelper:start-midihelper)))
(defmethod stop-backend ((backend (eql :alsa-midi)))
(midihelper:stop-midihelper))
(defmethod backend-instrument-controls (instrument (backend (eql :alsa-midi)))
(keys *alsa-midi-cc-table*))
(defmethod backend-node-p (object (backend (eql :alsa-midi)))
nil)
(defmethod backend-timestamps-for-event (event task (backend (eql :alsa-midi)))
nil)
(defmethod backend-proxys-node (id (backend (eql :alsa-midi)))
nil)
(defmethod backend-control-node-at (time (node number) params (backend (eql :alsa-midi)))
(midihelper:ev-noteon node note velocity))
(defmethod backend-control-node-at (time node params (backend (eql :alsa-midi)))
nil)
(defmethod backend-play-event (event task (backend (eql :alsa-midi)))
(when (or (eql (event-value event :type) :midi)
(typep (event-value event :instrument) 'number))
(let* ((channel (midi-truncate-clamp (or (event-value event :channel) 0) 15))
(pgm (midi-truncate-clamp (multiple-value-bind (value from) (event-value event :instrument)
(if (or (eql t from))
0
(if (not (integerp value))
0 ;; FIX: provide an instrument translation table (to automatically translate instrument names to program numbers)
value)))))
(note (midi-truncate-clamp (event-value event :midinote)))
(velocity (unipolar-1-to-midi (event-value event :amp))) ;; FIX: maybe this shouldn't be linear?
(time (local-time:timestamp+ (or (raw-event-value event :timestamp-at-start) (local-time:now))
(truncate (* (or (raw-event-value event :latency) *latency*) 1000000000))
:nsec))
(extra-params (loop :for key :in (keys event)
:for cc-mapping = (get-alsa-midi-cc-mapping key)
:if cc-mapping
:collect (list (car cc-mapping) (funcall (nth 3 cc-mapping) (event-value event key))))))
(bt:make-thread
(lambda ()
(sleep (local-time:timestamp-difference time (local-time:now)))
(when (and pgm
(not (= pgm (nth channel *alsa-midi-channels-instruments*))))
(midihelper:send-event (midihelper:ev-pgmchange channel pgm)))
(loop :for i :in extra-params
:do (midihelper:send-event (midihelper:ev-cc channel (car i) (cadr i))))
(midihelper:send-event (midihelper:ev-noteon channel note velocity))
(sleep (dur-time (sustain event) (tempo (slot-value task 'clock)))) ;; FIX: ignore/handle events with negative sleep values?
(midihelper:send-event (midihelper:ev-noteoff channel note velocity)))
:name "cl-patterns temporary alsa midi note thread"))))
(defmethod backend-task-removed (task (backend (eql :alsa-midi)))
;; FIX
)
(register-backend :alsa-midi)
;; (enable-backend :alsa-midi)
(export '(alsa-midi-panic set-alsa-midi-cc-mapping get-alsa-midi-cc-mapping))