From 3c4c9a2c89defe50ad40c544e383f50eb0aa040e Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 11 Sep 2021 12:15:14 +0200
Subject: Re-assert MIDI control map on parameter change

This makes the MIDI controller stay in sync with the programmer state
values.  It's kind of a coarse solution, though.  It would be better to:
1. Only re-assert the map if the changed parameter currently appears on
   the MIDI control surface
2. Only re-assert the part of the map related to the parameter

Almost as a side-effect, this enables switching between multiple control
maps.  Just call 'set-midi-control-map!' on the controller with the new
map.
---
 examples/show.scm                     |  2 +-
 guile/starlet/midi-control/base.scm   | 11 ++++-
 guile/starlet/midi-control/faders.scm | 83 ++++++++++++++++++++++++++++-------
 3 files changed, 76 insertions(+), 20 deletions(-)

diff --git a/examples/show.scm b/examples/show.scm
index 1e51a99..d672572 100644
--- a/examples/show.scm
+++ b/examples/show.scm
@@ -72,7 +72,7 @@
 (state-on-fader controller 19 my-state)
 
 
-(use-midi-control-map
+(set-midi-control-map!
   controller
   (list
     (list 'intensity                     'fader    16 '(108 72))
diff --git a/guile/starlet/midi-control/base.scm b/guile/starlet/midi-control/base.scm
index 08310ae..9363e81 100644
--- a/guile/starlet/midi-control/base.scm
+++ b/guile/starlet/midi-control/base.scm
@@ -33,7 +33,9 @@
             send-note-off
             register-midi-note-callback!
             register-midi-cc-callback!
-            remove-midi-callback!))
+            remove-midi-callback!
+            get-parameter-controller
+            set-parameter-controller!))
 
 
 (define-class <midi-control-surface> (<object>)
@@ -52,7 +54,12 @@
 
   (send-queue
     #:init-form (make-atomic-box '())
-    #:getter get-send-queue))
+    #:getter get-send-queue)
+
+  (parameter-controller
+    #:init-value #f
+    #:getter get-parameter-controller
+    #:setter set-parameter-controller!))
 
 
 (define-class <midi-callback> (<object>)
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index dbd2a0f..bd2da95 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -26,10 +26,22 @@
   #:use-module (starlet scanout)
   #:use-module (starlet utils)
   #:use-module (srfi srfi-1)
-  #:export (use-midi-control-map
+  #:use-module (oop goops)
+  #:export (set-midi-control-map!
              state-on-fader))
 
 
+(define-class <parameter-controller> (<object>)
+  (callbacks
+    #:init-keyword #:callbacks
+    #:getter get-callbacks
+    #:setter set-callbacks!)
+
+  (control-map
+    #:init-keyword #:control-map
+    #:getter get-control-map))
+
+
 (define (name-for-fader-state controller cc-number)
   (call-with-output-string
     (lambda (port)
@@ -277,23 +289,60 @@
      (send-note-off controller leds))))
 
 
-(define (use-midi-control-map controller control-map)
-  (let ((midi-callbacks '()))
-    (add-hook! selection-hook
-               (lambda (fixture-list)
+(define (scrub-parameter-controller! controller parameter-controller)
+
+  ;; Remove all the old callbacks
+  (for-each (lambda (callback)
+              (remove-midi-callback! controller callback))
+            (get-callbacks parameter-controller))
+
+  ;; Switch off all the old LEDs
+  (for-each (lambda (control-spec)
+              (led-off controller (cadddr control-spec)))
+            (get-control-map parameter-controller)))
+
+
+(define (update-midi-controls controller fixture-list)
+
+  (scrub-parameter-controller! controller
+                               (get-parameter-controller controller))
+
+  (set-callbacks!
+    (get-parameter-controller controller)
+    (map (lambda (control-spec)
+           (midi-control-attr controller control-spec fixture-list))
+         (get-control-map (get-parameter-controller controller)))))
+
+
+(define (set-midi-control-map! controller new-control-map)
+  (let ((old-parameter-controller (get-parameter-controller controller)))
+
+    ;; Remove the old parameter controller
+    (when old-parameter-controller
+      (scrub-parameter-controller! controller old-parameter-controller))
+
+    (set-parameter-controller!
+      controller
+      (make <parameter-controller>
+            #:callbacks '()
+            #:control-map new-control-map))
 
-                 (for-each (lambda (callback)
-                             (remove-midi-callback! controller callback))
-                           midi-callbacks)
+    ;; If this is the first time, add the callbacks
+    (unless old-parameter-controller
 
-                 (for-each (lambda (control-spec)
-                             (led-off controller (cadddr control-spec)))
-                           control-map)
+      ;; Selection changed
+      (add-hook!
+        selection-hook
+        (lambda (fixture-list)
+          (update-midi-controls controller fixture-list)))
 
-                 (set! midi-callbacks '())
+      ;; Value changed
+      (add-update-hook! programmer-state
+                        (lambda (fix attr value source)
+                          (unless (eq? source controller)
+                            (update-midi-controls controller (get-selection))))))
 
-                 (unless (nil? fixture-list)
-                   (set! midi-callbacks
-                     (map (lambda (control-spec)
-                            (midi-control-attr controller control-spec fixture-list))
-                          control-map)))))))
+    ;; If there is a selection, run the callback now
+    (let ((current-selection (get-selection)))
+      (when current-selection
+        (update-midi-controls controller current-selection)))))
-- 
cgit v1.2.3