diff options
| -rw-r--r-- | README.md | 32 | ||||
| -rw-r--r-- | examples/demo-show.scm | 4 | ||||
| -rw-r--r-- | guile/starlet/fixture-library/generic/rgb.scm | 29 | ||||
| -rw-r--r-- | guile/starlet/open-sound-control/utils.scm | 119 |
4 files changed, 171 insertions, 13 deletions
@@ -194,19 +194,27 @@ About the name Related projects ---------------- -Here are some related projects that I found especially interesting. -Amazingly, Starlet is not the only project to be found in the almost absurdly -specialised category of "Lisp-based stage lighting systems"! - -* [Afterglow](https://github.com/Deep-Symmetry/afterglow) Clojure live coding - environment using OLA -* [Fivetwelve-CSS](https://github.com/beyondscreen/fivetwelve-css) DMX lighting - control using CSS. [Watch this video](https://www.youtube.com/watch?v=ani_MOZt5_c) -* [QLC+](https://qlcplus.org/) the most popular open-source lighting control +In the almost absurdly specialised category of "Lisp-based stage lighting +systems", Starlet is far from being the only project: + +* [Lula](https://www.deinprogramm.de/sperber/lula/) is based on a very similar + concept, and predates Starlet by over two decades. Read + [this paper](https://doi.org/10.1145/507635.507652), which establishes a + formal basis for describing lighting states in code, and + [this thesis](https://bibliographie.uni-tuebingen.de/xmlui/bitstream/handle/10900/48174/pdf/lula-thesis.pdf?sequence=1) which goes into much more detail. +* [Afterglow](https://github.com/Deep-Symmetry/afterglow) is a live-coding + lighting controller based on Clojure. +* [Fivetwelve-CSS](https://github.com/beyondscreen/fivetwelve-css) Controls + lighting using CSS. It's not using Lisp, but it does use similar ideas about + composition. [Watch this video](https://www.youtube.com/watch?v=ani_MOZt5_c) + +You may also be interested in: + +* [Guile-OSC](https://github.com/taw10/guile-osc) - Open Sound Control library + for Guile Scheme. +* [QLC+](https://qlcplus.org/) - the most popular open-source lighting control program - -It's also worth taking a look at the -[stage-lighting topic](https://github.com/topics/stage-lighting) on Github. +* The [stage-lighting topic](https://github.com/topics/stage-lighting) on Github. Licence diff --git a/examples/demo-show.scm b/examples/demo-show.scm index 6f0dfe4..0195d56 100644 --- a/examples/demo-show.scm +++ b/examples/demo-show.scm @@ -121,6 +121,10 @@ (osc-parameter-encoder tilt osc-server x1k2 "/x1k2/encoders/2") (osc-parameter-encoder gobo osc-server x1k2 "/x1k2/encoders/3") (osc-parameter-encoder intensity osc-server x1k2 "/x1k2/encoders/6") +(osc-cmy-potentiometer colour osc-server x1k2 + "/x1k2/potentiometers/1" + "/x1k2/potentiometers/2" + "/x1k2/potentiometers/3") (osc-smart-potentiometer color-temperature osc-server x1k2 "/x1k2/potentiometers/4") (osc-state-fader osc-server x1k2 "/x1k2/faders/4" 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))))))) |