aboutsummaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-01-30 21:29:26 +0100
committerThomas White <taw@physics.org>2021-01-30 21:29:26 +0100
commitfc8d00e2eb4d5bdb40cdc58ec70489273d39e04a (patch)
tree39bc8fd429aba8989b177a6bb7dacebf59e1ba37 /guile
parentc0d903c2e16eccc444ea95187a02f3e0dfe639ae (diff)
Move useful stuff to utils
Diffstat (limited to 'guile')
-rw-r--r--guile/starlet/base.scm19
-rw-r--r--guile/starlet/midi-control/faders.scm18
-rw-r--r--guile/starlet/utils.scm44
3 files changed, 45 insertions, 36 deletions
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)))))