blob: be9918c6c54f22db2b0115110272e0ab8ac92c36 (
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(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"))))
(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)
; New version
(define (make-fixture fixture-class)
(list (int 0) (pan 50) (tilt 50)))
(define (at source sink)
(let ((attr (car source))
(val (cdr source)))
(set-cdr! (assq attr sink) val)))
(define (status fixture)
(for-each (lambda (a)
(format #t "~10@a: ~a~%" (car a) ((cdr a))))
fixture))
; Useful source functions
(define (int value)
(cons 'intensity (lambda () value)))
(define (pan value)
(cons 'pan (lambda () value)))
(define (tilt value)
(cons 'tilt (lambda () value)))
(define (flash sec)
(cons 'intensity (lambda ()
(if (= 0 (remainder (current-time) sec))
100 0))))
(define-syntax define-state
(syntax-rules ()
((_ name exp exp* ...)
(define name
(lambda () exp exp* ...)))))
; Demo
(define mh1 (make-fixture "Robe Robin DL7S Profile Mode 1"))
(define mh2 (make-fixture "Robe Robin DL7S Profile Mode 1"))
(define mh3 (make-fixture "Robe Robin DL7S Profile Mode 1"))
(define mh4 (make-fixture "Robe Robin DL7S Profile Mode 1"))
(define dim1 (make-fixture "Generic dimmer"))
(define dim2 (make-fixture "Generic dimmer"))
(define-state exstate
(mh1 (flash 2))
(mh2 (int 0))
(mh3 (int (+ 30 30)))
(mh4 (int 32))
(dim1 (int 100))
(dim2 (int 12)))
; (def-cue lx5.7
; (xf 'up 10 'down 5 example-state))
|
