summaryrefslogtreecommitdiff
path: root/guile/nanolight/fixture-library/generic.scm
blob: ef462fe61e93cec133a911438a3e97f6b8b0e75c (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
(define-module (nanolight fixture-library generic)
  #:use-module (oop goops)
  #:use-module (nanolight fixture)
  #:export (generic-dimmer generic-rgb))

(use-modules (srfi srfi-1))


(define (generic-dimmer)
  (list
    (make <fixture-attribute> #:name 'intensity
      #:range '(0 100) #:type 'continuous #:home-value 0
      #:translator (lambda (universe start-addr value set-dmx)
                     (set-dmx universe start-addr
                       (percent->dmxval value))))))


(define (feature-char->attr-name c)
  (case c
    ((i) 'intensity)
    ((r) 'red)
    ((g) 'green)
    ((b) 'blue)
    ((w) 'white)
    (else
     (error "Unrecognised symbol for generic RGB fixture" c))))


(define (generic-rgb feature-list)
  (lambda ()
    (fold
     (lambda (feature addr-offset list-so-far)
       (if (eq? feature 0)
           list-so-far
           (cons
            (make <fixture-attribute>
              #:name (feature-char->attr-name feature)
              #:range '(0 100)
              #:type 'continuous
              #:home-value 0
              #:translator (lambda (universe start-addr value set-dmx)
                             (set-dmx universe
                                      (+ start-addr addr-offset)
                                      (percent->dmxval value))))
            list-so-far)))

     '()
     feature-list
     (iota (length feature-list) 0))))