blob: 6eb3c297d7a7eca2cd9d6a0bdf1935bfa2586276 (
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
(define-module (nanolight fixture)
#:use-module (oop goops)
#:use-module (ice-9 threads)
#:export (<fixture> <fixture-attribute>
make-output
patch-fixture show-state
fixture-string get-address-string
percent->dmxval
get-start-addr get-universe))
(define-class <fixture-attribute> (<object>)
(name
#:init-value 'unnamed-attribute
#:init-keyword #:name
#:getter name)
(offset
#:init-value 0
#:init-keyword #:offset
#:getter offset)
(continuous
#:init-value #t
#:init-keyword #:continuous
#:getter continuous)
(steps
#:init-value '()
#:init-keyword #:steps
#:getter steps
#:setter set-steps!))
(define-class <fixture> (<object>)
(attributes
#:init-value '()
#:init-keyword #:attributes)
(universe
#:init-value #f
#:init-keyword #:uni
#:getter get-universe
#:setter set-universe!)
(start-addr
#:init-value #f
#:init-keyword #:sa
#:getter get-start-addr
#:setter set-start-addr!)
(friendly-name
#:init-value "Fixture"
#:init-keyword #:friendly-name
#:getter get-friendly-name
#:setter set-friendly-name!)
(address-string
#:init-value #f
#:allocation #:virtual
#:getter get-address-string
#:slot-ref (lambda (a)
(string-append
(number->string (slot-ref a 'universe))
"."
(number->string (slot-ref a 'start-addr))))
#:slot-set! (lambda (a s) #f)))
(define (fixture-string fixture)
(string-append
(get-friendly-name fixture)
" at "
(get-address-string fixture)))
(define (patch-fixture output attributes universe start-addr friendly-name)
(let ((new-fixture (make <fixture>
#:attributes attributes
#:uni universe
#:sa start-addr
#:friendly-name friendly-name)))
(output 'add-fixture new-fixture)
new-fixture))
; FIXME: Clamp to range
(define (percent->dmxval val)
(/ (* 256 val) 100))
(define (show-state output state)
(output 'show-state state))
(define (scanout fixture-list)
(define (set-dmx universe addr nbytes value)
#f)
(define (scanout-fixture fixture)
#f)
(for-each scanout-fixture fixture-list))
(define (make-output)
; List of all patched fixtures (for scanout)
(let ((fixtures '()))
(define (run-scanout)
(scanout fixtures)
(yield)
(run-scanout))
(make-thread run-scanout)
(define (show-state state)
(display "Applying state:\n"))
(define (add-fixture fixture)
(set! fixtures (cons fixture fixtures)))
(lambda args
(apply
(case (car args)
((show-state) show-state)
((add-fixture) add-fixture)
(else => (error "Invalid method")))
(cdr args)))))
|
