From bd271d16160fba132da9a82bd0c574c9f26e2942 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Mon, 15 May 2023 21:04:24 +0200
Subject: Implement OSC encoders for list attributes

---
 examples/demo-show.scm                     |  1 +
 guile/starlet/fixture.scm                  | 17 ++++++++++++++++-
 guile/starlet/open-sound-control/utils.scm | 12 ++++++++++--
 guile/starlet/utils.scm                    | 10 +++++++++-
 4 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/examples/demo-show.scm b/examples/demo-show.scm
index 207e0c7..263343e 100644
--- a/examples/demo-show.scm
+++ b/examples/demo-show.scm
@@ -123,6 +123,7 @@
 
 (osc-parameter-encoder osc-server "/x1k2/encoders/1" x1k2 "/x1k2/leds/1" pan)
 (osc-parameter-encoder osc-server "/x1k2/encoders/2" x1k2 "/x1k2/leds/2" tilt)
+(osc-parameter-encoder osc-server "/x1k2/encoders/3" x1k2 "/x1k2/leds/3" gobo)
 (osc-parameter-encoder osc-server "/x1k2/encoders/102" x1k2 "/x1k2/nothing" intensity)
 
 (osc-state-fader osc-server "/x1k2/faders/4"
diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm
index 1db713b..856a67d 100644
--- a/guile/starlet/fixture.scm
+++ b/guile/starlet/fixture.scm
@@ -45,7 +45,10 @@
             get-attr-range
             get-attr-home-val
             continuous-attribute?
-            colour-attribute?))
+            colour-attribute?
+
+            next-attr-item
+            prev-attr-item))
 
 
 (define-class <fixture-attribute> (<object>)
@@ -221,3 +224,15 @@
 
 
 (define fixture-has-attr? find-attr)
+
+
+(define (next-attr-item attr cval)
+  (next-item-in-list
+    (get-attr-range attr)
+    cval))
+
+
+(define (prev-attr-item attr cval)
+  (next-item-in-list
+    (reverse (get-attr-range attr))
+    cval))
diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm
index 4f0a60b..932abaa 100644
--- a/guile/starlet/open-sound-control/utils.scm
+++ b/guile/starlet/open-sound-control/utils.scm
@@ -92,10 +92,18 @@
     (get-selection)))
 
 
-(define (encoder-inc attr n)
+(define (encoder-inc attr-id n)
   (for-each
     (lambda (fix)
-      (at fix attr (+ (current-value fix attr) n)))
+      (let ((attr (find-attr fix attr-id))
+            (cval (current-value fix attr-id)))
+        (cond
+          ((eq? 'continuous (get-attr-type attr))
+           (at fix attr-id (+ cval n)))
+          ((eq? 'list (get-attr-type attr))
+           (if (> n 0)
+             (at fix attr-id (next-attr-item attr cval))
+             (at fix attr-id (prev-attr-item attr cval)))))))
     (get-selection)))
 
 
diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm
index e0579ab..1506553 100644
--- a/guile/starlet/utils.scm
+++ b/guile/starlet/utils.scm
@@ -42,7 +42,8 @@
             hash-table-empty?
             lookup
             add-and-run-hook!
-            cat-with-spaces))
+            cat-with-spaces
+            next-item-in-list))
 
 
 (define (print-hash-table ht)
@@ -187,3 +188,10 @@
     (lambda (b a)
       (string-append a " " b))
     "" lst))
+
+
+(define (next-item-in-list the-list cval)
+  (let ((sl (memq cval the-list)))
+    (if (nil? (cdr sl))
+      (first the-list)
+      (second sl))))
-- 
cgit v1.2.3