diff options
Diffstat (limited to 'guile/starlet')
| -rw-r--r-- | guile/starlet/base.scm | 17 | ||||
| -rw-r--r-- | guile/starlet/colours.scm | 45 | ||||
| -rw-r--r-- | guile/starlet/fixture-library/robe.scm | 13 | ||||
| -rw-r--r-- | guile/starlet/playback.scm | 24 |
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 |