From 44b815498461d4db0b6f553830b3cd8cd9480a85 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Tue, 29 Aug 2023 19:56:13 +0200
Subject: Fixture library: Add <generic-rgbw>

---
 guile/starlet/fixture-library/generic/rgb.scm | 29 ++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/guile/starlet/fixture-library/generic/rgb.scm b/guile/starlet/fixture-library/generic/rgb.scm
index 1b292af..a47b48d 100644
--- a/guile/starlet/fixture-library/generic/rgb.scm
+++ b/guile/starlet/fixture-library/generic/rgb.scm
@@ -24,7 +24,17 @@
   #:use-module (starlet attributes)
   #:use-module (starlet utils)
   #:use-module (starlet colours)
-  #:export (<generic-rgb>))
+  #:export (<generic-rgb>
+             <generic-rgbw>))
+
+
+(define (colour-as-rgbw-weirdness col weirdness)
+  (let ((rgb (colour-as-rgb col)))
+    (let ((w (* (- 1 weirdness) (apply min rgb))))
+      (list (- (red rgb) w)
+            (- (green rgb) w)
+            (- (blue rgb) w)
+            w))))
 
 
 (define-fixture
@@ -41,3 +51,20 @@
     (set-chan8 2 (percent->dmxval8 (* intensity 0.01 (cadr rgb))))
     (set-chan8 3 (percent->dmxval8 (* intensity 0.01 (caddr rgb))))))
 
+
+(define-fixture
+
+  <generic-rgbw>
+
+  (fixture-attributes
+    (attr-continuous intensity '(0 100) 0)
+    (attr-colour colour white)
+    (attr-continuous white-weirdness '(0 100) 0))
+
+  (let ((intensity (get-attr intensity))
+        (rgbw (colour-as-rgbw-weirdness (get-attr colour)
+                                        (/ (get-attr white-weirdness) 100))))
+    (set-chan8 1 (percent->dmxval8 (* 0.01 intensity (car rgbw))))
+    (set-chan8 2 (percent->dmxval8 (* 0.01 intensity (cadr rgbw))))
+    (set-chan8 3 (percent->dmxval8 (* 0.01 intensity (caddr rgbw))))
+    (set-chan8 4 (percent->dmxval8 (* 0.01 intensity (cadddr rgbw))))))
-- 
cgit v1.2.3