summaryrefslogtreecommitdiff
path: root/src/init.scm
blob: e2be7a21d42326c22ad8e30b14b0959d760a6331 (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
(define at
  (lambda (fix level)
    (if (list? fix)
      (for-each (lambda (q) (at q level)) fix)
      (set-intensity (find-fixture fixtures 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 "Generic dimmer") 'dim 48 0 1)
(patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)