blob: 606bd728a15ace4d5268f2cd45ae7a61ccfe4a85 (
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
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
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
(define-module (starlet midi-control faders)
#:use-module (starlet midi-control base)
#:use-module (starlet base)
#:use-module (starlet utils)
#:use-module (ice-9 receive)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-1)
#:export (state-on-fader))
(define* (state-on-fader cc-number
state
#:key (channel #f))
(register-state!
(lighting-state
(state-for-each
(lambda (fix attr val)
(at fix attr
(lambda (time)
(let ((cc-val (get-cc-value cc-number #:channel channel)))
;; Fader position known?
(if cc-val
(if (intensity? attr)
;; Intensity parameters get scaled according to the fader
(* 0.01 val (ccval->percent cc-val))
;; Non-intensity parameters just get set in our new state,
;; but only if the fader is up!
(if (> cc-val 0)
val
'no-value))
;; Fader position unknown
'no-value)))))
state))))
(define (current-values fixture-list attr-name)
(map (lambda (fix)
(current-value fix attr-name (hirestime)))
fixture-list))
(define (fixtures-with-attr fixture-list attr-name)
(let ((attrs (map (partial find-attr attr-name) fixture-list)))
(fold (lambda (fix attr old)
(if attr
(cons (cons fix (car old))
(cons attr (cdr old)))
old))
(cons '() '())
fixture-list attrs)))
(define* (at-midi-jogwheel fixture-list attr cc-number
#:key (led #f))
(define (ccval->offset a)
(if (eq? a 127)
-1
1))
(let ((fixtures (car (fixtures-with-attr fixture-list attr))))
(unless (null? fixtures)
(when led
(send-note-on led))
(let ((old-vals (current-values fixtures attr))
(offset 0))
(register-midi-cc-callback!
#:cc-number cc-number
#:func (lambda (prev-cc-val new-cc-value)
(set! offset (+ offset (ccval->offset new-cc-value)))
(for-each (lambda (fix old-val)
(set-in-state! programmer-state
fix
attr
(+ old-val offset)))
fixtures old-vals)))))))
(define (fader-congruent vals attrs)
(mean (map (lambda (val attr)
(scale-to-range val
(get-attr-range attr)
'(0 127)))
vals attrs)))
(define (fader-up-gradients initial-vals
attrs
congruent-val)
(map (lambda (initial-val attr)
(let ((attr-max (cadr (get-attr-range attr))))
(if (< congruent-val 127)
(/ (- attr-max initial-val)
(- 127 congruent-val))
0)))
initial-vals
attrs))
(define (fader-down-gradients initial-vals
attrs
congruent-val)
(map (lambda (initial-val attr)
(let ((attr-min (car (get-attr-range attr))))
(if (> congruent-val 0)
(/ (- initial-val attr-min)
congruent-val)
0)))
initial-vals
attrs))
(define (apply-fader cc-offset
attr-name
gradients
initial-vals
fixtures)
(for-each (lambda (fix initial-val gradient)
(set-in-state! programmer-state
fix
attr-name
(+ initial-val
(* gradient cc-offset))))
fixtures
initial-vals
gradients))
(define* (at-midi-fader fixture-list
attr-name
cc-number
#:key
(led-incongruent #f)
(led #f))
(let ((fixtures-attrs (fixtures-with-attr fixture-list attr-name)))
(unless (null? (car fixtures-attrs))
(let* ((fixtures (car fixtures-attrs))
(attrs (cdr fixtures-attrs))
(initial-vals (current-values fixtures attr-name))
(congruent-val (fader-congruent initial-vals attrs))
(up-gradients (fader-up-gradients initial-vals attrs congruent-val))
(dn-gradients (fader-down-gradients initial-vals attrs congruent-val))
(cc-val (get-cc-value cc-number))
(congruent (and cc-val (= cc-val congruent-val))))
(if congruent
(send-note-on led)
(send-note-on led-incongruent))
(register-midi-cc-callback!
#:cc-number cc-number
#:func (lambda (prev-cc-val new-cc-value)
(if congruent
(cond
((> new-cc-value congruent-val)
(apply-fader (- new-cc-value congruent-val)
attr-name
up-gradients
initial-vals
fixtures))
((< new-cc-value congruent-val)
(apply-fader (- new-cc-value congruent-val)
attr-name
dn-gradients
initial-vals
fixtures)))
(when (or (and (not prev-cc-val)
(= new-cc-value congruent-val))
(and prev-cc-val new-cc-value
(in-range congruent-val
prev-cc-val
new-cc-value)))
(set! congruent #t)
(send-note-on led)))))))))
(define control-map
'((intensity jogwheel 21 98)
(pan jogwheel 0 124)
(tilt jogwheel 1 125)
(cyan fader 4 (120 84))
(magenta fader 5 (121 85))
(yellow fader 6 (122 86))
(cto fader 7 (123 87))
(iris fader 8 (116 80))
(zoom fader 9 (117 81))
(focus fader 10 (118 82))))
(define (midi-control-attr control-spec fixture-list)
(cond
((eq? 'jogwheel (cadr control-spec))
(at-midi-jogwheel fixture-list
(car control-spec)
(caddr control-spec)
#:led (cadddr control-spec)))
((eq? 'fader (cadr control-spec))
(at-midi-fader fixture-list
(car control-spec)
(caddr control-spec)
#:led (car (cadddr control-spec))
#:led-incongruent (cadr (cadddr control-spec))))))
;; Stuff to clear up when we're done with selected fixtures
(define midi-callbacks '())
(define (select-midi fixture-list)
(define (led-off leds)
(cond
((list? leds)
(for-each send-note-off leds))
((number? leds)
(send-note-off leds))))
(for-each remove-midi-callback! midi-callbacks)
(for-each (lambda (control-spec)
(led-off (cadddr control-spec)))
control-map)
(set! midi-callbacks '())
(unless (nil? fixture-list)
(set! midi-callbacks
(map (partial midi-control-attr fixture-list)
control-map))))
(add-hook! selection-hook select-midi)
|
