blob: 9bc0552f426b06b9b04eb881a5d77496081aafa3 (
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
|
(define-module (nanolight fixture)
#:export (<fixture> <fixture-attribute>
patch-fixture
fixture-string get-address-string)
#:use-module (oop goops))
(define-class <fixture-attribute> (<object>)
(name
#:init-value 'unnamed-attribute
#:init-keyword #:name
#:getter name)
(offset
#:init-value 0
#:init-keyword #:offset
#:getter offset))
(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)))
; List of all patched fixtures (for scanout)
(define fixtures (list))
(define (add-fixture-to-roster fixture)
(set! fixtures (cons fixture fixtures)))
(define (fixture-string fixture)
(string-append
(get-friendly-name fixture)
" at "
(get-address-string fixture)))
(define (patch-fixture attributes universe start-addr friendly-name)
(let ((new-fixture (make <fixture>
#:attributes attributes
#:uni universe
#:sa start-addr
#:friendly-name friendly-name)))
(add-fixture-to-roster new-fixture)
new-fixture))
|
