diff options
Diffstat (limited to 'guile/starlet/fixture-library/generic/rgb.scm')
-rw-r--r-- | guile/starlet/fixture-library/generic/rgb.scm | 51 |
1 files changed, 39 insertions, 12 deletions
diff --git a/guile/starlet/fixture-library/generic/rgb.scm b/guile/starlet/fixture-library/generic/rgb.scm index 6fa281d..a47b48d 100644 --- a/guile/starlet/fixture-library/generic/rgb.scm +++ b/guile/starlet/fixture-library/generic/rgb.scm @@ -1,7 +1,7 @@ ;; ;; starlet/fixture-library/generic/rgb.scm ;; -;; Copyright © 2020-2021 Thomas White <taw@bitwiz.org.uk> +;; Copyright © 2020-2022 Thomas White <taw@bitwiz.org.uk> ;; ;; This file is part of Starlet. ;; @@ -19,25 +19,52 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; (define-module (starlet fixture-library generic rgb) - #:use-module (oop goops) + #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) + #:use-module (starlet utils) #:use-module (starlet colours) - #:export (<generic-rgb>)) + #:export (<generic-rgb> + <generic-rgbw>)) -(define-class <generic-rgb> (<fixture>) - (attributes - #:init-form (list - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white)))) +(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-method (scanout-fixture (fixture <generic-rgb>) - get-attr set-chan8 set-chan16) +(define-fixture - (let ((intensity (get-attr 'intensity)) - (rgb (colour-as-rgb (get-attr 'colour)))) + <generic-rgb> + + (fixture-attributes + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white)) + + (let ((intensity (get-attr intensity)) + (rgb (colour-as-rgb (get-attr colour)))) (set-chan8 1 (percent->dmxval8 (* intensity 0.01 (car rgb)))) (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)))))) |