From 8b937adbf3dffdb1f0ebedf8e31addda8390640f Mon Sep 17 00:00:00 2001
From: Thomas White <taw@bitwiz.me.uk>
Date: Sat, 5 Dec 2020 15:08:05 +0100
Subject: Add generic-rgb

---
 guile/starlet/fixture-library/generic.scm | 41 ++++++++++++++++++++++++++++++-
 1 file changed, 40 insertions(+), 1 deletion(-)

(limited to 'guile/starlet/fixture-library')

diff --git a/guile/starlet/fixture-library/generic.scm b/guile/starlet/fixture-library/generic.scm
index 7d75e57..5806788 100644
--- a/guile/starlet/fixture-library/generic.scm
+++ b/guile/starlet/fixture-library/generic.scm
@@ -1,7 +1,8 @@
 (define-module (starlet fixture-library generic)
   #:use-module (oop goops)
   #:use-module (starlet base)
-  #:export (<generic-dimmer>))
+  #:export (<generic-dimmer>
+            generic-rgb))
 
 (define-class <generic-dimmer> (<fixture>)
   (attributes
@@ -14,3 +15,41 @@
 
   ;; Set DMX value for intensity
   (set-chan 1 (percent->dmxval (get-attr 'intensity))))
+
+
+(define (chan->attr chan)
+  (attr-continuous chan '(0 100) 0))
+
+
+(define (generic-rgb chans)
+
+  (let ((new-class (make-class
+                    (list <fixture>)
+                    (list (cons 'attributes
+                                (list #:init-thunk
+                                      (lambda ()
+                                        (map chan->attr chans)))))
+                    #:name 'generic-rgb)))
+
+    (add-method!
+     scanout-fixture
+     (method ((fix new-class) get-attr set-chan set-chan-16bit)
+             (for-each
+
+              (lambda (chan offset)
+
+                (cond
+
+                 ((eq? chan '0)
+                  (set-chan offset 0))
+
+                 ((eq? chan 'FL)
+                  (set-chan offset 255))
+
+                 (else (set-chan offset
+                                 (percent->dmxval
+                                  (get-attr chan))))))
+
+              chans (iota (length chans) 1))))
+
+    new-class))
-- 
cgit v1.2.3