From fc8d00e2eb4d5bdb40cdc58ec70489273d39e04a Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 30 Jan 2021 21:29:26 +0100
Subject: Move useful stuff to utils

---
 guile/starlet/base.scm                | 19 +--------------
 guile/starlet/midi-control/faders.scm | 18 +-------------
 guile/starlet/utils.scm               | 44 ++++++++++++++++++++++++++++++++++-
 3 files changed, 45 insertions(+), 36 deletions(-)

(limited to 'guile')

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 780ff44..967ad45 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -1,4 +1,5 @@
 (define-module (starlet base)
+  #:use-module (starlet utils)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 atomic)
@@ -511,12 +512,6 @@
                     (values output1 output2 others))))
 
 
-(define (more-than-one a)
-  (if (nil? a)
-      #f
-      (not (nil? (cdr a)))))
-
-
 (define (attr-or-symbol? a)
   (or (fixture-attribute? a)
       (symbol? a)))
@@ -565,18 +560,6 @@
 (define selection '())
 
 
-(define (flatten-sublists l)
-
-  (define (listify a)
-    (if (list? a)
-        a
-        (list a)))
-
-  (fold (lambda (a prev)
-          (append prev (listify a)))
-        '() l))
-
-
 (define (sel . fixture-list)
   (set! selection
     (flatten-sublists fixture-list))
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index 113917c..97ed1ff 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -1,6 +1,7 @@
 (define-module (starlet midi-control faders)
   #:use-module (starlet midi-control base)
   #:use-module (starlet base)
+  #:use-module (starlet utils)
   #:use-module (ice-9 receive)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-1)
@@ -47,11 +48,6 @@
        fixture-list))
 
 
-(define (partial f second-val)
-  (lambda (first-val)
-    (f first-val second-val)))
-
-
 (define (fixtures-with-attr fixture-list attr-name)
   (let ((attrs (map (partial find-attr attr-name) fixture-list)))
     (fold (lambda (fix attr old)
@@ -91,18 +87,6 @@
                             fixtures old-vals)))))))
 
 
-(define (in-range a val1 val2)
-  (or
-   (and (>= a val1)
-        (<= a val2))
-   (and (>= a val2)
-        (<= a val1))))
-
-
-(define (mean vals)
-  (/ (fold + 0 vals)
-     (length vals)))
-
 
 (define (fader-congruent vals attrs)
   (mean (map (lambda (val attr)
diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm
index be87321..049bd86 100644
--- a/guile/starlet/utils.scm
+++ b/guile/starlet/utils.scm
@@ -1,7 +1,13 @@
 (define-module (starlet utils)
+  #:use-module (srfi srfi-1)
   #:export (return-unspecified
             print-hash-table
-            copy-hash-table))
+            copy-hash-table
+            partial
+            in-range
+            mean
+            flatten-sublists
+            more-than-one))
 
 
 (define (return-unspecified)
@@ -21,3 +27,39 @@
                      (hash-set! new-ht key value))
                    ht)
     new-ht))
+
+
+(define (partial f second-val)
+  (lambda (first-val)
+    (f first-val second-val)))
+
+
+(define (in-range a val1 val2)
+  (or
+   (and (>= a val1)
+        (<= a val2))
+   (and (>= a val2)
+        (<= a val1))))
+
+
+(define (mean vals)
+  (/ (fold + 0 vals)
+     (length vals)))
+
+
+(define (flatten-sublists l)
+
+  (define (listify a)
+    (if (list? a)
+        a
+        (list a)))
+
+  (fold (lambda (a prev)
+          (append prev (listify a)))
+        '() l))
+
+
+(define (more-than-one a)
+  (if (nil? a)
+      #f
+      (not (nil? (cdr a)))))
-- 
cgit v1.2.3