From 047bb46e042d896470cd8ebbe5546e421149e10d Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 2 Jul 2020 22:47:15 +0200
Subject: Implement generic-rgb

---
 guile/nanolight/fixture-library/generic.scm | 38 ++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

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))))
-- 
cgit v1.2.3