Work on description of lighting states

1 files changed, 39 insertions, 9 deletions

diff --git a/src/init.scm b/src/init.scm
index e2be7a2..ce75282 100644
--- a/src/init.scm
+++ b/src/init.scm
@@ -1,8 +1,13 @@
-(define at
+(define set-level
   (lambda (fix level)
-    (if (list? fix)
-      (for-each (lambda (q) (at q level)) fix)
-      (set-intensity (find-fixture fixtures fix) level))))
+    (cond
+      [(list? fix) (for-each (lambda (q)
+                               (set-level q level))
+                             fix)]
+      [(symbol? fix) (set-intensity
+                       (find-fixture fixtures fix)
+                       level)]
+      [else (set-intensity fix level)])))
 
 
 (define find-fixture
@@ -24,14 +29,39 @@
 (define patch-many
   (lambda (fixcls prefix n universe start-addr)
     (define f (lambda (i)
-               (patch-fixture (symbol-append prefix (string->symbol (number->string i)))
-                              fixcls universe (+ start-addr (- i 1)))
-               (if (< i n)
-                 (f (+ i 1)))))
+                 (patch-fixture (symbol-append prefix (string->symbol (number->string i)))
+                                fixcls universe (+ start-addr (- i 1)))
+                 (if (< i n)
+                   (f (+ i 1)))))
     (if fixcls
       (f 1)
       (display "Fixture class not available\n"))))
 
 
-(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 48 0 1)
+(define at
+  (lambda (fixname level)
+    (cons fixname (cons 'intensity level))))
+
+
+(define show-state-absolute
+  (lambda (state)
+    (set-level fixtures 0)
+    (for-each (lambda (q)
+                (set-level
+                  (car q)
+                  (cddr q)))
+              state)))
+
+
 (patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)
+(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 6 0 1)
+
+(define home (list
+               (at 'mh1 0)
+               (at 'mh2 0)
+               (at 'mh3 (+ 30 30))
+               (at 'mh4 0)
+               (at 'dim1 0)
+               (at 'dim2 0)))
+
+(show-state-absolute home)