From 55a076a607b5e65f90f98e4e5e9bac5852df1d3e Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 29 Apr 2023 18:19:20 +0200
Subject: Move selection stuff to a separate module

---
 examples/demo-show.scm                     |  1 +
 guile/starlet/open-sound-control/utils.scm |  2 +-
 guile/starlet/selection.scm                | 61 ++++++++++++++++++++++++++++++
 guile/starlet/state.scm                    | 43 ++-------------------
 4 files changed, 67 insertions(+), 40 deletions(-)
 create mode 100644 guile/starlet/selection.scm

diff --git a/examples/demo-show.scm b/examples/demo-show.scm
index 7405886..92fc780 100644
--- a/examples/demo-show.scm
+++ b/examples/demo-show.scm
@@ -10,6 +10,7 @@
   (starlet attributes)
   (starlet cue-list)
   (starlet attributes)
+  (starlet selection)
   (starlet fixture-library generic dimmer)
   (starlet fixture-library stairville z120m)
   (starlet fixture-library robe dl7s)
diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm
index bb9c310..160d9bc 100644
--- a/guile/starlet/open-sound-control/utils.scm
+++ b/guile/starlet/open-sound-control/utils.scm
@@ -20,7 +20,7 @@
 ;;
 (define-module (starlet open-sound-control utils)
   #:use-module (starlet playback)
-  #:use-module (starlet state)
+  #:use-module (starlet selection)
   #:use-module (starlet utils)
   #:use-module (open-sound-control client)
   #:use-module (open-sound-control server-thread)
diff --git a/guile/starlet/selection.scm b/guile/starlet/selection.scm
new file mode 100644
index 0000000..32be41a
--- /dev/null
+++ b/guile/starlet/selection.scm
@@ -0,0 +1,61 @@
+;;
+;; starlet/selection.scm
+;;
+;; Copyright © 2020-2023 Thomas White <taw@bitwiz.org.uk>
+;;
+;; This file is part of Starlet.
+;;
+;; Starlet is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+(define-module (starlet selection)
+  #:use-module (starlet utils)
+  #:use-module (srfi srfi-1)
+  #:export (sel
+             desel
+             selection-hook
+             get-selection
+             selected?))
+
+
+(define selection-hook (make-hook 1))
+
+(define selection '())
+
+
+(define (get-selection)
+  selection)
+
+
+(define (sel . fixture-list)
+  (if (nil? fixture-list)
+      (set! selection '())
+      (if (not (car fixture-list))
+          (set! selection '())
+          (set! selection (flatten-sublists fixture-list))))
+  (run-hook selection-hook selection))
+
+
+(define (selected? . fixture-list)
+  (every (lambda (fix)
+           (memq fix selection))
+         (flatten-sublists fixture-list)))
+
+
+(define (desel . fixture-list)
+  (let ((remove-us (flatten-sublists fixture-list)))
+    (set! selection
+      (filter (lambda (fix)
+                (not (memq fix remove-us)))
+              selection)))
+  (run-hook selection-hook selection))
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index e760d2a..a2cb65d 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -23,6 +23,7 @@
   #:use-module (starlet colours)
   #:use-module (starlet utils)
   #:use-module (starlet attributes)
+  #:use-module (starlet selection)
   #:use-module (oop goops)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 atomic)
@@ -53,11 +54,6 @@
             home-fixture!
             blackout
             blackout!
-            sel
-            desel
-            selection-hook
-            get-selection
-            selected?
             value->number
             atomically-overlay-state!
             update-state!
@@ -425,7 +421,8 @@ pre-existing contents."
 ;; NB Can't set multiple fixtures and attributes: (at fix1 pan 35 fix2 tilt 22)
 
 (define (at . args)
-  (receive (fixtures attribute value)
+  (let ((selection (get-selection)))
+    (receive (fixtures attribute value)
            (partition3 fixture? attribute? (flatten-sublists args))
            (cond
 
@@ -451,39 +448,7 @@ pre-existing contents."
                   (set-fixtures selection (car attribute) (car value))))
 
              (else
-               (set-fixtures fixtures (car attribute) (car value))))))
-
-
-(define selection-hook (make-hook 1))
-
-(define selection '())
-
-(define (get-selection)
-  selection)
-
-
-(define (sel . fixture-list)
-  (if (nil? fixture-list)
-      (set! selection '())
-      (if (not (car fixture-list))
-          (set! selection '())
-          (set! selection (flatten-sublists fixture-list))))
-  (run-hook selection-hook selection))
-
-
-(define (selected? . fixture-list)
-  (every (lambda (fix)
-           (memq fix selection))
-         (flatten-sublists fixture-list)))
-
-
-(define (desel . fixture-list)
-  (let ((remove-us (flatten-sublists fixture-list)))
-    (set! selection
-      (filter (lambda (fix)
-                (not (memq fix remove-us)))
-              selection)))
-  (run-hook selection-hook selection))
+               (set-fixtures fixtures (car attribute) (car value)))))))
 
 
 (define (state-empty? st)
-- 
cgit v1.2.3