From e0d13cfbc4878e17e946f62b550abe27aaf01aa8 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@bitwiz.me.uk>
Date: Sat, 2 Jan 2021 18:33:15 +0100
Subject: Implement at-midi-fader

get-cc-value now returns #f if the position of the fader is unknown.
Some other changes were needed to accommodate that.
---
 guile/starlet/midi-control/base.scm   | 17 ++++---
 guile/starlet/midi-control/faders.scm | 84 +++++++++++++++++++++++++++--------
 2 files changed, 75 insertions(+), 26 deletions(-)

diff --git a/guile/starlet/midi-control/base.scm b/guile/starlet/midi-control/base.scm
index fece2be..10bc286 100644
--- a/guile/starlet/midi-control/base.scm
+++ b/guile/starlet/midi-control/base.scm
@@ -6,7 +6,8 @@
   #:use-module (srfi srfi-1)
   #:export (start-midi-control
             get-cc-value
-            scale-127-100
+            ccval->percent
+            percent->ccval
             send-note-on
             send-note-off
             register-midi-note-callback!
@@ -132,15 +133,13 @@
 
 
 (define* (get-cc-value cc-number
-                       #:key (channel #f)
-                       (unknown-val 0))
+                       #:key (channel #f))
   (let ((cc-arrays (atomic-box-ref cc-arrays)))
     (let ((ccs (assq-ref cc-arrays
                          (if channel channel default-channel))))
       (if ccs
-          (let ((val (vector-ref ccs cc-number)))
-            (if val val unknown-val))
-          unknown-val))))
+          (vector-ref ccs cc-number)
+          #f))))
 
 
 (define (check-note-callbacks channel note-number)
@@ -152,10 +151,14 @@
                     (atomic-box-ref callback-list))))
 
 
-(define (scale-127-100 n)
+(define (ccval->percent n)
   (/ (* n 100) 127))
 
 
+(define (percent->ccval n)
+  (inexact->exact (round (/ (* n 127) 100))))
+
+
 (define default-channel 0)
 
 (define* (start-midi-control device-name
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index a53262d..dde2760 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -12,17 +12,18 @@
    (lighting-state
     (state-for-each
      (lambda (fix attr val)
-       (if (intensity? attr)
+           (if (intensity? attr)
 
-           ;; Intensity parameters get scaled according to the fader
-           (at fix attr (lambda (time)
-                          (* 0.01
-                             val
-                             (scale-127-100 (get-cc-value cc-number
-                                                          #:channel channel)))))
+               ;; Intensity parameters get scaled according to the fader
+               (at fix attr (lambda (time)
+                              (let ((cc-val (get-cc-value cc-number
+                                                          #:channel channel)))
+                                (if cc-val
+                                  (* 0.01 val (ccval->percent cc-val))
+                                  0))))
 
-           ;; Non-intensity parameters just get set in our new state
-           (at fix attr val)))
+               ;; Non-intensity parameters just get set in our new state
+               (at fix attr val)))
 
      state))))
 
@@ -50,6 +51,51 @@
                          (+ old-val offset))))))
 
 
+(define (in-range a val1 val2)
+  (or
+   (and (>= a val1)
+        (<= a val2))
+   (and (>= a val2)
+        (<= a val1))))
+
+
+(define* (at-midi-fader fix
+                        attr
+                        cc-number
+                        #:key
+                        (led-incongruent #f)
+                        (led #f))
+
+  (let* ((congruent-val (percent->ccval (current-value fix attr)))
+
+         (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)
+
+              (when congruent
+                (set-attr! selection-state
+                           fix
+                           attr
+                           (ccval->percent new-cc-value)))
+
+              (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 (select-fixtures fixture)
   (values
    (list 98 124 125 84 85 86 120 121 122)
@@ -59,16 +105,16 @@
     (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))))
+                      #:led 125)
+    (at-midi-fader fixture 'r 4
+                      #:led 120
+                      #:led-incongruent 84)
+    (at-midi-fader fixture 'g 5
+                      #:led 121
+                      #:led-incongruent 85)
+    (at-midi-fader fixture 'b 6
+                      #:led 122
+                      #:led-incongruent 86))))
 
 
 ;; Stuff to clear up when we're done with selected fixtures
-- 
cgit v1.2.3