diff options
| -rw-r--r-- | src/init.scm | 48 |
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) |