blob: a7eafc113f67e851d088c77d8dde47fcde58e199 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
(define set-level
(lambda (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
(lambda (fixtures name)
(cond
[(null? fixtures) #f]
[(eq? (fixture-name (car fixtures)) name) (car fixtures)]
[else (find-fixture (cdr fixtures) name)])))
(define find-fixture-class
(lambda (fixture-classes name)
(cond
[(null? fixture-classes) #f]
[(string-ci=? (fixture-class-name (car fixture-classes)) name) (car fixture-classes)]
[else (find-fixture-class (cdr fixture-classes) name)])))
(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)))))
(if fixcls
(f 1)
(display "Fixture class not available\n"))))
(define at
(lambda (fixname level)
(cons fixname (cons 'intensity level))))
(define show-state
(lambda (state)
(set-level fixtures 0)
(let ([qv (state)])
(for-each (lambda (q)
(set-level (car q) (cddr q)))
qv))))
(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 example
(lambda ()
(list
(at 'mh1 85)
(at 'mh2 0)
(at 'mh3 (+ 30 30))
(at 'mh4 32)
(at 'dim1 100)
(at 'dim2 12))))
(define home
(lambda ()
(list)))
(show-state home)
|
