blob: b12d91a43d857b8124290e32b07236da80871818 (
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
|
(define-module (nanolight state)
#:export (combine-states print-state int flash))
(use-modules (nanolight fixture))
(use-modules (srfi srfi-1))
(define (find-fixture-attr fixture attr state)
(find (lambda (a) (and
(eq? (car a) fixture)
(eq? (cadr a) attr)))
state))
; Combine two states. Return combined list
(define (merge-states a b)
(let ((c '()))
(define (add-to-state add)
; Already in state?
(let ((attr (find-fixture-attr (car add) (cadr add) c)))
(if attr
(set-cdr! (last-pair attr) (cddr add)) ; add to existing list
(set! c (cons add c))))) ; add fixture+attr to state
(for-each add-to-state a)
(for-each add-to-state b)
c))
; Combine the first two states in the list
; Return a new list, one shorter than the input
(define (merge-first-two-states a)
(cons (merge-states (car a) (cadr a)) (cddr a)))
; Each argument is a "state", i.e. a list of these: (fixture attr function)
; Returns a combined state, with non-unique fixtures combined
(define (combine-states . a)
(cond
[(= (length a) 0) '()]
[(= (length a) 1) (car a)]
[else (apply combine-states (merge-first-two-states a))]))
(define (print-state st)
(define (print-statelet a)
(if (eq? (car a) #f)
(display "(oops! nothing)"))
(display (fixture-string (car a)))
(display " / ")
(display (cadr a))
(newline)
(for-each (lambda (b)
(display " ")
(display b)
(display " ---> ")
(display (b))
(newline))
(cddr a)))
(for-each print-statelet st))
; Helper functions
(define (hirestime)
(let ((a (gettimeofday)))
(+
(car a)
(/
(cdr a)
1000000))))
(define pi 3.141592653589793)
(define (square-wave hz)
(if (> (sin (* 2 pi hz (hirestime))) 0) 100 0))
(define (static-value attr value fixture)
(list (list fixture attr (lambda () value))))
; Useful source functions
(define (int value fixture)
(static-value 'intensity value fixture))
(define (pan value fixture)
(static-value 'pan value fixture))
(define (tilt value fixture)
(static-value 'tilt value fixture))
(define (flash hz fixture)
(list (list fixture 'intensity (lambda () (square-wave hz)))))
|
