aboutsummaryrefslogtreecommitdiff
path: root/guile/starlet
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-04-06 21:45:15 +0200
committerThomas White <taw@physics.org>2021-04-06 23:05:44 +0200
commit686cad73eca73d9bbf7122e30bb5f433f0661b86 (patch)
treefadec0638ac245887817878b2e372286163da44e /guile/starlet
parent094e72b0e6215aa002a6a68951ba28521448185f (diff)
Initial abstraction layer for colours
Diffstat (limited to 'guile/starlet')
-rw-r--r--guile/starlet/base.scm17
-rw-r--r--guile/starlet/colours.scm45
-rw-r--r--guile/starlet/fixture-library/robe.scm13
-rw-r--r--guile/starlet/playback.scm24
4 files changed, 92 insertions, 7 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index ea7850c..bbb98e2 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -1,5 +1,6 @@
(define-module (starlet base)
#:use-module (starlet utils)
+ #:use-module (starlet colours)
#:use-module (oop goops)
#:use-module (ice-9 threads)
#:use-module (ice-9 atomic)
@@ -22,12 +23,14 @@
<fixture-attribute>
attr-continuous
attr-list
+ attr-colour
get-attr-type
get-attr-range
get-attr-name
get-attr-home-val
intensity?
continuous-attribute?
+ colour-attribute?
<starlet-state>
make-empty-state
@@ -207,6 +210,11 @@
(get-attr-type aobj)))
+(define (colour-attribute? aobj)
+ (eq? 'colour
+ (get-attr-type aobj)))
+
+
(define (append-or-replace-named-state orig-list name new-state)
(let ((new-list (map (lambda (st)
(if (eq? (get-state-name st) name)
@@ -520,6 +528,15 @@ pre-existing contents."
#:home-value attr-home-value))))
+(define-syntax attr-colour
+ (syntax-rules ()
+ ((_ attr-name attr-home-value)
+ (make <fixture-attribute>
+ #:name attr-name
+ #:type 'colour
+ #:home-value attr-home-value))))
+
+
(define current-state (make-parameter programmer-state))
diff --git a/guile/starlet/colours.scm b/guile/starlet/colours.scm
new file mode 100644
index 0000000..d390c5d
--- /dev/null
+++ b/guile/starlet/colours.scm
@@ -0,0 +1,45 @@
+(define-module (starlet colours)
+ #:use-module (oop goops)
+ #:export (<colour>
+ make-colour-cmy
+ make-colour-rgb
+ colour-as-cmy
+ white))
+
+
+(define-class <colour> (<object>)
+ (type
+ #:init-form (error "Colour type must be specified")
+ #:init-keyword #:type
+ #:getter colour-type)
+
+ (value
+ #:init-form (error "Colour value must be specified")
+ #:init-keyword #:value
+ #:getter colour-value))
+
+
+(define-method (write (col <colour>) port)
+ (format port "#<<colour> ~a ~a>"
+ (colour-type col)
+ (colour-value col)))
+
+
+(define (make-colour-cmy c m y)
+ (make <colour>
+ #:type 'cmy
+ #:value (list c m y)))
+
+
+(define (make-colour-rgb r g b)
+ (make <colour>
+ #:type 'rgb
+ #:value (list r g b)))
+
+
+(define white
+ (make-colour-cmy 0 0 0))
+
+
+(define (colour-as-cmy col)
+ (colour-value col))
diff --git a/guile/starlet/fixture-library/robe.scm b/guile/starlet/fixture-library/robe.scm
index 1dae94b..7654f69 100644
--- a/guile/starlet/fixture-library/robe.scm
+++ b/guile/starlet/fixture-library/robe.scm
@@ -1,6 +1,7 @@
(define-module (starlet fixture-library robe)
#:use-module (oop goops)
#:use-module (starlet base)
+ #:use-module (starlet colours)
#:export (<robe-dl7s-mode1>
<robe-mmxwashbeam-mode1>
<robe-mmxspot-mode1>))
@@ -127,9 +128,7 @@
(attr-list 'prism '(#t #f) #f)
(attr-list 'strobe '(#f #t random zap) #f)
(attr-continuous 'strobe-speed '(0 100) 50)
- (attr-continuous 'cyan '(0 100) 0)
- (attr-continuous 'magenta '(0 100) 0)
- (attr-continuous 'yellow '(0 100) 0)
+ (attr-colour 'colour white)
(attr-continuous 'iris '(0 100) 0)
(attr-continuous 'zoom '(0 100) 0)
(attr-continuous 'focus '(0 100) 0)
@@ -171,9 +170,11 @@
(uv . 110))
(get-attr 'colwheel)))
- (set-chan8 9 (percent->dmxval8 (get-attr 'cyan)))
- (set-chan8 10 (percent->dmxval8 (get-attr 'magenta)))
- (set-chan8 11 (percent->dmxval8 (get-attr 'yellow)))
+ (let ((cmy (colour-as-cmy (get-attr 'colour))))
+ (set-chan8 9 (percent->dmxval8 (car cmy)))
+ (set-chan8 10 (percent->dmxval8 (cadr cmy)))
+ (set-chan8 11 (percent->dmxval8 (caddr cmy))))
+
(set-chan8 35 (percent->dmxval8 (get-attr 'hotspot)))
(set-chan8 12 (scale-to-range (get-attr 'cto) '(3200 6900) '(0 255)))
(set-chan8 27 (scale-to-range (get-attr 'frost) '(0 100) '(0 179))))
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index c9153d8..9d372bf 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -304,7 +304,28 @@
(lambda (time)
(cond
((< time fade-start-time) start-val)
- ((> time (+ preset-start-time preset-time)) preset-val)
+ ((and (not (eq? 'no-value preset-val))
+ (> time (+ preset-start-time preset-time)))
+ preset-val)
+ (else target-val))))
+
+
+(define (make-colour-fade start-val
+ target-val
+ preset-val
+ fade-time
+ fade-start-time
+ preset-time
+ preset-start-time)
+ (lambda (time)
+ (cond
+
+ ((< time fade-start-time) start-val)
+
+ ((and (not (eq? 'no-value preset-val))
+ (> time (+ preset-start-time preset-time)))
+ preset-val)
+
(else target-val))))
@@ -449,6 +470,7 @@
(cond
((eq? type 'continuous) make-continuous-attr-fade)
((eq? type 'list) make-list-attr-fade)
+ ((eq? type 'colour) make-colour-fade)
(else
(raise-exception (make-exception
(make-exception-with-message