Split smart potentiometer control logic out of osc-smart-potentiometer

1 files changed, 124 insertions, 87 deletions

diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm
index d89665c..ae97c2c 100644
--- a/guile/starlet/open-sound-control/utils.scm
+++ b/guile/starlet/open-sound-control/utils.scm
@@ -29,7 +29,9 @@
   #:use-module (open-sound-control client)
   #:use-module (open-sound-control server-thread)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 receive)
   #:export (osc-playback-controls
             osc-select-button
             osc-parameter-encoder
@@ -180,48 +182,41 @@
         (get-selection-as-string)))))
 
 
-(define (fader-congruent vals attrs)
-  (mean (map (lambda (val attr)
-               (scale-to-range val (get-attr-range attr) '(0 127)))
-             vals attrs)))
-
-
 (define (fader-up-gradients initial-vals
-                            attrs
+                            max-vals
                             congruent-val)
-  (map (lambda (initial-val attr)
-         (let ((attr-max (cadr (get-attr-range attr))))
-           (if (< congruent-val 127)
+  (map (lambda (initial-val attr-max)
+         (if (< congruent-val 127)
                (/ (- attr-max initial-val)
                   (- 127 congruent-val))
-               0)))
+               0))
        initial-vals
-       attrs))
+       max-vals))
 
 
 (define (fader-down-gradients initial-vals
-                              attrs
+                              min-vals
                               congruent-val)
-  (map (lambda (initial-val attr)
-         (let ((attr-min (car (get-attr-range attr))))
-           (if (> congruent-val 0)
+  (map (lambda (initial-val attr-min)
+         (if (> congruent-val 0)
                (/ (- initial-val attr-min)
                   congruent-val)
-               0)))
-
+               0))
        initial-vals
-       attrs))
+       min-vals))
 
 
 (define (fixtures-with-attr fixture-list attr-name)
-  (let ((attrs (map (cut find-attr <> attr-name) fixture-list)))
-    (fold (lambda (fix attr old)
-            (if attr
-              (cons (cons fix (car old))
-                    (cons attr (cdr old)))
-              old))
-          (cons '() '())
-          fixture-list attrs)))
+  (let ((fix-attrs
+          (map (lambda (fix)
+                 (let ((attr (find-attr fix attr-name)))
+                   (if attr
+                     (cons fix attr)
+                     (cons #f #f))))
+               fixture-list)))
+    (values
+      (filter (lambda (x) x) (map car fix-attrs))
+      (filter (lambda (x) x) (map cdr fix-attrs)))))
 
 
 (define (current-values fixture-list attr-name)
@@ -230,23 +225,73 @@
        fixture-list))
 
 
-(define (apply-fader cc-offset
-                     attr-name
-                     gradients
-                     initial-vals
-                     fixtures
-                     label)
-  (for-each
-    (lambda (fix initial-val gradient)
-      (set-in-state! programmer-state
-                     fix
-                     attr-name
-                     (+ initial-val
-                        (* gradient cc-offset))
-                     label))
-    fixtures
-    initial-vals
-    gradients))
+(define-record-type <smart-potentiometer>
+  (smart-pot-record addr
+                    pot-method
+                    initial-vals
+                    min-vals
+                    max-vals
+                    congruent-val
+                    up-gradients
+                    dn-gradients)
+  smart-pot?
+  (addr          get-target-addr)
+  (pot-method    get-method)
+  (initial-vals  get-initial-vals    set-initial-vals)
+  (min-vals      get-min-vals        set-min-vals)
+  (max-vals      get-max-vals        set-max-vals)
+  (congruent-val get-congruent-val   set-congruent-val)
+  (up-gradients  get-up-gradients    set-up-gradients)
+  (dn-gradients  get-dn-gradients    set-dn-gradients))
+
+
+(define (make-smart-potentiometer server addr pot-method callback)
+
+  (let ((sp (smart-pot-record addr pot-method '() '() '() 0 '() '())))
+
+    (add-osc-method
+      server
+      (string-append pot-method "/value-change")
+      "i"
+      (lambda (new-cc-value)
+        (callback
+          (map
+            (lambda (initial-val gradient)
+              (+ initial-val
+                 (* gradient
+                    (- new-cc-value (get-congruent-val sp)))))
+            (get-initial-vals sp)
+            (if (> new-cc-value (get-congruent-val sp))
+              (get-up-gradients sp)
+              (get-dn-gradients sp))))))
+
+    sp))
+
+
+(define (reset-gradients sp)
+  (unless (nil? (get-initial-vals sp))
+    (set-congruent-val sp
+                       (mean
+                         (map
+                           (lambda (val min-val max-val)
+                             (scale-to-range val (list min-val max-val) '(0 127)))
+                           (get-initial-vals sp)
+                           (get-min-vals sp)
+                           (get-max-vals sp))))
+    (set-up-gradients sp
+                      (fader-up-gradients
+                        (get-initial-vals sp)
+                        (get-max-vals sp)
+                        (get-congruent-val sp)))
+    (set-dn-gradients sp
+                      (fader-up-gradients
+                        (get-initial-vals sp)
+                        (get-min-vals sp)
+                        (get-congruent-val sp)))
+    (osc-send
+      (get-target-addr sp)
+      (string-append (get-method sp) "/set-pickup")
+      (get-congruent-val sp))))
 
 
 (define (osc-smart-potentiometer attr-name
@@ -254,58 +299,50 @@
                                  addr
                                  potentiometer)
 
-  (let ((fixtures '())
-        (attrs '())
-        (initial-vals '())
-        (congruent-val 0)
-        (up-gradients '())
-        (dn-gradients '()))
-
-    (let ((set-gradients
-            (lambda ()
-              (unless (nil? fixtures)
-                (set! initial-vals (current-values fixtures attr-name))
-                (set! congruent-val (fader-congruent initial-vals attrs))
-                (set! up-gradients (fader-up-gradients initial-vals attrs congruent-val))
-                (set! dn-gradients (fader-down-gradients initial-vals attrs congruent-val))
-                (osc-send addr (string-append potentiometer "/set-pickup") congruent-val)))))
-
+  (let ((fixtures '()))
+
+    ;; First, create a smart potentiometer object and tell it to
+    ;; set the attribute values in the programmer state
+    (let ((smart-pot
+            (make-smart-potentiometer
+              server
+              addr
+              potentiometer
+              (lambda (new-vals)
+                (for-each
+                  (lambda (fix new-val)
+                    (set-in-state! programmer-state
+                                   fix
+                                   attr-name
+                                   new-val
+                                   potentiometer))
+                  fixtures new-vals)))))
+
+      ;; Next, set up a selection hook callback to update the list of
+      ;; fixtures we are controlling
       (add-and-run-hook!
         selection-hook
         (lambda (selection)
-          (let ((fixtures-attrs (fixtures-with-attr selection attr-name)))
-            (if (null? (car fixtures-attrs))
+          (receive
+            (new-fixtures attrs)
+            (fixtures-with-attr selection attr-name)
+            (if (nil? new-fixtures)
               (osc-send addr (string-append potentiometer "/disable"))
               (begin
-                (set! fixtures (car fixtures-attrs))
-                (set! attrs (cdr fixtures-attrs))
-                (set-gradients)
+                (set! fixtures new-fixtures)
+                (let ((ranges (map get-attr-range attrs)))
+                  (set-min-vals smart-pot (map first ranges))
+                  (set-max-vals smart-pot (map second ranges)))
+                (set-initial-vals smart-pot (current-values fixtures attr-name))
+                (reset-gradients smart-pot)
                 (osc-send addr (string-append potentiometer "/enable"))))))
         (get-selection))
 
-      (add-osc-method
-        server
-        (string-append potentiometer "/value-change")
-        "i"
-        (lambda (new-cc-value)
-          (cond
-            ((> new-cc-value congruent-val)
-             (apply-fader (- new-cc-value congruent-val)
-                          attr-name
-                          up-gradients
-                          initial-vals
-                          fixtures
-                          potentiometer))
-            ((<= new-cc-value congruent-val)
-             (apply-fader (- new-cc-value congruent-val)
-                          attr-name
-                          dn-gradients
-                          initial-vals
-                          fixtures
-                          potentiometer)))))
-
+      ;; Finally, arrange for the smart potentiometer object to be notified
+      ;; if the values change externally
       (add-update-hook!
         programmer-state
         (lambda (source)
           (unless (eq? source potentiometer)
-            (set-gradients)))))))
+            (set-initial-vals smart-pot (current-values fixtures attr-name))
+            (reset-gradients smart-pot)))))))