From a7575b80bdd9ae5059e1c92ebc7d9b8ec452d3eb Mon Sep 17 00:00:00 2001 From: Thomas White Date: Tue, 19 Jan 2021 20:38:29 +0100 Subject: Implement selection of multiple fixtures at once --- guile/starlet/midi-control/faders.scm | 241 +++++++++++++++++++++------------- 1 file changed, 150 insertions(+), 91 deletions(-) (limited to 'guile/starlet/midi-control/faders.scm') diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm index 1c321aa..912d9f7 100644 --- a/guile/starlet/midi-control/faders.scm +++ b/guile/starlet/midi-control/faders.scm @@ -30,7 +30,18 @@ state)))) -(define* (at-midi-jogwheel fix attr cc-number +(define (current-values fixture-list attr-name) + (map (lambda (fix) + (current-value fix attr-name)) + fixture-list)) + + +(define (fixtures-with-attr fixture-list attr-name) + (filter (lambda (fix) (find-attr fix attr-name)) + fixture-list)) + + +(define* (at-midi-jogwheel fixture-list attr cc-number #:key (led #f)) (define (ccval->offset a) @@ -38,19 +49,24 @@ -1 1)) - (when led - (send-note-on led)) + (let ((fixtures (fixtures-with-attr fixture-list attr))) + (unless (null? fixtures) + + (when led + (send-note-on led)) - (let ((old-val (current-value fix 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))) - (set-attr! programmer-state - fix - attr - (+ old-val offset)))))) + (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-attr! programmer-state + fix + attr + (+ old-val offset))) + fixtures old-vals))))))) (define (in-range a val1 val2) @@ -61,100 +77,144 @@ (<= a val1)))) -(define* (at-midi-fader fix - attr - cc-number - #:key - (led-incongruent #f) - (led #f)) +;; Returns a pair of (low . high), which are the amount of fader +;; space required in the downward and upward directions respectively +(define (fader-space fixtures attr-name) - (let* ((congruent-val (percent->ccval (current-value fix attr))) + (define (attr-max-value attr) + (cadr (get-attr-range attr))) - (cc-val (get-cc-value cc-number)) - (congruent (and cc-val - (= cc-val congruent-val)))) + (define (attr-min-value attr) + (car (get-attr-range attr))) - (if congruent - (send-note-on led) - (send-note-on led-incongruent)) + (define (distance-above-min fix attr) + (- (current-value fix (get-attr-name attr)) + (attr-min-value attr))) - (register-midi-cc-callback! - #:cc-number cc-number - #:func (lambda (prev-cc-val new-cc-value) + (define (distance-below-max fix attr) + (- (attr-max-value attr) + (current-value fix (get-attr-name attr)))) - (when congruent - (set-attr! programmer-state - fix - attr - (ccval->percent new-cc-value))) + (fold (lambda (fix prev) + (let ((attr (find-attr fix attr-name))) + (cons (max (distance-above-min fix attr) + (car prev)) + (max (distance-below-max fix attr) + (cdr prev))))) + (cons 0 0) + 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 space-down car) +(define space-up cdr) -(define-record-type - (make-midi-control-spec attr-name - type - cc-number - leds) - midi-control-spec? - (attr-name attr-name) - (type type) - (cc-number cc-number) - (leds leds)) +(define (space-span r) + (+ (space-down r) + (space-up r))) +(define (fader-space->congruence r) + (inexact->exact + (round + (* 127 (/ (space-down r) + (space-span r)))))) -(define control-map - (list - (make-midi-control-spec 'intensity 'jogwheel 21 98) - (make-midi-control-spec 'pan 'jogwheel 0 124) - (make-midi-control-spec 'tilt 'jogwheel 1 125) - (make-midi-control-spec 'r 'fader 4 '(120 84)) - (make-midi-control-spec 'g 'fader 5 '(121 85)) - (make-midi-control-spec 'b 'fader 6 '(122 86)))) +(define (range-scale cspace) + (/ (+ (space-up cspace) + (space-down cspace)) + 127)) -(define (find-control-spec control-map needle) - (find (lambda (a) - (eq? (attr-name a) needle)) - control-map)) +(define (conv-fader orig-cc + new-cc + initial-val + control-space) + (+ initial-val + (* (range-scale control-space) + (- new-cc orig-cc)))) -(define (midi-control-attr fixture attr-name) - (let ((control-spec (find-control-spec - control-map - attr-name))) - (cond - ((not control-spec) #f) ;; Fixture does not have this attribute - - ((eq? (type control-spec) 'jogwheel) - (at-midi-jogwheel fixture +(define* (at-midi-fader fixture-list attr-name - (cc-number control-spec) - #:led (leds control-spec))) + cc-number + #:key + (led-incongruent #f) + (led #f)) - ((eq? (type control-spec) 'fader) - (at-midi-fader fixture - attr-name - (cc-number control-spec) - #:led (car (leds control-spec)) - #:led-incongruent (cadr (leds control-spec))))))) + (let ((fixtures (fixtures-with-attr fixture-list attr-name))) + (unless (null? fixtures) + (let* ((control-space (fader-space fixtures attr-name)) + (congruent-val (fader-space->congruence control-space)) + (cc-val (get-cc-value cc-number)) + (congruent (and cc-val (= cc-val congruent-val))) + (initial-vals (current-values fixture-list attr-name))) + + (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) + + (when congruent + (for-each (lambda (fix initial-val) + (set-attr! programmer-state + fix + attr-name + (conv-fader congruent-val + new-cc-value + initial-val + control-space))) + fixture-list + initial-vals)) + + + (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 (sel fixture) - - (define (merge-rule-replace attr a b) b) +(define (sel . fixture-list) (define (led-off leds) (cond @@ -163,18 +223,17 @@ ((number? leds) (send-note-off leds)))) - (for-each remove-midi-callback! midi-callbacks) (for-each (lambda (control-spec) - (led-off (leds control-spec))) + (led-off (cadddr control-spec))) control-map) (set! midi-callbacks '()) - (when fixture + (when (car fixture-list) (set! midi-callbacks - (map (lambda (attr) - (midi-control-attr fixture - (get-attr-name attr))) - (get-attributes fixture))))) + (map (lambda (control-spec) + (midi-control-attr control-spec + fixture-list)) + control-map)))) -- cgit v1.2.3