From 43e21c32d57067bce99f1263f161ad6f1330730a Mon Sep 17 00:00:00 2001 From: Thomas White Date: Thu, 31 Dec 2020 17:59:16 +0100 Subject: Manage LEDs for parameter adjustment --- guile/starlet/midi-control/faders.scm | 47 +++++++++++++++++++++++++++-------- 1 file changed, 37 insertions(+), 10 deletions(-) diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm index 67ece1b..a53262d 100644 --- a/guile/starlet/midi-control/faders.scm +++ b/guile/starlet/midi-control/faders.scm @@ -1,6 +1,7 @@ (define-module (starlet midi-control faders) #:use-module (starlet midi-control base) #:use-module (starlet base) + #:use-module (ice-9 receive) #:export (on-fader sel)) @@ -26,13 +27,17 @@ state)))) -(define (at-midi-jogwheel fix attr cc-number) +(define* (at-midi-jogwheel fix attr cc-number + #:key (led #f)) (define (ccval->offset a) (if (eq? a 127) -1 1)) + (when led + (send-note-on led)) + (let ((old-val (current-value fix attr)) (offset 0)) (register-midi-cc-callback! @@ -46,13 +51,29 @@ (define (select-fixtures fixture) - (list - (at-midi-jogwheel fixture 'intensity 21) - (at-midi-jogwheel fixture 'pan 0) - (at-midi-jogwheel fixture 'tilt 1))) - - + (values + (list 98 124 125 84 85 86 120 121 122) + (list + (at-midi-jogwheel fixture 'intensity 21 + #:led 98) + (at-midi-jogwheel fixture 'pan 0 + #:led 124) + (at-midi-jogwheel fixture 'tilt 1 + #:led 125)))) +;; (at-midi-fader fixture 'red 4 +;; #:led-incongruent 84 +;; #:led-congruent 120) +;; (at-midi-fader fixture 'green 5 +;; #:led-incongruent 85 +;; #:led-congruent 121) +;; (at-midi-fader fixture 'blue 6 +;; #:led-incongruent 86 +;; #:led-congruent 122)))) + + +;; Stuff to clear up when we're done with selected fixtures (define midi-callbacks '()) +(define midi-leds '()) (define (sel fixture) @@ -64,7 +85,13 @@ selection-state programmer-state) (clear-state! selection-state) - (for-each remove-midi-callback! midi-callbacks)) + (for-each remove-midi-callback! midi-callbacks) + (for-each send-note-off midi-leds) + (set! midi-callbacks '()) + (set! midi-leds '())) + (when fixture - (set! midi-callbacks - (select-fixtures fixture)))) + (receive (leds callbacks) + (select-fixtures fixture) + (set! midi-callbacks callbacks) + (set! midi-leds leds)))) -- cgit v1.2.3