From 6d54086fc0814e55dfb80ebe36c16e53bed3401a Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 4 Apr 2021 12:00:48 +0200
Subject: Add the ability to make certain states unique

This allows easy re-assignment of faders with state-on-fader
---
 guile/starlet/base.scm                | 42 ++++++++++++++++++++++++++++++-----
 guile/starlet/midi-control/faders.scm | 18 ++++++++++++++-
 2 files changed, 53 insertions(+), 7 deletions(-)

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 407e3d9..ea7850c 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -125,8 +125,13 @@
 ;; of (fixture . attribute)  -->  value
 (define-class <starlet-state> (<object>)
   (hash-table
-   #:init-form (make-hash-table)
-   #:getter get-state-hash-table))
+    #:init-form (make-hash-table)
+    #:getter get-state-hash-table)
+  (name
+    #:init-value #f
+    #:init-keyword #:name
+    #:getter get-state-name
+    #:setter set-state-name!))
 
 
 (define-method (set-in-state! (state <starlet-state>)
@@ -202,10 +207,35 @@
        (get-attr-type aobj)))
 
 
-(define (register-state! new-state)
-  (atomic-box-set! state-list
-                   (append (atomic-box-ref state-list)
-                           (list new-state))))
+(define (append-or-replace-named-state orig-list name new-state)
+  (let ((new-list (map (lambda (st)
+                         (if (eq? (get-state-name st) name)
+                             (begin
+                               new-state)
+                             st))
+                       orig-list)))
+
+    ;; If there is no state with this name in the list,
+    ;; the replacement above will have no effect.
+    ;; Check again and add in the normal way if so.
+    (if (find (lambda (st) (eq? (get-state-name st)
+                                name))
+              new-list)
+        new-list
+        (append orig-list (list new-state)))))
+
+
+(define* (register-state! new-state
+                          #:key (unique-name #f))
+  (if unique-name
+      (begin (set-state-name! new-state unique-name)
+             (atomic-box-set! state-list
+                              (append-or-replace-named-state (atomic-box-ref state-list)
+                                                             unique-name
+                                                             new-state)))
+      (atomic-box-set! state-list
+                       (append (atomic-box-ref state-list)
+                               (list new-state)))))
 
 ;; Patch a new fixture
 (define* (patch-real name
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index 606bd72..34d9ddb 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -8,6 +8,21 @@
   #:export (state-on-fader))
 
 
+(define (channel-number->string channel)
+  (if channel
+      (number->string channel)
+      "default"))
+
+
+(define (name-for-fader-state channel cc-number)
+  (string->symbol
+    (string-append
+      "faderstate-ch"
+      (channel-number->string channel)
+      "-cc"
+      (number->string cc-number))))
+
+
 (define* (state-on-fader cc-number
                          state
                          #:key (channel #f))
@@ -37,7 +52,8 @@
                       ;; Fader position unknown
                       'no-value)))))
 
-        state))))
+        state))
+    #:unique-name (name-for-fader-state channel cc-number)))
 
 
 (define (current-values fixture-list attr-name)
-- 
cgit v1.2.3