summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2020-07-02 22:47:15 +0200
committerThomas White <taw@physics.org>2020-07-02 22:47:15 +0200
commit047bb46e042d896470cd8ebbe5546e421149e10d (patch)
tree368e38260230c4e4822cc361d6c63c59648f5c51
parent3a53e4672af6e9d572d6c59e24e8559d35266b11 (diff)
Implement generic-rgb
-rw-r--r--guile/nanolight/fixture-library/generic.scm38
1 files changed, 37 insertions, 1 deletions
diff --git a/guile/nanolight/fixture-library/generic.scm b/guile/nanolight/fixture-library/generic.scm
index ff497b3..ef462fe 100644
--- a/guile/nanolight/fixture-library/generic.scm
+++ b/guile/nanolight/fixture-library/generic.scm
@@ -1,7 +1,9 @@
(define-module (nanolight fixture-library generic)
#:use-module (oop goops)
#:use-module (nanolight fixture)
- #:export (generic-dimmer))
+ #:export (generic-dimmer generic-rgb))
+
+(use-modules (srfi srfi-1))
(define (generic-dimmer)
@@ -11,3 +13,37 @@
#: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))))