Move useful functions to utils

6 files changed, 68 insertions, 62 deletions

diff --git a/guile/starlet/fixture-library/adj/mega-tripar-profile.scm b/guile/starlet/fixture-library/adj/mega-tripar-profile.scm
index cec35a6..6f70d40 100644
--- a/guile/starlet/fixture-library/adj/mega-tripar-profile.scm
+++ b/guile/starlet/fixture-library/adj/mega-tripar-profile.scm
@@ -20,6 +20,7 @@
 ;;
 (define-module (starlet fixture-library adj mega-tripar-profile)
   #:use-module (starlet fixture)
+  #:use-module (starlet utils)
   #:use-module (starlet colours)
   #:export (<adj-mega-tripar-profile-3ch>
              <adj-mega-tripar-profile-4ch>))
diff --git a/guile/starlet/fixture-library/generic/dimmer.scm b/guile/starlet/fixture-library/generic/dimmer.scm
index b1894b7..844b697 100644
--- a/guile/starlet/fixture-library/generic/dimmer.scm
+++ b/guile/starlet/fixture-library/generic/dimmer.scm
@@ -20,6 +20,7 @@
 ;;
 (define-module (starlet fixture-library generic dimmer)
   #:use-module (starlet fixture)
+  #:use-module (starlet utils)
   #:export (<generic-dimmer>))
 
 (define-fixture
diff --git a/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm b/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm
index d79dcc9..f2ed8a5 100644
--- a/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm
+++ b/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm
@@ -20,6 +20,7 @@
 ;;
 (define-module (starlet fixture-library stairville octagon-theater-cw-ww)
   #:use-module (starlet fixture)
+  #:use-module (starlet utils)
   #:export (<stairville-octagon-theater-cw-ww>))
 
 (define-fixture
diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm
index 5ef3492..c6a6edf 100644
--- a/guile/starlet/fixture.scm
+++ b/guile/starlet/fixture.scm
@@ -20,6 +20,7 @@
 ;;
 (define-module (starlet fixture)
   #:use-module (starlet colours)
+  #:use-module (starlet utils)
   #:use-module (oop goops)
   #:use-module (ice-9 exceptions)
   #:use-module (srfi srfi-1)
@@ -41,13 +42,6 @@
             continuous-attribute?
             colour-attribute?
             intensity?
-
-            scale-to-range
-            scale-and-clamp-to-range
-            round-dmx
-            percent->dmxval8
-            percent->dmxval16
-
             define-fixture))
 
 
@@ -188,46 +182,6 @@
        (get-attr-type aobj)))
 
 
-;; Helper functions for fixture scanout routines
-(define (percent->dmxval8 val)
-  (round-dmx
-   (scale-to-range val '(0 100) '(0 255))))
-
-
-(define (percent->dmxval16 val)
-  (scale-to-range val '(0 100) '(0 65535)))
-
-
-(define (round-dmx a)
-  (inexact->exact
-   (min 255 (max 0 (round a)))))
-
-
-(define (scale-to-range val orig-range dest-range)
-
-  (define (range r)
-    (- (cadr r) (car r)))
-
-  (+ (car dest-range)
-     (* (range dest-range)
-        (/ (- val (car orig-range))
-           (range orig-range)))))
-
-
-(define (clamp-to-range val val1 val2)
-  (let ((minval (min val1 val2))
-        (maxval (max val1 val2)))
-  (max minval
-       (min val maxval))))
-
-;; Like scale-to-range, but result is clamped within dest-range
-(define (scale-and-clamp-to-range val orig-range dest-range)
-  (clamp-to-range
-    (scale-to-range val orig-range dest-range)
-    (car dest-range)
-    (cadr dest-range)))
-
-
 (define-syntax define-fixture
   (syntax-rules ()
 
diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm
index f5f4baa..43c2cf0 100644
--- a/guile/starlet/scanout.scm
+++ b/guile/starlet/scanout.scm
@@ -194,26 +194,12 @@
                                (list new-state)))))
 
 
-(define (msb val)
-  (round-dmx (euclidean-quotient val 256)))
-
-(define (lsb val)
-  (round-dmx (euclidean-remainder val 256)))
-
-
 (define (send-to-ola ola-client universe-buffer-pair)
   (let ((uni (car universe-buffer-pair))
         (buf (cdr universe-buffer-pair)))
   (send-streaming-dmx-data! ola-client uni buf)))
 
 
-(define (ensure-number value irritating)
-  (unless (number? value)
-    (raise-exception (make-exception
-                       (make-exception-with-message "Value is not a number")
-                       (make-exception-with-irritants irritating)))))
-
-
 (define scanout-freq 0)
 (define ola-thread #f)
 
diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm
index 2f4e613..8508079 100644
--- a/guile/starlet/utils.scm
+++ b/guile/starlet/utils.scm
@@ -21,6 +21,7 @@
 (define-module (starlet utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-8)
+  #:use-module (ice-9 exceptions)
   #:export (print-hash-table
             copy-hash-table
             in-range
@@ -28,7 +29,15 @@
             flatten-sublists
             more-than-one
             hirestime
-            categorize))
+            categorize
+            lsb
+            msb
+            ensure-number
+            round-dmx
+            scale-to-range
+            scale-and-clamp-to-range
+            percent->dmxval8
+            percent->dmxval16))
 
 
 (define (print-hash-table ht)
@@ -96,3 +105,57 @@
 
 (define (categorize items . predicates)
   (apply values (categorize-rec predicates items '())))
+
+
+(define (msb val)
+  (round-dmx (euclidean-quotient val 256)))
+
+(define (lsb val)
+  (round-dmx (euclidean-remainder val 256)))
+
+
+(define (round-dmx a)
+  (inexact->exact
+   (min 255 (max 0 (round a)))))
+
+
+(define (ensure-number value irritating)
+  (unless (number? value)
+    (raise-exception (make-exception
+                       (make-exception-with-message "Value is not a number")
+                       (make-exception-with-irritants irritating)))))
+
+
+(define (percent->dmxval8 val)
+  (round-dmx
+   (scale-to-range val '(0 100) '(0 255))))
+
+
+(define (percent->dmxval16 val)
+  (scale-to-range val '(0 100) '(0 65535)))
+
+
+(define (scale-to-range val orig-range dest-range)
+
+  (define (range r)
+    (- (cadr r) (car r)))
+
+  (+ (car dest-range)
+     (* (range dest-range)
+        (/ (- val (car orig-range))
+           (range orig-range)))))
+
+
+(define (clamp-to-range val val1 val2)
+  (let ((minval (min val1 val2))
+        (maxval (max val1 val2)))
+  (max minval
+       (min val maxval))))
+
+
+;; Like scale-to-range, but result is clamped within dest-range
+(define (scale-and-clamp-to-range val orig-range dest-range)
+  (clamp-to-range
+    (scale-to-range val orig-range dest-range)
+    (car dest-range)
+    (cadr dest-range)))