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

---
 guile/starlet/selection.scm | 61 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 guile/starlet/selection.scm

(limited to 'guile/starlet/selection.scm')

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))
-- 
cgit v1.2.3