1 files changed, 122 insertions, 21 deletions
diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm
index d5441cb..1506553 100644
--- a/guile/starlet/utils.scm
+++ b/guile/starlet/utils.scm
@@ -20,15 +20,30 @@
 ;;
 (define-module (starlet utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-8)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 control)
   #:export (print-hash-table
             copy-hash-table
-            partial
-            partial-start
             in-range
             mean
             flatten-sublists
             more-than-one
-            hirestime))
+            hirestime
+            lsb
+            msb
+            ensure-number
+            round-dmx
+            scale-to-range
+            scale-and-clamp-to-range
+            percent->dmxval8
+            percent->dmxval16
+            comment
+            hash-table-empty?
+            lookup
+            add-and-run-hook!
+            cat-with-spaces
+            next-item-in-list))
 
 
 (define (print-hash-table ht)
@@ -47,15 +62,6 @@
     new-ht))
 
 
-(define (partial f second-val)
-  (lambda (first-val)
-    (f first-val second-val)))
-
-
-(define (partial-start f first-val)
-  (lambda args
-    (apply f first-val args)))
-
 
 (define (in-range a val1 val2)
   (or
@@ -71,15 +77,12 @@
 
 
 (define (flatten-sublists l)
-
-  (define (listify a)
-    (if (list? a)
-        a
-        (list a)))
-
-  (fold (lambda (a prev)
-          (append prev (listify a)))
-        '() l))
+  (fold
+    (lambda (el prev)
+      (if (list? el)
+        (append (flatten-sublists el) prev)
+        (cons el prev)))
+    '() l))
 
 
 (define (more-than-one a)
@@ -94,3 +97,101 @@
        (/ (cdr a)
           1000000))))
 
+
+(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)))
+
+
+(define-syntax comment
+  (syntax-rules ()
+    ((_ body ...)
+     #f)))
+
+
+(define (hash-table-empty? ht)
+  (let/ec
+    return
+    (hash-for-each-handle
+      (lambda (key)
+        (return #f))
+      ht)
+    #t))
+
+
+(define (lookup key dictionary)
+  (cond
+    ((nil? dictionary)
+     #f)
+    ((eq? key (caar dictionary))
+     (cadr (car dictionary)))
+    (else
+      (lookup key (cdr dictionary)))))
+
+
+(define (add-and-run-hook! hook proc . initial-args)
+  (add-hook! hook proc)
+  (apply proc initial-args))
+
+
+(define (cat-with-spaces lst)
+  (reduce
+    (lambda (b a)
+      (string-append a " " b))
+    "" lst))
+
+
+(define (next-item-in-list the-list cval)
+  (let ((sl (memq cval the-list)))
+    (if (nil? (cdr sl))
+      (first the-list)
+      (second sl))))