aboutsummaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
Diffstat (limited to 'guile')
-rw-r--r--guile/starlet/open-sound-control/utils.scm2
-rw-r--r--guile/starlet/selection.scm61
-rw-r--r--guile/starlet/state.scm43
3 files changed, 66 insertions, 40 deletions
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)