diff options
Diffstat (limited to 'guile')
-rw-r--r-- | guile/starlet/open-sound-control/utils.scm | 2 | ||||
-rw-r--r-- | guile/starlet/selection.scm | 61 | ||||
-rw-r--r-- | guile/starlet/state.scm | 43 |
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) |