From 730ed8b6b63bb3fdce9db8320e5b37963616e41e Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 12 Sep 2021 18:08:10 +0200
Subject: Variable sensitivity for jogwheels

Use make-sensitivity-knob
---
 guile/starlet/midi-control/base.scm   | 25 +++++++++++++++++++++++--
 guile/starlet/midi-control/faders.scm | 19 +++++++++++++++----
 2 files changed, 38 insertions(+), 6 deletions(-)

(limited to 'guile')

diff --git a/guile/starlet/midi-control/base.scm b/guile/starlet/midi-control/base.scm
index 9363e81..bed1a1f 100644
--- a/guile/starlet/midi-control/base.scm
+++ b/guile/starlet/midi-control/base.scm
@@ -35,7 +35,9 @@
             register-midi-cc-callback!
             remove-midi-callback!
             get-parameter-controller
-            set-parameter-controller!))
+            get-controller-sensitivity
+            set-parameter-controller!
+            make-sensitivity-knob))
 
 
 (define-class <midi-control-surface> (<object>)
@@ -59,7 +61,12 @@
   (parameter-controller
     #:init-value #f
     #:getter get-parameter-controller
-    #:setter set-parameter-controller!))
+    #:setter set-parameter-controller!)
+
+  (sensitivity
+    #:init-value 3
+    #:getter get-controller-sensitivity
+    #:setter set-controller-sensitivity!))
 
 
 (define-class <midi-callback> (<object>)
@@ -271,3 +278,17 @@
       (make-midi-controller-real device-name channel))
 
     #:unwind? #t))
+
+
+(define (set-sensitivity controller prev new)
+  (set-controller-sensitivity!
+    controller
+    (min 5 (max 1 (+ (if (= new 127) -1 1)
+                     (get-controller-sensitivity controller))))))
+
+
+(define (make-sensitivity-knob controller cc-num)
+  (register-midi-callback!
+    controller 'cc cc-num
+    (lambda (prev new)
+      (set-sensitivity controller prev new))))
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index bd2da95..2af57e3 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -107,16 +107,26 @@
               val))))
 
 
+(define (attr-scale controller attr)
+  (let ((sens-level (get-controller-sensitivity controller)))
+    (cond
+      ((= sens-level 1) 0.02)
+      ((= sens-level 2) 0.1)
+      ((= sens-level 3) 0.5)
+      ((= sens-level 4) 1.5)
+      ((= sens-level 5) 3.0))))
+
+
 (define* (at-midi-jogwheel controller
                            fixture-list
                            attr
                            cc-number
                            #:key (led #f))
 
-  (define (ccval->offset a)
+  (define (ccval->offset controller a)
     (if (eq? a 127)
-        -1
-        1))
+        (- (attr-scale controller attr))
+        (attr-scale controller attr)))
 
   (let ((fixtures (car (fixtures-with-attr fixture-list attr))))
     (unless (null? fixtures)
@@ -130,7 +140,8 @@
           controller
           #:cc-number cc-number
           #:func (lambda (prev-cc-val new-cc-value)
-                   (set! offset (+ offset (ccval->offset new-cc-value)))
+                   (set! offset (+ offset (ccval->offset controller
+                                                         new-cc-value)))
                    (for-each (lambda (fix old-val)
                                (let ((attr-obj (find-attr fix attr)))
                                  (when (and attr-obj
-- 
cgit v1.2.3