aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@bitwiz.me.uk>2021-01-19 20:38:29 +0100
committerThomas White <taw@bitwiz.me.uk>2021-01-19 21:07:31 +0100
commita7575b80bdd9ae5059e1c92ebc7d9b8ec452d3eb (patch)
treeb74d2187b5857939f948773be91a482539a5afd1
parente0aac152ffca8ae437b9968849fe258bff11adf9 (diff)
Implement selection of multiple fixtures at once
-rw-r--r--guile/starlet/base.scm2
-rw-r--r--guile/starlet/midi-control/faders.scm241
2 files changed, 152 insertions, 91 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 8673be3..ddefcdf 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -42,6 +42,8 @@
intensity?
state-find
get-attr-type
+ get-attr-range
+ find-attr
fixture?
fixture-attribute?
programmer-state
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 <midi-control-spec>
- (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))))