/
ableton_push_2.clj
2984 lines (2682 loc) · 147 KB
/
ableton_push_2.clj
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
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(ns afterglow.controllers.ableton-push-2
"Allows the Ableton Push 2 to be used as a control surface for
Afterglow. Its features are described in the [online
documentation](https://github.com/brunchboy/afterglow/blob/master/doc/push2.adoc#using-ableton-push-2)."
{:author "James Elliott"}
(:require [afterglow.controllers.ableton-push :as push :refer [set-pad-velocity]]
[afterglow.controllers :as controllers]
[afterglow.controllers.tempo :as tempo]
[afterglow.effects.cues :as cues]
[afterglow.effects.dimmer :refer [master-get-level master-set-level]]
[afterglow.midi :as amidi]
[afterglow.rhythm :as rhythm]
[afterglow.show :as show]
[afterglow.show-context :refer [with-show]]
[afterglow.util :as util]
[afterglow.version :as version]
[clojure.math.numeric-tower :as math]
[com.evocomputing.colors :as colors]
[overtone.at-at :as at-at]
[overtone.midi :as midi]
[taoensso.timbre :as timbre])
(:import [afterglow.effects Effect]
[org.deepsymmetry Wayang]
[java.util Arrays]
[java.awt GraphicsEnvironment Graphics2D Font AlphaComposite RenderingHints]
[javax.sound.midi ShortMessage]))
(defonce fonts-loaded
(atom false))
(defn load-fonts
"Load and register the fonts we will use to draw on the display, if
they have not already been."
[]
(or @fonts-loaded
(let [ge (GraphicsEnvironment/getLocalGraphicsEnvironment)]
(doseq [font-file ["/public/fonts/Open_Sans_Condensed/OpenSans-CondLight.ttf"
"/public/fonts/Open_Sans_Condensed/OpenSans-CondLightItalic.ttf"
"/public/fonts/Open_Sans_Condensed/OpenSans-CondBold.ttf"
"/public/fonts/Roboto/Roboto-Medium.ttf"
"/public/fonts/Roboto/Roboto-MediumItalic.ttf"
"/public/fonts/Roboto/Roboto-Regular.ttf"
"/public/fonts/Roboto/Roboto-Bold.ttf"
"/public/fonts/Roboto/Roboto-Italic.ttf"
"/public/fonts/Roboto/Roboto-BoldItalic.ttf"
"/public/fonts/Lekton/Lekton-Regular.ttf"]]
(.registerFont ge (java.awt.Font/createFont
java.awt.Font/TRUETYPE_FONT
(.getResourceAsStream Effect font-file))))
(reset! fonts-loaded true))))
(defn get-display-font
"Find one of the fonts configured for use on the display by keyword,
which should be one of `:condensed`, `:condensed-light`, `:roboto`,
or `:roboto-medium`. The `style` argument is a `java.awt.Font` style
constant, and `size` is point size.
Roboto is available in all style variations, Roboto Medium in plain
and italic, Condensed only in bold, and condensed light in plain and
italic."
[k style size]
(case k
:condensed (Font. "Open Sans Condensed" Font/BOLD size)
:condensed-light (Font. "Open Sans Condensed Light" style size)
:monospace (Font. "Lekton" style size)
:roboto (Font. "Roboto" style size)
:roboto-medium (Font. "Roboto Medium" style size)))
(defn dim
"Return a dimmed version of a color."
[color]
(colors/darken color 35))
(def off-color
"The color of buttons that are completely off."
(colors/create-color :black))
(def amber-color
"The color for bright amber buttons."
(colors/create-color :h 45 :s 100 :l 50))
(def dim-amber-color
"The color for dim amber buttons."
(dim amber-color))
(def red-color
"The color for bright red buttons."
(colors/create-color :red))
(def dim-red-color
"The color for dim red buttons."
(dim red-color))
(def green-color
"The color for bright green buttons."
(colors/create-color :green))
(def dim-green-color
"The color for dim green buttons."
(dim green-color))
(def white-color
"The color for bright white buttons."
(colors/create-color :white))
(def dim-white-color
"The color for dim white buttons."
(colors/darken white-color 90))
(def default-track-color
"The color gauge tracks will use unless otherwise specified."
(colors/darken white-color 50))
(defn send-sysex
"Send a MIDI System Exclusive command to the Push 2 with the proper
prefix. The `command` argument begins with the Command ID of the
desired command, as listed in Table 2.4.2 of the Ableton Push 2 MIDI
and Display Interface Manual, followed by its parameter bytes. The
`SOX` byte, Ableton Sysex ID, device ID, and model ID will be
prepended, and the `EOX` byte appended, before sending the command."
[controller command]
(midi/midi-sysex (:port-out controller)
(concat [0xf0 0x00 0x21 0x1d (:device-id controller) 0x01] command [0xf7])))
(defn- request-led-palette-entry
"Ask the Push 2 for the LED palette entry with the specified index."
[controller index]
(send-sysex controller [0x04 index]))
(defn- save-led-palette-entry
"Record an LED palette entry we have received in response to our
startup query, so we can preserve the white palette when setting RGB
colors, and restore all LED palettes when we suspend or exit our
mapping.
Make a note of the fact that we received a palette response at the
current moment in time in `gather-timestamp`, and if this was not
the final palette entry, request the next one. If it was the final
one, deliver a true value to `gather-timestamp`."
[controller data gather-timestamp gather-promise]
(let [index (first data)]
(swap! (:led-palettes controller) assoc index (vec (rest data)))
(reset! gather-timestamp (at-at/now))
(if (< index 127) ; Ask for the next entry unless we have received them all
(request-led-palette-entry controller (inc index))
(deliver gather-promise true))))
(defonce ^:private ^{:doc "The currently active pad grid batch-update
function, if any. Will be called whenever we receive a display
backlight level Sysex response, which is our cue that the Push has
caught up in drawing LEDs."}
grid-batch-update-fn
(atom nil))
(defn- sysex-received
"Process a MIDI System Exclusive reply from the Push 2. The `msg`
argument is the raw data we have just received. If
`gather-timestamp` and `gather-promise` were supplied, and we see an
LED palette reply, this reply was received during startup when we
are gathering LED palette entries, so we should use them to record
any palette response. If we see a display backlight reply, it means
the Push has caught up with our batch of pad grid LED color updates,
and we can start sending the next."
([controller msg]
(sysex-received controller msg nil nil))
([controller msg gather-timestamp gather-promise]
(if (= (vec (take 5 (:data msg))) [0x00 0x21 0x1d (:device-id controller) 0x01])
(let [data (map int (butlast (drop 5 (:data msg))))
command (first data)
args (rest data)]
(case command
0x04 (if (some? gather-timestamp)
(save-led-palette-entry controller args gather-timestamp gather-promise)
(timbre/warn "Ignoring Push 2 LED palette response when not gathering palette."))
0x09 (when-let [f @grid-batch-update-fn] ; Display backlight reply; ready for next grid update batch
(f))
(timbre/warn "Ignoring SysEx message from Push 2 with command ID" command)))
(timbre/warn "Received unrecognized SysEx message from Push 2 port." (vec (:data msg))))))
(defn- gather-led-palettes
"Ask the Push 2 for all of its LED palettes. We ask for the first,
then when we receive that, ask for the next, until we have got them
all, to avoid overflowing its buffers. We will wait for up to half a
second for this process to complete. If that elapses, and it has
been more than 100ms since we sent our last request, we give up.
Return a truthy value to indicate success."
[controller]
(let [gather-timestamp (atom (at-at/now))
gather-promise (promise)
startup-handler (fn [message]
(if (= 0xf0 (:status message))
(sysex-received controller message gather-timestamp gather-promise)
(timbre/info "Ignoring non-sysex message received during Push 2 startup.")))]
(try
(amidi/add-device-mapping (:port-in controller) startup-handler)
(loop []
(request-led-palette-entry controller 0)
(or (deref gather-promise 500 false)
(if (> (- (at-at/now) @gather-timestamp) 100)
(timbre/error "Failed to gather LED Palette entries for Push 2; giving up.")
(do
(timbre/warn "Gathering LED Palette entries for Push 2 is taking more than half a second.")
(recur)))))
(finally (amidi/remove-device-mapping (:port-in controller) startup-handler)))))
(defn- restore-led-palettes
"Set the LED palettes back to the way we found them during our
initial binding. This is called when clearing the interface when
exiting user mode or deactivating the binding, so we can gracefully
coexist with Live."
[controller]
(let [sent (volatile! 0)]
(doseq [[index palette] @(:led-palettes controller)]
(send-sysex controller (concat [0x03 index] palette))
(when (zero? (rem (vswap! sent inc) 10))
(Thread/sleep 5)))))
(defn set-pad-color
"Set the color of one of the 64 touch pads to a specific RGB color.
If the color is black, we send a note off to the pad. Otherwise, we
take over the color palette entry whose velocity matches the note
number of the pad, and set it to the desired RGB value, then send it
a note with the velocity corresponding to the palette entry we just
adjusted.
Since we also have to set a white value, we pass along the white
value that was present in the palette we found for this velocity
when initially binding to the Push 2."
[controller x y color]
{:pre [(<= 0 x 7) (<= 0 y 7)]}
(let [note (+ 36 x (* y 8))
palette (get @(:led-palettes controller) note)]
(if (util/float= (colors/lightness color) 0.0)
(midi/midi-note-off (:port-out controller) note)
(let [r (colors/red color)
g (colors/green color)
b (colors/blue color)]
(send-sysex controller [0x03 note (bit-and r 0x7f) (quot r 0x80) (bit-and g 0x7f) (quot g 0x80)
(bit-and b 0x7f) (quot b 0x80) (get palette 6) (get palette 7)])
(midi/midi-note-on (:port-out controller) note note)))))
(def control-buttons
"The labeled buttons which send and respond to Control Change
events."
{:tap-tempo {:control 3 :kind :monochrome}
:metronome {:control 9 :kind :monochrome}
:master {:control 28 :kind :monochrome}
:quarter {:control 36 :kind :color :index 8}
:quarter-triplet {:control 37 :kind :color :index 9}
:eighth {:control 38 :kind :color :index 10}
:eighth-triplet {:control 39 :kind :color :index 11}
:sixteenth {:control 40 :kind :color :index 12}
:sixteenth-triplet {:control 41 :kind :color :index 13}
:thirty-second {:control 42 :kind :color :index 14}
:thirty-second-triplet {:control 43 :kind :color :index 15}
:left-arrow {:control 44 :kind :monochrome}
:right-arrow {:control 45 :kind :monochrome}
:up-arrow {:control 46 :kind :monochrome}
:down-arrow {:control 47 :kind :monochrome}
:select {:control 48 :kind :monochrome}
:shift {:control 49 :kind :monochrome}
:note {:control 50 :kind :monochrome}
:session {:control 51 :kind :monochrome}
:add-device {:control 52 :kind :monochrome}
:add-track {:control 53 :kind :monochrome}
:device-mode {:control 110 :kind :monochrome}
:browse-mode {:control 111 :kind :monochrome}
:mix-mode {:control 112 :kind :monochrome}
:clip-mode {:control 113 :kind :monochrome}
:repeat {:control 56 :kind :monochrome}
:accent {:control 57 :kind :monochrome}
:scales {:control 58 :kind :monochrome}
:layout {:control 31 :kind :monochrome}
:setup {:control 30 :kind :monochrome}
:user-mode {:control 59 :kind :monochrome}
:page-left {:control 62 :kind :monochrome}
:page-right {:control 63 :kind :monochrome}
:octave-down {:control 54 :kind :monochrome}
:octave-up {:control 55 :kind :monochrome}
:stop {:control 85 :kind :color :index 2} ; The play button, but stop for stop mode.
:record {:control 86 :kind :color :index 3 :dim-color dim-red-color :bright-color red-color}
:automate {:control 89 :kind :color :index 4}
:fixed-length {:control 90 :kind :monochrome}
:new {:control 87 :kind :monochrome}
:duplicate {:control 88 :kind :monochrome}
:quantize {:control 116 :kind :monochrome}
:double {:control 117 :kind :monochrome}
:convert {:control 35 :kind :monochrome}
:mute {:control 60 :kind :color :index 5}
:solo {:control 61 :kind :color :index 6}
:stop-clip {:control 29 :kind :color :index 7}
:delete {:control 118 :kind :monochrome}
:undo {:control 119 :kind :monochrome}
:top-pad-0 {:control 20 :kind :color}
:top-pad-1 {:control 21 :kind :color}
:top-pad-2 {:control 22 :kind :color}
:top-pad-3 {:control 23 :kind :color}
:top-pad-4 {:control 24 :kind :color}
:top-pad-5 {:control 25 :kind :color}
:top-pad-6 {:control 26 :kind :color}
:top-pad-7 {:control 27 :kind :color}
:encoder-pad-0 {:control 102 :kind :color}
:encoder-pad-1 {:control 103 :kind :color}
:encoder-pad-2 {:control 104 :kind :color}
:encoder-pad-3 {:control 105 :kind :color}
:encoder-pad-4 {:control 106 :kind :color}
:encoder-pad-5 {:control 107 :kind :color}
:encoder-pad-6 {:control 108 :kind :color}
:encoder-pad-7 {:control 109 :kind :color}})
(defn set-cc-led-color
"Set one of the color LEDs that respond to control change values to
a particular color. If the color is black, we send a control value
of zero. Otherwise, we take over the color palette entry assigned to
the LED, and set it to the desired RGB value, then send it a control
change with the velocity corresponding to the palette entry we just
adjusted.
Since we also have to set a white value, we pass along the white
value that was present in the palette we found for this entry
when initially binding to the Push 2."
[controller control palette-index color]
(let [palette (get @(:led-palettes controller) palette-index)]
(if (util/float= (colors/lightness color) 0.0)
(midi/midi-control (:port-out controller) control 0)
(let [r (colors/red color)
g (colors/green color)
b (colors/blue color)]
(send-sysex controller [0x03 palette-index (bit-and r 0x7f) (quot r 0x80) (bit-and g 0x7f) (quot g 0x80)
(bit-and b 0x7f) (quot b 0x80) (get palette 6) (get palette 7)])
(midi/midi-control (:port-out controller) control palette-index)))))
(defn set-button-color
"Set one of the labeled buttons to a particular color (if it is a
monochrome button, the lightness of the color is translated to a
control value; otherwise, the palette entry assigned to the button
is set to the specified color, and the corresponding velocity is
sent."
[controller button color]
(if (= :monochrome (:kind button))
(midi/midi-control (:port-out controller) (:control button)
(math/round (* (/ (colors/lightness color) 100) 127)))
(set-cc-led-color controller (:control button) (or (:index button) (:control button)) color)))
(defn set-top-pad-color
"Set one of the top-row pads (between the grid and the display) to a
particular color."
[controller x color]
(set-button-color controller (get control-buttons (keyword (str "top-pad-" x))) color))
(defn set-encoder-pad-color
"Set one of the pads below the row of display encoders to a
particular color."
[controller x color]
(set-button-color controller (get control-buttons (keyword (str "encoder-pad-" x))) color))
(def touch-strip-mode-flags
"The values which are combined to set the touch strip into
particular modes."
{:touch-strip-controlled-by-push 0
:touch-strip-controlled-by-host 1
:touch-strip-host-sends-values 0
:touch-strip-host-sends-sysex 2
:touch-strip-values-sent-as-pitch-bend 0
:touch-strip-values-sent-as-mod-wheel 4
:touch-strip-leds-show-bar 0
:touch-strip-leds-show-point 8
:touch-strip-bar-starts-at-bottom 0
:touch-strip-bar-starts-at-center 16
:touch-strip-auto-return-inactive 0
:touch-strip-auto-return-active 32
:touch-strip-auto-return-to-bottom 0
:touch-strip-auto-return-to-center 64})
(defn build-touch-strip-mode
"Calculate a touch strip mode byte based on a list of flags (keys in
`touch-strip-mode-flags`)."
[& flags]
(apply + (map touch-strip-mode-flags (set flags))))
(def touch-strip-mode-default
"The mode to which we should return the touch strip when we are
shutting down."
(build-touch-strip-mode :touch-strip-controlled-by-push :touch-strip-host-sends-values
:touch-strip-values-sent-as-pitch-bend :touch-strip-leds-show-point
:touch-strip-bar-starts-at-bottom :touch-strip-auto-return-active
:touch-strip-auto-return-to-center))
(def touch-strip-mode-level
"The mode to which we should set the touch strip when the user is
editing a pan-style control."
(build-touch-strip-mode :touch-strip-controlled-by-host :touch-strip-host-sends-values
:touch-strip-values-sent-as-pitch-bend :touch-strip-leds-show-bar
:touch-strip-bar-starts-at-bottom :touch-strip-auto-return-inactive
:touch-strip-auto-return-to-center))
(def touch-strip-mode-pan
"The mode to which we should set the touch strip when the user is
editing a level-style control."
(build-touch-strip-mode :touch-strip-controlled-by-host :touch-strip-host-sends-values
:touch-strip-values-sent-as-pitch-bend :touch-strip-leds-show-bar
:touch-strip-bar-starts-at-center :touch-strip-auto-return-inactive
:touch-strip-auto-return-to-center))
(def touch-strip-mode-hue
"The mode to which we should set the touch strip when the user is
editing a hue."
(build-touch-strip-mode :touch-strip-controlled-by-host :touch-strip-host-sends-values
:touch-strip-values-sent-as-pitch-bend :touch-strip-leds-show-point
:touch-strip-bar-starts-at-bottom :touch-strip-auto-return-inactive
:touch-strip-auto-return-to-center))
(def touch-strip-mode-sysex
"The mode to which we should set the touch strip when we want to be
able to individually set LEDs, for example to turn them all off."
(build-touch-strip-mode :touch-strip-controlled-by-host :touch-strip-host-sends-sysex
:touch-strip-auto-return-inactive :touch-strip-auto-return-to-center))
(defn clear-all-touch-strip-leds
"Send a System Exclusive message which requests all touch strip LEDs
be turned off."
[controller]
(send-sysex controller (concat [0x19] (repeat 16 0))))
(defn- clear-display-buffer
"Clear the graphical display buffer in preparation for drawing an
interface frame."
[controller]
(let [graphics (.createGraphics (:display-buffer controller))]
(.setPaint graphics java.awt.Color/BLACK)
(.fillRect graphics 0 0 Wayang/DISPLAY_WIDTH Wayang/DISPLAY_HEIGHT)))
(defn clear-display
"Clear the graphical display."
[controller]
(clear-display-buffer controller)
(Wayang/sendFrame))
(defn create-graphics
"Create the graphics object we will use to draw in the display, and
configure its rendering hints properly."
[controller]
(let [graphics (.createGraphics (:display-buffer controller))]
(.setRenderingHint graphics RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)
graphics))
(defn show-labels
"Illuminates all buttons with text labels, for development assistance."
([controller]
(show-labels controller (colors/create-color :white)))
([controller color]
(doseq [[_ button] control-buttons]
(set-button-color controller button color))))
(defn- update-top-pads
"Sees if any of the top row of pads have changed state since
the interface was updated, and if so, sends the necessary MIDI
messages to update them on the Push."
[controller]
(doseq [x (range 8)]
(let [next-color (get @(:next-top-pads controller) x)]
(when (not= next-color
(get @(:last-top-pads controller) x))
(set-top-pad-color controller x next-color)
(swap! (:last-top-pads controller) assoc x next-color)))))
(defn set-touch-strip-mode
"Set the touch strip operating mode."
[controller mode]
(send-sysex controller [0x17 mode]))
(defn- update-touch-strip
"Sees if the state of the touch strip has changed since the
interface was updated, and if so, sends the necessary MIDI control
values to update it on the Push."
[controller]
(let [next-strip @(:next-touch-strip controller)
[_ last-mode] @(:last-touch-strip controller)]
(when (not= next-strip @(:last-touch-strip controller))
(if next-strip
(let [[value mode] next-strip
message (ShortMessage.)]
(when (not= mode last-mode)
(set-touch-strip-mode controller mode)
(if (= mode touch-strip-mode-sysex) ; We want the touch strip fully dark
(clear-all-touch-strip-leds controller)))
(when (not= mode touch-strip-mode-sysex) ; We are actually displaying values
(.setMessage message ShortMessage/PITCH_BEND 0 (rem value 128) (quot value 128))
(midi/midi-send-msg (get-in controller [:port-out :receiver]) message -1))
(reset! (:last-touch-strip controller) next-strip))
(do
(set-touch-strip-mode controller touch-strip-mode-default)
(reset! (:last-touch-strip controller) nil))))))
(defn- set-touch-strip-from-value
"Display a value being adjusted in the touch strip."
[controller value low high mode]
(let [full-range (- high low)]
(reset! (:next-touch-strip controller) [(math/round (* 16383 (/ (- value low) full-range))) mode])))
(defn- set-touch-strip-from-cue-var
"Display the value of a cue variable being adjusted in the touch
strip."
[controller cue v effect-id]
(let [value (or (cues/get-cue-variable cue v :show (:show controller) :when-id effect-id) 0)
low (min value (:min v)) ; In case user set "out of bounds".
high (max value (:max v))]
(set-touch-strip-from-value controller value low high
(if (:centered v) touch-strip-mode-pan touch-strip-mode-level))))
(defn- value-from-touch-strip
"Convert a pitch bend message from the touch strip to the
corresponding variable value it represents."
[message low high]
(let [full-range (- high low)]
(+ low (* full-range (double (/ (+ (* (:data2 message) 128) (:data1 message)) 16383))))))
(defn- update-text-buttons
"Sees if any labeled buttons have changed state since the last time
the interface was updated, and if so, sends the necessary MIDI
commands to update them on the Push."
[controller]
;; First turn off any which were on before but no longer are
(doseq [[button old-color] @(:last-text-buttons controller)]
(when-not (get @(:next-text-buttons controller) button)
(when-not (= off-color old-color)
(set-button-color controller button off-color))))
;; Then, set any currently requested states
(doseq [[button color] @(:next-text-buttons controller)]
(when-not (= (get @(:last-text-buttons controller) button) color)
(set-button-color controller button color)))
;; And record the new state for next time
(reset! (:last-text-buttons controller) @(:next-text-buttons controller)))
(def button-cell-width
"The number of pixels allocated to each button above or below the
graphical display."
(/ Wayang/DISPLAY_WIDTH 8))
(def button-cell-margin
"The number of pixels to keep blank between labels of adjacent buttons."
4)
(defn string-width
"Determines how many pixels wide a string will be in a given font
and render context."
[text font render-context]
(.getWidth (.getStringBounds font text render-context)))
(defn fit-string
"Truncates a string (appending an ellipsis) enough to fit within a
given pixel width."
[text font render-context max-width]
(if (or (clojure.string/blank? text) (<= (string-width text font render-context) max-width))
text
(loop [truncated (subs text 0 (dec (count text)))]
(let [result (str truncated "…")]
(if (or (clojure.string/blank? truncated) (<= (string-width result font render-context) max-width))
result
(recur (subs truncated 0 (dec (count truncated)))))))))
(defn set-graphics-color
"Set the paint of the supplied graphics context to use the specified
color."
[graphics color]
(.setPaint graphics (java.awt.Color. (colors/red color) (colors/green color) (colors/blue color)
(colors/alpha color))))
(defn calculate-text-width
"Figure out how many pixels wide some text will be in a given font."
[graphics font text]
(let [context (.getFontRenderContext graphics)]
(.getWidth (.getStringBounds font text context))))
(defn draw-bottom-button-label
"Draw a label for a button below the graphical display."
[controller index text color & {:keys [background-color] :or {background-color off-color}}]
(let [graphics (create-graphics controller)
font (get-display-font :roboto-medium Font/BOLD 14)
context (.getFontRenderContext graphics)
label (fit-string text font context (- button-cell-width button-cell-margin))
width (string-width label font context)]
(set-graphics-color graphics background-color)
(.fillRect graphics (* index button-cell-width) (- Wayang/DISPLAY_HEIGHT 15)
button-cell-width 15)
(set-graphics-color graphics color)
(.setFont graphics font)
(.drawString graphics label (int (math/round (- (* (+ index 0.5) button-cell-width) (/ width 2))))
(- Wayang/DISPLAY_HEIGHT 4))))
(defn- space-for-encoder-button-label
"Calculate how much room there is to draw a label under an encoder,
based on how many encoders the label applies to."
[encoder-count]
(- (* button-cell-width encoder-count) button-cell-margin))
(def font-for-encoder-button-label
"The font used when drawing labels under encoders."
(get-display-font :condensed Font/PLAIN 14))
(def encoder-label-underline-height
"The height at which to draw the line under an encoder label."
20.0)
(defn draw-encoder-button-label
"Draw a label under an encoder at the top of the graphical display."
[controller index encoder-count text color]
(let [graphics (create-graphics controller)
space (space-for-encoder-button-label encoder-count)
context (.getFontRenderContext graphics)
label (fit-string text font-for-encoder-button-label context space)
width (string-width label font-for-encoder-button-label context)]
(set-graphics-color graphics color)
(.setFont graphics font-for-encoder-button-label)
(.drawString graphics label
(int (math/round (- (* (+ index (/ encoder-count 2)) button-cell-width) (/ width 2)))) 16)
(.draw graphics (java.awt.geom.Line2D$Double.
(+ (* index button-cell-width) (/ button-cell-margin 2.0)) encoder-label-underline-height
(- (* (+ index encoder-count) button-cell-width) (/ button-cell-margin 2.0) 1.0)
encoder-label-underline-height))))
(def font-for-cue-variable-values
"The font used when drawing cue variable values."
(get-display-font :condensed-light Font/PLAIN 22))
(def font-for-cue-variable-emphasis
"The font used when drawing cue variable values."
(get-display-font :condensed Font/PLAIN 22))
(defn draw-attributed-variable-value
"Draw a label under an encoder at the top of the graphical display,
with an attributed string so the label can have mixed fonts, colors,
etc. Assumes the value will fit in the allocated space."
[controller index encoder-count attributed-string color]
(let [graphics (create-graphics controller)
space (space-for-encoder-button-label encoder-count)
context (.getFontRenderContext graphics)
iterator (.getIterator attributed-string)
measurer (java.awt.font.LineBreakMeasurer. iterator context)
layout (.nextLayout measurer Integer/MAX_VALUE)
width (.getWidth (.getBounds layout))]
;; Establish a default color for characters that don't change it
(set-graphics-color graphics color)
(.drawString graphics iterator
(int (math/round (- (* (+ index (/ encoder-count 2)) button-cell-width) (/ width 2)))) 40)))
(defn draw-cue-variable-value
"Draw a label under an encoder at the top of the graphical display."
([controller index encoder-count text color]
(draw-cue-variable-value controller index encoder-count text color font-for-cue-variable-values))
([controller index encoder-count text color font]
(if (= (class text) java.text.AttributedString)
(draw-attributed-variable-value controller index encoder-count text color)
(let [graphics (create-graphics controller)
space (space-for-encoder-button-label encoder-count)
context (.getFontRenderContext graphics)
label (fit-string text font context space)
width (string-width label font context)]
(set-graphics-color graphics color)
(.setFont graphics font)
(.drawString graphics label
(int (math/round (- (* (+ index (/ encoder-count 2)) button-cell-width) (/ width 2)))) 40)))))
(defn draw-null-gauge
"Draw a mostly meaningless gauge simply to indicate that the encoder
is doing something. Used for beat adjustments, for example, which
have no reasonable range or location to show."
[controller index encoder-count color]
(let [graphics (create-graphics controller)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))]
(set-graphics-color graphics color)
(.draw graphics (java.awt.geom.Ellipse2D$Double. (- x-center 20.0) 50.0 40.0 40.0))))
(defn draw-gauge
"Draw a graphical gauge with an indicator that fills an arc under a
variable value. The default range is from zero to a hundred, and the
default color for both the track and active area is dim white."
[controller index encoder-count value & {:keys [lowest highest track-color active-color]
:or {lowest 0 highest 100
track-color default-track-color active-color track-color}}]
(let [graphics (create-graphics controller)
range (- highest lowest)
fraction (/ (- value lowest) range)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. (- x-center 20.0) 50.0 40.0 40.0 240.0 -300.0 java.awt.geom.Arc2D/OPEN)]
(set-graphics-color graphics track-color)
(.draw graphics arc)
(.setStroke graphics (java.awt.BasicStroke. 5.0 java.awt.BasicStroke/CAP_ROUND java.awt.BasicStroke/JOIN_ROUND))
(set-graphics-color graphics active-color)
(.setAngleExtent arc (* -300.0 fraction))
(.draw graphics arc)))
(defn draw-pan-gauge
"Draw a graphical gauge with an indicator that extends from the top
center of an arc under a variable value. The default range is from
zero to a hundred, and the default color for both the track and
active area is dim white."
[controller index encoder-count value & {:keys [lowest highest track-color active-color]
:or {lowest 0 highest 100
track-color default-track-color active-color track-color}}]
(let [graphics (create-graphics controller)
range (- highest lowest)
fraction (/ (- value lowest) range)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. (- x-center 20.0) 50.0 40.0 40.0 240.0 -300.0 java.awt.geom.Arc2D/OPEN)]
(set-graphics-color graphics track-color)
(.draw graphics arc)
(.setStroke graphics (java.awt.BasicStroke. 5.0 java.awt.BasicStroke/CAP_ROUND java.awt.BasicStroke/JOIN_ROUND))
(set-graphics-color graphics active-color)
(.setAngleStart arc 90.0)
(.setAngleExtent arc (+ 150 (* -300.0 fraction)))
(.draw graphics arc)))
(defn draw-boolean-gauge
"Draw a graphical gauge with an indicator that covers the left or
right half of an arc under a variable value, depending on if the
value is true or false. The default color for the track is dim
white. The color for the current value area is either red (for no)
or green (for yes), and is dimmed when `:active?` is false. To
support animating state changes, a `:fraction` parameter can be
supplied which specifies how far from the opposite state the
indicator should be drawn."
[controller index encoder-count value & {:keys [track-color active? fraction]
:or {track-color default-track-color fraction 1.0}}]
(let [graphics (create-graphics controller)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. (- x-center 20.0) 50.0 40.0 40.0 240.0 -300.0 java.awt.geom.Arc2D/OPEN)]
(set-graphics-color graphics track-color)
(.draw graphics arc)
(.setStroke graphics (java.awt.BasicStroke. 5.0 java.awt.BasicStroke/CAP_ROUND java.awt.BasicStroke/JOIN_ROUND))
(set-graphics-color graphics (if active?
(if value green-color red-color)
(if value dim-green-color dim-red-color)))
(.setAngleStart arc (if value
(+ 90.0 (* (- 1.0 fraction) 150))
(- 240.0 (* (- 1.0 fraction) 150))))
(.setAngleExtent arc -150.0)
(.draw graphics arc)))
(defn draw-circular-gauge
"Draw a graphical gauge with an indicator that rides around an
circle (starting at the bottom) under a variable value. The default
range is from 0 to 360 (for hues), and the default color for both
the track and active area is dim white."
[controller index encoder-count value & {:keys [lowest highest track-color active-color]
:or {lowest 0 highest 360
track-color default-track-color active-color track-color}}]
(let [graphics (create-graphics controller)
range (- highest lowest)
fraction (/ (- value lowest) range)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. (- x-center 20.0) 50.0 40.0 40.0 240.0 -300.0 java.awt.geom.Arc2D/OPEN)]
(set-graphics-color graphics track-color)
(.draw graphics (java.awt.geom.Ellipse2D$Double. (- x-center 20.0) 50.0 40.0 40.0))
(.setStroke graphics (java.awt.BasicStroke. 6.0 java.awt.BasicStroke/CAP_ROUND java.awt.BasicStroke/JOIN_ROUND))
(set-graphics-color graphics active-color)
(.setAngleStart arc (+ 270.0 (* -300.0 fraction)))
(.setAngleExtent arc 0.0)
(.draw graphics arc)))
(defonce ^:private
^{:doc "The circle of hues around which a hue gauge indicator
rolls. This is a constant image regardless of the current hue,
so we can draw it once and reuse it."}
hue-track
(let [gauge-image (java.awt.image.BufferedImage. 50 50 java.awt.image.BufferedImage/TYPE_INT_ARGB)
gauge-graphics (.createGraphics gauge-image)
mask-image (java.awt.image.BufferedImage. 50 50 java.awt.image.BufferedImage/TYPE_INT_ARGB)
mask-graphics (.createGraphics mask-image)
arc (java.awt.geom.Arc2D$Double. 5.0 5.0 40.0 40.0 270.0 -5.0 java.awt.geom.Arc2D/OPEN)]
;; Color "outside the lines" that we will be masking so the mask can smoothe the edges
(.setStroke gauge-graphics (java.awt.BasicStroke. 5.0 java.awt.BasicStroke/CAP_ROUND
java.awt.BasicStroke/JOIN_ROUND))
(dotimes [i 72] ; Draw the circle of hues
(.setAngleStart arc (- 270.0 (* i 5)))
(set-graphics-color gauge-graphics (colors/create-color :h (* i 5) :s 100.0 :l 50.0))
(.draw gauge-graphics arc))
;; Draw a mask we can use to soft clip the color hue track. Start by clearing it so all pixels have zero alpha.
(.setComposite mask-graphics java.awt.AlphaComposite/Clear)
(.fillRect mask-graphics 0 0 50 50)
;; Render the gauge track mask, an anti-aliased circle
(.setComposite mask-graphics java.awt.AlphaComposite/Src)
(.setRenderingHint mask-graphics java.awt.RenderingHints/KEY_ANTIALIASING
java.awt.RenderingHints/VALUE_ANTIALIAS_ON)
(.setColor mask-graphics java.awt.Color/WHITE)
(.draw mask-graphics (java.awt.geom.Ellipse2D$Double. 5.0 5.0 40.0 40.0))
;; Render the track into the mask using SrcAtop, which effectively uses the alpha value as
;; a coverage value for each pixel stored in the destination. For the areas outside our clip
;; shape, the destination alpha will be zero, so nothing is rendered in those areas. For the
;; areas inside our clip shape, the destination alpha will be fully opaque, so the full color
;; is rendered. At the edges, the original antialiasing is carried over to give us the desired
;; soft clipping effect.
(.setComposite mask-graphics java.awt.AlphaComposite/SrcAtop)
(.drawImage mask-graphics gauge-image 0 0 nil)
mask-image)) ; Return the masked track image
(defn draw-hue-gauge
"Draw a graphical gauge whose colors are the hues of the color
circle, with an indicator that rides around an circle (starting at
the bottom) under a variable value."
[controller index encoder-count value active?]
(let [graphics (create-graphics controller)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. (- x-center 20.0) 50.0 40.0 40.0 (- 270.0 value) 0.0 java.awt.geom.Arc2D/OPEN)]
;; Draw the precomputed hue track image
(.drawImage graphics hue-track (math/round (- x-center 25)) 45 nil)
;; Then draw the larger knob at the current hue value
(.setStroke graphics (java.awt.BasicStroke. 6.0 java.awt.BasicStroke/CAP_ROUND java.awt.BasicStroke/JOIN_ROUND))
(if active?
(set-graphics-color graphics (colors/create-color :h value :s 100.0 :l 50.0))
(set-graphics-color graphics (colors/create-color :h value :s 100.0 :l 25.0)))
(.draw graphics arc)))
(defn draw-saturation-gauge
"Draw a graphical gauge whose colors are the saturation levels of
the specified hue circle, with an indicator like that of a level
gauge, under a variable value."
[controller index encoder-count hue value active?]
(let [graphics (create-graphics controller)
gauge-image (java.awt.image.BufferedImage. 50 50 java.awt.image.BufferedImage/TYPE_INT_ARGB)
gauge-graphics (.createGraphics gauge-image)
mask-image (java.awt.image.BufferedImage. 50 50 java.awt.image.BufferedImage/TYPE_INT_ARGB)
mask-graphics (.createGraphics mask-image)
x-center (+ (* index button-cell-width) (* encoder-count 0.5 button-cell-width))
arc (java.awt.geom.Arc2D$Double. 5.0 5.0 40.0 40.0 240.0 -3.0 java.awt.geom.Arc2D/OPEN)]
;; Color "outside the lines" that we will be masking so the mask can smoothe the edges
(.setStroke gauge-graphics (java.awt.BasicStroke. 3.0 java.awt.BasicStroke/CAP_ROUND
java.awt.BasicStroke/JOIN_ROUND))
(dotimes [i 100] ; Draw the saturation track
(.setAngleStart arc (- 240.0 (* i 3)))
(set-graphics-color gauge-graphics (colors/create-color :h hue :s i :l 50.0))
(.draw gauge-graphics arc))
;; Then draw the wider section representing the current saturation
(.setStroke gauge-graphics (java.awt.BasicStroke. 8.0 java.awt.BasicStroke/CAP_ROUND
java.awt.BasicStroke/JOIN_ROUND))
(dotimes [i (max (math/round value) 1)]
(if active?
(set-graphics-color gauge-graphics (colors/create-color :h hue :s i :l 50.0))
(set-graphics-color gauge-graphics (colors/create-color :h hue :s i :l 25.0)))
(.setAngleStart arc (- 240.0 (* i 3)))
(.draw gauge-graphics arc))
;; Draw a mask we can use to soft clip the saturation gauge. Start by clearing it so all pixels have zero alpha.
(.setComposite mask-graphics java.awt.AlphaComposite/Clear)
(.fillRect mask-graphics 0 0 50 50)
;; Render the gauge track mask, an anti-aliased arc
(.setComposite mask-graphics java.awt.AlphaComposite/Src)
(.setRenderingHint mask-graphics java.awt.RenderingHints/KEY_ANTIALIASING
java.awt.RenderingHints/VALUE_ANTIALIAS_ON)
(.setColor mask-graphics java.awt.Color/WHITE)
(.setAngleStart arc 240.0)
(.setAngleExtent arc -300.0)
(.draw mask-graphics arc)
;; Render the gauge current saturation section, a wider anti-aliased arc
(.setStroke mask-graphics (java.awt.BasicStroke. 5.0 java.awt.BasicStroke/CAP_ROUND
java.awt.BasicStroke/JOIN_ROUND))
(.setAngleExtent arc (* -3.0 value))
(.draw mask-graphics arc)
;; Render the gauge into the mask using SrcAtop, which effectively uses the alpha value as
;; a coverage value for each pixel stored in the destination. For the areas outside our clip
;; shape, the destination alpha will be zero, so nothing is rendered in those areas. For the
;; areas inside our clip shape, the destination alpha will be fully opaque, so the full color
;; is rendered. At the edges, the original antialiasing is carried over to give us the desired
;; soft clipping effect.
(.setComposite mask-graphics java.awt.AlphaComposite/SrcAtop)
(.drawImage mask-graphics gauge-image 0 0 nil)
;; Finally, draw the soft-masked gauge onto the controller display image
(.drawImage graphics mask-image (math/round (- x-center 25)) 45 nil)))
(defn- metronome-sync-label
"Determine the sync type label to display under the BPM section."
[controller]
(with-show (:show controller)
(case (:type (show/sync-status))
:manual "Manual"
:midi "MIDI"
:dj-link "DJ Link"
:traktor-beat-phase "Traktor"
"Unknown")))
(defn- metronome-sync-color
"Determine the color to light the sync pad under the BPM section."
[controller]
(with-show (:show controller)
(if (= (:type (show/sync-status)) :manual)
amber-color
(if (:current (show/sync-status))
green-color
red-color))))
(defn- update-mode!
"Turn a controller mode on or off, identified by the associated
control button number or keyword."
[controller button state]
(let [button (if (keyword? button) (get-in control-buttons [button :control]) button)]
(swap! (:modes controller) #(if state (conj % button) (disj % button)))))
(defn in-mode?
"Check whether the controller is in a particular mode, identified by
a control button number or keyword."
[controller button]
(let [button (if (keyword? button) (get-in control-buttons [button :control]) button)]
(get @(:modes controller) button)))
(def metronome-background
"The background for the metronome section, to mark it as such."
(colors/darken (colors/desaturate (colors/create-color :blue) 55) 45))
(def metronome-content
"The color for content in the metronome section, to mark it as such."
(colors/desaturate (colors/create-color :aqua) 30))
(def font-for-metronome-values
"The font used when drawing metronome values."
(get-display-font :monospace Font/PLAIN 22))
(defn- bpm-adjusting-interface
"Brighten the section of the BPM that is being adjusted, and draw
the gauge in a brighter color, or indicate that it is being synced
and can't be adjusted."
[controller snapshot]
(if (= (:type (show/sync-status)) :manual)
(let [graphics (create-graphics controller)
bpm (double (:bpm snapshot))
bpm-string (format "%.1f" bpm)
label (java.text.AttributedString. bpm-string)]
(set-graphics-color graphics metronome-background)
(.fillRect graphics button-cell-width 21 button-cell-width 20)
(.addAttribute label java.awt.font.TextAttribute/FONT font-for-metronome-values)
(if (in-mode? controller :shift)
(.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
0 (- (count bpm-string) 2))
(.addAttribute label java.awt.font.TextAttribute/FOREGROUND (java.awt.Color/WHITE)
(dec (count bpm-string)) (count bpm-string)))
(draw-attributed-variable-value controller 1 1 label metronome-content)
(draw-gauge controller 1 1 bpm :lowest controllers/minimum-bpm :highest controllers/maximum-bpm
:track-color metronome-content :active-color white-color)
(set-touch-strip-from-value controller bpm controllers/minimum-bpm controllers/maximum-bpm
touch-strip-mode-level))
;; Display the sync mode in red to explain why we are not adjusting it.
(let [graphics (create-graphics controller)]
(draw-bottom-button-label controller 1 (metronome-sync-label controller) red-color
:background-color metronome-background))))
(defn sign-velocity
"Convert a midi velocity to its signed equivalent, to translate
encoder rotations, which are twos-complement seven bit numbers."
[val]
(if (>= val 64)
(- val 128)
val))
(defn- adjust-bpm-from-encoder
"Adjust the current BPM based on how the encoder was twisted, unless
the metronome is synced."
[controller message]
(with-show (:show controller)
(when (= (:type (show/sync-status)) :manual)
(let [scale (if (in-mode? controller :shift) 1 10)
delta (/ (sign-velocity (:velocity message)) scale)
bpm (rhythm/metro-bpm (:metronome (:show controller)))]
(rhythm/metro-bpm (:metronome (:show controller)) (min controllers/maximum-bpm
(max controllers/minimum-bpm (+ bpm delta))))))))