diff options
Diffstat (limited to 'guile')
| -rw-r--r-- | guile/starlet/fixture-library/generic/rgb.scm | 29 | ||||
| -rw-r--r-- | guile/starlet/open-sound-control/utils.scm | 119 |
2 files changed, 147 insertions, 1 deletions
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)))))) diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm index ae97c2c..567c2b3 100644 --- a/guile/starlet/open-sound-control/utils.scm +++ b/guile/starlet/open-sound-control/utils.scm @@ -26,6 +26,7 @@ #:use-module (starlet engine) #:use-module (starlet state) #:use-module (starlet utils) + #:use-module (starlet colours) #:use-module (open-sound-control client) #:use-module (open-sound-control server-thread) #:use-module (srfi srfi-1) @@ -36,6 +37,7 @@ osc-select-button osc-parameter-encoder osc-smart-potentiometer + osc-cmy-potentiometer osc-state-fader send-selection-updates-to)) @@ -346,3 +348,120 @@ (unless (eq? source potentiometer) (set-initial-vals smart-pot (current-values fixtures attr-name)) (reset-gradients smart-pot))))))) + + +(define (osc-cmy-potentiometer attr-name server addr c-pot-method m-pot-method y-pot-method) + + (let ((fixtures '()) + (colours '())) + + (let ((c-pot + (make-smart-potentiometer + server + addr + c-pot-method + (lambda (new-vals) + (set! colours + (map + (lambda (old-colour new-c) + (cmy new-c + (magenta old-colour) + (yellow old-colour))) + (map colour-as-cmy colours) new-vals)) + (for-each + (lambda (fix colour) + (set-in-state! programmer-state + fix + attr-name + colour + c-pot-method)) + fixtures colours)))) + + (m-pot + (make-smart-potentiometer + server + addr + m-pot-method + (lambda (new-vals) + (set! colours + (map + (lambda (old-colour new-m) + (cmy (cyan old-colour) + new-m + (yellow old-colour))) + (map colour-as-cmy colours) new-vals)) + (for-each + (lambda (fix colour) + (set-in-state! programmer-state + fix + attr-name + colour + m-pot-method)) + fixtures colours)))) + + (y-pot + (make-smart-potentiometer + server + addr + y-pot-method + (lambda (new-vals) + (set! colours + (map + (lambda (old-colour new-y) + (cmy (cyan old-colour) + (magenta old-colour) + new-y)) + (map colour-as-cmy colours) new-vals)) + (for-each + (lambda (fix colour) + (set-in-state! programmer-state + fix + attr-name + colour + y-pot-method)) + fixtures colours))))) + + (add-and-run-hook! + selection-hook + (lambda (selection) + (receive + (new-fixtures attrs) + (fixtures-with-attr selection attr-name) + (if (nil? new-fixtures) + (begin + (osc-send addr (string-append c-pot-method "/disable")) + (osc-send addr (string-append m-pot-method "/disable")) + (osc-send addr (string-append y-pot-method "/disable"))) + (begin + (set! fixtures new-fixtures) + (set-min-vals c-pot (map (lambda (x) 0) fixtures)) + (set-min-vals m-pot (map (lambda (x) 0) fixtures)) + (set-min-vals y-pot (map (lambda (x) 0) fixtures)) + (set-max-vals c-pot (map (lambda (x) 100) fixtures)) + (set-max-vals m-pot (map (lambda (x) 100) fixtures)) + (set-max-vals y-pot (map (lambda (x) 100) fixtures)) + (set! colours (current-values fixtures attr-name)) + (set-initial-vals c-pot (map cyan (map colour-as-cmy colours))) + (set-initial-vals m-pot (map magenta (map colour-as-cmy colours))) + (set-initial-vals y-pot (map yellow (map colour-as-cmy colours))) + (reset-gradients c-pot) + (reset-gradients m-pot) + (reset-gradients y-pot) + (osc-send addr (string-append c-pot-method "/enable")) + (osc-send addr (string-append m-pot-method "/enable")) + (osc-send addr (string-append y-pot-method "/enable")))))) + (get-selection)) + + (add-update-hook! + programmer-state + (lambda (source) + (unless (or (eq? source c-pot-method) + (eq? source m-pot-method) + (eq? source y-pot-method)) + (set! colours (current-values fixtures attr-name)) + (set-initial-vals c-pot (map cyan (map colour-as-cmy colours))) + (set-initial-vals m-pot (map magenta (map colour-as-cmy colours))) + (set-initial-vals y-pot (map yellow (map colour-as-cmy colours))) + (reset-gradients c-pot) + (reset-gradients m-pot) + (reset-gradients y-pot))))))) |