Turn all Guile stuff into proper modules

2 files changed, 98 insertions, 0 deletions

diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
new file mode 100644
index 0000000..95bdc13
--- /dev/null
+++ b/guile/nanolight/fixture.scm
@@ -0,0 +1 @@
+(define-module (nanolight fixture))
diff --git a/guile/nanolight/state.scm b/guile/nanolight/state.scm
new file mode 100644
index 0000000..deb31cf
--- /dev/null
+++ b/guile/nanolight/state.scm
@@ -0,0 +1,97 @@
+(define-module (nanolight state)
+  #:export (combine-states print-state int flash))
+
+(use-modules (nanolight fixture))
+(use-modules (srfi srfi-1))
+
+
+(define (find-fixture-attr fixture attr state)
+  (find (lambda (a) (and
+                      (eq? (car a) fixture)
+                      (eq? (cadr a) attr)))
+    state))
+
+
+; Combine two states.  Return combined list
+(define (merge-states a b)
+  (let ((c '()))
+
+    (define (add-to-state add)
+
+      ; Already in state?
+      (let ((attr (find-fixture-attr (car add) (cadr add) c)))
+        (if attr
+          (set-cdr! (last-pair attr) (cddr add))  ; add to existing list
+          (set! c (cons add c)))))   ; add fixture+attr to state
+
+    (for-each add-to-state a)
+    (for-each add-to-state b)
+
+    c))
+
+
+; Combine the first two states in the list
+; Return a new list, one shorter than the input
+(define (merge-first-two-states a)
+  (cons (merge-states (car a) (cadr a)) (cddr a)))
+
+
+; Each argument is a "state", i.e. a list of these: (fixture attr function)
+; Returns a combined state, with non-unique fixtures combined
+(define (combine-states . a)
+  (cond
+    [(= (length a) 0) '()]
+    [(= (length a) 1) (car a)]
+    [else (apply combine-states (merge-first-two-states a))]))
+
+
+(define (print-state st)
+
+  (define (print-statelet a)
+    (display (car a))
+    (display " ")
+    (display (cadr a))
+    (newline)
+    (for-each (lambda (b)
+                (display "       ")
+                (display b)
+                (display "  --->  ")
+                (display (b))
+                (newline))
+      (cddr a)))
+
+  (for-each print-statelet st))
+
+
+; Helper functions
+
+(define (hirestime)
+  (let ((a (gettimeofday)))
+    (+
+      (car a)
+      (/
+        (cdr a)
+        1000000))))
+
+(define pi 3.141592653589793)
+
+(define (square-wave hz)
+  (if (> (sin (* 2 pi hz (hirestime))) 0) 100 0))
+
+(define (static-value attr value fixture)
+  (list (list fixture attr (lambda () value))))
+
+
+; Useful source functions
+
+(define (int value fixture)
+  (static-value 'intensity value fixture))
+
+(define (pan value fixture)
+  (static-value 'pan value fixture))
+
+(define (tilt value fixture)
+  (static-value 'tilt value fixture))
+
+(define (flash hz fixture)
+  (list (list fixture 'intensity (lambda () (square-wave hz)))))