diff options
Diffstat (limited to 'guile')
20 files changed, 257 insertions, 157 deletions
diff --git a/guile/starlet/attributes.scm b/guile/starlet/attributes.scm new file mode 100644 index 0000000..7d2a561 --- /dev/null +++ b/guile/starlet/attributes.scm @@ -0,0 +1,82 @@ +;; +;; starlet/attributes.scm +;; +;; Copyright © 2022 Thomas White <taw@bitwiz.org.uk> +;; +;; This file is part of Starlet. +;; +;; Starlet is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; +(define-module (starlet attributes) + #:use-module (oop goops) + #:export (<starlet-attribute> + make-attribute + attribute? + intensity? + canonical-name)) + + +(define-class <starlet-attribute> (<object>) + (canonical-name + #:init-keyword #:name + #:getter canonical-name)) + +(define (make-attribute canonical-name) + (make <starlet-attribute> + #:name canonical-name)) + +(define (attribute? a) + (is-a? a <starlet-attribute>)) + +(define-method (write (attribute <starlet-attribute>) port) + (write + (canonical-name attribute) + port)) + +(define-method (canonical-name whatever) + whatever) + + +;; The standard attribute names +;; Note that this list says nothing about the interpretation of the values +;; - that's left to the individual fixture definitions. +(define-public intensity (make-attribute 'intensity)) +(define-public colour (make-attribute 'colour)) +(define-public colour-temperature (make-attribute 'colour-temperature)) +(define-public strobe (make-attribute 'strobe)) +(define-public strobe-frequency (make-attribute 'strobe-frequency)) +(define-public pan (make-attribute 'pan)) +(define-public tilt (make-attribute 'tilt)) +(define-public prism (make-attribute 'prism)) +(define-public frost (make-attribute 'frost)) +(define-public hotspot (make-attribute 'hotspot)) +(define-public iris (make-attribute 'iris)) +(define-public zoom (make-attribute 'zoom)) +(define-public barndoor-rotation (make-attribute 'barndoor-rotation)) +(define-public barndoor1 (make-attribute 'barndoor1)) +(define-public barndoor2 (make-attribute 'barndoor2)) +(define-public barndoor3 (make-attribute 'barndoor3)) +(define-public barndoor4 (make-attribute 'barndoor4)) +(define-public beamtype (make-attribute 'beamtype)) +(define-public colwheel (make-attribute 'colwheel)) +(define-public gobo (make-attribute 'gobo)) + +;; Duplicate names for convenience... +(define-public color colour) +(define-public color-temperature colour-temperature) + + +(define (intensity? a) + (eq? intensity a)) + diff --git a/guile/starlet/crossfade.scm b/guile/starlet/crossfade.scm index 241f295..047fce9 100644 --- a/guile/starlet/crossfade.scm +++ b/guile/starlet/crossfade.scm @@ -31,6 +31,7 @@ #:use-module (starlet fixture) #:use-module (starlet state) #:use-module (starlet transition-effect) + #:use-module (starlet attributes) #:export (crossfade)) diff --git a/guile/starlet/cue-list.scm b/guile/starlet/cue-list.scm index 0684a56..681158f 100644 --- a/guile/starlet/cue-list.scm +++ b/guile/starlet/cue-list.scm @@ -32,6 +32,7 @@ #:use-module (starlet state) #:use-module (starlet clock) #:use-module (starlet utils) + #:use-module (starlet attributes) #:use-module (starlet transition-effect) #:use-module (starlet snap-transition) #:use-module (starlet crossfade) @@ -192,7 +193,7 @@ (define (fixture-dark-in-cue? fix the-cue) (every (lambda (part) - (dark? (state-find fix 'intensity (get-cue-part-state part)))) + (dark? (state-find fix intensity (get-cue-part-state part)))) (get-cue-parts the-cue))) diff --git a/guile/starlet/effects.scm b/guile/starlet/effects.scm index b6bfd2a..0a23dee 100644 --- a/guile/starlet/effects.scm +++ b/guile/starlet/effects.scm @@ -21,6 +21,7 @@ (define-module (starlet effects) #:use-module (starlet clock) #:use-module (starlet state) + #:use-module (starlet attributes) #:export (flash sinewave flash-chase)) @@ -61,7 +62,7 @@ (let ((clock (make-clock))) (for-each (lambda (fix idx) - (at fix 'intensity + (at fix intensity (lambda () (hump (- (euclidean-remainder (elapsed-time clock) repeat-time) diff --git a/guile/starlet/fixture-library/adj/mega-tripar-profile.scm b/guile/starlet/fixture-library/adj/mega-tripar-profile.scm index 90a84f6..4815fa9 100644 --- a/guile/starlet/fixture-library/adj/mega-tripar-profile.scm +++ b/guile/starlet/fixture-library/adj/mega-tripar-profile.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library adj mega-tripar-profile) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:use-module (starlet colours) #:export (<adj-mega-tripar-profile-3ch> @@ -34,11 +35,11 @@ <adj-mega-tripar-profile-3ch> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white)) + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white)) - (let ((intensity (/ (get-attr 'intensity) 100)) - (rgb (colour-as-rgb (get-attr 'colour)))) + (let ((intensity (/ (get-attr intensity) 100)) + (rgb (colour-as-rgb (get-attr colour)))) (set-chan8 1 (percent->dmxval8 (* intensity (car rgb)))) (set-chan8 2 (percent->dmxval8 (* intensity (cadr rgb)))) (set-chan8 3 (percent->dmxval8 (* intensity (caddr rgb)))))) @@ -51,11 +52,11 @@ <adj-mega-tripar-profile-4ch> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white)) + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white)) - (let ((rgb (colour-as-rgb (get-attr 'colour)))) - (set-chan8 1 (percent->dmxval8 (get-attr 'intensity))) + (let ((rgb (colour-as-rgb (get-attr colour)))) + (set-chan8 1 (percent->dmxval8 (get-attr intensity))) (set-chan8 2 (percent->dmxval8 (car rgb))) (set-chan8 3 (percent->dmxval8 (cadr rgb))) (set-chan8 4 (percent->dmxval8 (caddr rgb))))) diff --git a/guile/starlet/fixture-library/chauvet/mav2.scm b/guile/starlet/fixture-library/chauvet/mav2.scm index d79e73e..5fae168 100644 --- a/guile/starlet/fixture-library/chauvet/mav2.scm +++ b/guile/starlet/fixture-library/chauvet/mav2.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library chauvet mav2) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:use-module (starlet colours) #:export (<chauvet-mav2-32ch>)) @@ -31,19 +32,19 @@ <chauvet-mav2-32ch> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-continuous 'pan '(0 540) 270) - (attr-continuous 'tilt '(0 270) 135) - (attr-continuous 'cyan '(0 100) 0) - (attr-continuous 'magenta '(0 100) 0) - (attr-continuous 'yellow '(0 100) 0)) + (attr-continuous intensity '(0 100) 0) + (attr-continuous pan '(0 540) 270) + (attr-continuous tilt '(0 270) 135) + (attr-continuous cyan '(0 100) 0) + (attr-continuous magenta '(0 100) 0) + (attr-continuous yellow '(0 100) 0)) - (set-chan-16bit 1 (get-attr 'pan) 540) - (set-chan-16bit 3 (get-attr 'tilt) 270) - (set-chan-16bit 6 (get-attr 'intensity) 100) + (set-chan-16bit 1 (get-attr pan) 540) + (set-chan-16bit 3 (get-attr tilt) 270) + (set-chan-16bit 6 (get-attr intensity) 100) - (set-chan 10 (percent->dmxval (get-attr 'cyan))) - (set-chan 11 (percent->dmxval (get-attr 'magenta))) - (set-chan 12 (percent->dmxval (get-attr 'yellow))) + (set-chan 10 (percent->dmxval (get-attr cyan))) + (set-chan 11 (percent->dmxval (get-attr magenta))) + (set-chan 12 (percent->dmxval (get-attr yellow))) (set-chan 8 255)) diff --git a/guile/starlet/fixture-library/generic/dimmer.scm b/guile/starlet/fixture-library/generic/dimmer.scm index e823dc7..6b25c15 100644 --- a/guile/starlet/fixture-library/generic/dimmer.scm +++ b/guile/starlet/fixture-library/generic/dimmer.scm @@ -22,6 +22,7 @@ #:use-module (starlet scanout) #:use-module (starlet fixture) #:use-module (starlet utils) + #:use-module (starlet attributes) #:export (<generic-dimmer>)) (define-fixture @@ -29,7 +30,7 @@ <generic-dimmer> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0)) + (attr-continuous intensity '(0 100) 0)) - (set-chan8 1 (percent->dmxval8 (get-attr 'intensity)))) + (set-chan8 1 (percent->dmxval8 (get-attr intensity)))) diff --git a/guile/starlet/fixture-library/generic/rgb.scm b/guile/starlet/fixture-library/generic/rgb.scm index 4c2eb11..1b292af 100644 --- a/guile/starlet/fixture-library/generic/rgb.scm +++ b/guile/starlet/fixture-library/generic/rgb.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library generic rgb) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:use-module (starlet colours) #:export (<generic-rgb>)) @@ -31,11 +32,11 @@ <generic-rgb> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white)) + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white)) - (let ((intensity (get-attr 'intensity)) - (rgb (colour-as-rgb (get-attr 'colour)))) + (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)))))) diff --git a/guile/starlet/fixture-library/robe/dl7s.scm b/guile/starlet/fixture-library/robe/dl7s.scm index f64de19..c733731 100644 --- a/guile/starlet/fixture-library/robe/dl7s.scm +++ b/guile/starlet/fixture-library/robe/dl7s.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library robe dl7s) #:use-module (oop goops) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet colours) #:export (<robe-dl7s-mode1>)) @@ -30,31 +31,31 @@ <robe-dl7s-mode1> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-continuous 'pan '(0 540) 270) - (attr-continuous 'tilt '(0 270) 135) - (attr-list 'strobe '(#t #f) #f) - (attr-list 'prism '(#t #f) #f) - (attr-colour 'colour white) - (attr-continuous 'colour-temperature '(2700 8000) 3200)) + (attr-continuous intensity '(0 100) 0) + (attr-continuous pan '(0 540) 270) + (attr-continuous tilt '(0 270) 135) + (attr-list strobe '(#t #f) #f) + (attr-list prism '(#t #f) #f) + (attr-colour colour white) + (attr-continuous colour-temperature '(2700 8000) 3200)) - (set-chan16 50 (percent->dmxval16 (get-attr 'intensity))) + (set-chan16 50 (percent->dmxval16 (get-attr intensity))) - (set-chan16 1 (scale-to-range (get-attr 'pan) '(0 540) '(0 65535))) - (set-chan16 3 (scale-to-range (get-attr 'tilt) (0 270) '(0 65535))) + (set-chan16 1 (scale-to-range (get-attr pan) '(0 540) '(0 65535))) + (set-chan16 3 (scale-to-range (get-attr tilt) (0 270) '(0 65535))) - (set-chan8 49 (if (get-attr 'strobe) 95 32)) + (set-chan8 49 (if (get-attr strobe) 95 32)) - (set-chan8 28 (if (get-attr 'prism) 50 0)) + (set-chan8 28 (if (get-attr prism) 50 0)) (set-chan8 6 0) ;; Power/special function: default (set-chan8 7 0) ;; Colour mode: default (set-chan8 15 - (scale-and-clamp-to-range (get-attr 'colour-temperature) + (scale-and-clamp-to-range (get-attr colour-temperature) '(8000 2700) '(0 255))) - (let ((cmy (colour-as-cmy (get-attr 'colour)))) + (let ((cmy (colour-as-cmy (get-attr colour)))) (set-chan16 9 (percent->dmxval16 (car cmy))) (set-chan16 11 (percent->dmxval16 (cadr cmy))) (set-chan16 13 (percent->dmxval16 (caddr cmy))))) diff --git a/guile/starlet/fixture-library/robe/mmxspot.scm b/guile/starlet/fixture-library/robe/mmxspot.scm index bd399be..1f37299 100644 --- a/guile/starlet/fixture-library/robe/mmxspot.scm +++ b/guile/starlet/fixture-library/robe/mmxspot.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library robe mmxspot) #:use-module (oop goops) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet colours) #:export (<robe-mmxspot-mode1>)) @@ -30,41 +31,42 @@ <robe-mmxspot-mode1> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-continuous 'pan '(0 540) 270) - (attr-continuous 'tilt '(0 270) 135) - (attr-list 'colwheel '(#f red blue orange green amber uv) #f) - (attr-list 'prism '(#t #f) #f) - (attr-list 'strobe '(#f #t random zap) #f) - (attr-continuous 'strobe-speed '(0 100) 50) - (attr-colour 'colour white) - (attr-continuous 'iris '(0 100) 0) - (attr-continuous 'zoom '(0 100) 0) - (attr-continuous 'focus '(0 100) 0) - (attr-continuous 'hotspot '(0 100) 0) - (attr-continuous 'frost '(0 100) 0) - (attr-continuous 'cto '(3200 6900) 6900)) + (attr-continuous intensity '(0 100) 0) + (attr-continuous pan '(0 540) 270) + (attr-continuous tilt '(0 270) 135) + (attr-list colwheel '(#f red blue orange green amber uv) #f) + (attr-list prism '(#t #f) #f) + (attr-list strobe '(off on random zap) off) + (attr-continuous strobe-frequency '(0 100) 50) + (attr-colour colour white) + (attr-continuous iris '(0 100) 0) + (attr-continuous zoom '(0 100) 0) + (attr-continuous focus '(0 100) 0) + (attr-continuous hotspot '(0 100) 0) + (attr-continuous frost '(0 100) 0) + (attr-continuous cto '(3200 6900) 6900)) - (set-chan16 37 (percent->dmxval16 (get-attr 'intensity))) + (set-chan16 37 (percent->dmxval16 (get-attr intensity))) - (set-chan16 1 (scale-to-range (get-attr 'pan) '(0 540) '(0 65535))) + (set-chan16 1 (scale-to-range (get-attr pan) '(0 540) '(0 65535))) - (set-chan16 3 (scale-to-range (get-attr 'tilt) '(0 270) '(0 65535))) + (set-chan16 3 (scale-to-range (get-attr tilt) '(0 270) '(0 65535))) - (set-chan16 28 (scale-to-range (get-attr 'iris) '(0 100) '(0 45567))) - (set-chan16 30 (percent->dmxval16 (get-attr 'zoom))) - (set-chan16 32 (percent->dmxval16 (get-attr 'focus))) + (set-chan16 28 (scale-to-range (get-attr iris) '(0 100) '(0 45567))) + (set-chan16 30 (percent->dmxval16 (get-attr zoom))) + (set-chan16 32 (percent->dmxval16 (get-attr focus))) (set-chan8 36 - (let ((strb (get-attr 'strobe)) - (spd (get-attr 'strobe-speed))) + (let ((strb (get-attr strobe)) + (spd (get-attr strobe-speed))) (cond - ((eq? strb #t) (scale-to-range spd '(0 100) '(64 95))) + ;; FIXME: Check the frequencies + ((eq? strb 'on) (scale-to-range spd '(0 100) '(64 95))) ((eq? strb 'random) (scale-to-range spd '(0 100) '(192 223))) ((eq? strb 'zap) (scale-to-range spd '(0 100) '(160 191))) (else 255)))) - (set-chan8 25 (if (get-attr 'prism) 20 0)) + (set-chan8 25 (if (get-attr prism) 20 0)) (set-chan8 7 (assv-ref '((#f . 0) (red . 18) @@ -73,13 +75,13 @@ (green . 73) (amber . 91) (uv . 110)) - (get-attr 'colwheel))) + (get-attr colwheel))) - (let ((cmy (colour-as-cmy (get-attr 'colour)))) + (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)))) + (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/fixture-library/robe/mmxwashbeam.scm b/guile/starlet/fixture-library/robe/mmxwashbeam.scm index 282bd0f..a41c80d 100644 --- a/guile/starlet/fixture-library/robe/mmxwashbeam.scm +++ b/guile/starlet/fixture-library/robe/mmxwashbeam.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library robe mmxwashbeam) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:use-module (starlet colours) #:export (<robe-mmxwashbeam-mode1>)) @@ -31,37 +32,37 @@ <robe-mmxwashbeam-mode1> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-continuous 'pan '(0 540) 270) - (attr-continuous 'tilt '(0 270) 135) - (attr-list 'strobe '(#t #f) #f) - (attr-list 'colwheel '(#f red blue orange green amber uv) #f) - (attr-list 'gobo '(#f iris gobo1 gobo2 gobo3 gobo4 gobo5 gobo6) #f) - (attr-list 'beamtype '(beam beamwash beamwashext) 'beam) - (attr-colour 'colour white) - (attr-continuous 'zoom '(0 100) 0) - (attr-continuous 'focus '(0 100) 0) - (attr-continuous 'barndoor-rot '(0 180) 90) - (attr-continuous 'barndoor1 '(0 180) 0) - (attr-continuous 'barndoor2 '(0 100) 0) - (attr-continuous 'barndoor3 '(0 100) 0) - (attr-continuous 'barndoor4 '(0 100) 0)) + (attr-continuous intensity '(0 100) 0) + (attr-continuous pan '(0 540) 270) + (attr-continuous tilt '(0 270) 135) + (attr-list strobe '(#t #f) #f) + (attr-list colwheel '(#f red blue orange green amber uv) #f) + (attr-list gobo '(#f iris gobo1 gobo2 gobo3 gobo4 gobo5 gobo6) #f) + (attr-list beamtype '(beam beamwash beamwashext) 'beam) + (attr-colour colour white) + (attr-continuous zoom '(0 100) 0) + (attr-continuous focus '(0 100) 0) + (attr-continuous barndoor-rot '(0 180) 90) + (attr-continuous barndoor1 '(0 180) 0) + (attr-continuous barndoor2 '(0 100) 0) + (attr-continuous barndoor3 '(0 100) 0) + (attr-continuous barndoor4 '(0 100) 0)) - (set-chan16 33 (percent->dmxval16 (get-attr 'intensity))) + (set-chan16 33 (percent->dmxval16 (get-attr intensity))) - (set-chan16 1 (scale-to-range (get-attr 'pan) '(0 540) '(0 65535))) - (set-chan16 3 (scale-to-range (get-attr 'tilt) '(0 270) '(0 65535))) + (set-chan16 1 (scale-to-range (get-attr pan) '(0 540) '(0 65535))) + (set-chan16 3 (scale-to-range (get-attr tilt) '(0 270) '(0 65535))) - (set-chan8 32 (if (get-attr 'strobe) 70 255)) + (set-chan8 32 (if (get-attr strobe) 70 255)) - (set-chan16 19 (percent->dmxval16 (get-attr 'zoom))) - (set-chan16 21 (percent->dmxval16 (get-attr 'focus))) + (set-chan16 19 (percent->dmxval16 (get-attr zoom))) + (set-chan16 21 (percent->dmxval16 (get-attr focus))) - ;;(set-chan 24 (number->dmxval (get-attr 'barndoor-rot) '(0 180))) - (set-chan8 25 (percent->dmxval8 (get-attr 'barndoor1))) - (set-chan8 26 (percent->dmxval8 (get-attr 'barndoor2))) - (set-chan8 27 (percent->dmxval8 (get-attr 'barndoor3))) - (set-chan8 28 (percent->dmxval8 (get-attr 'barndoor4))) + ;;(set-chan 24 (number->dmxval (get-attr barndoor-rot) '(0 180))) + (set-chan8 25 (percent->dmxval8 (get-attr barndoor1))) + (set-chan8 26 (percent->dmxval8 (get-attr barndoor2))) + (set-chan8 27 (percent->dmxval8 (get-attr barndoor3))) + (set-chan8 28 (percent->dmxval8 (get-attr barndoor4))) (set-chan8 7 (assv-ref '((#f . 0) (red . 18) @@ -70,7 +71,7 @@ (green . 73) (amber . 91) (uv . 110)) - (get-attr 'colwheel))) + (get-attr colwheel))) (set-chan8 15 (assv-ref '((#f . 0) (iris . 5) @@ -80,14 +81,14 @@ (gobo4 . 22) (gobo5 . 26) (gobo6 . 30)) - (get-attr 'gobo))) + (get-attr gobo))) (set-chan8 18 (assv-ref '((beam . 0) (beamwash . 35) (beamwashext . 45)) - (get-attr 'beamtype))) + (get-attr beamtype))) - (let ((cmy (colour-as-cmy (get-attr 'colour)))) + (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))))) diff --git a/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm b/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm index cbabe1e..b3320b2 100644 --- a/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm +++ b/guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library stairville octagon-theater-cw-ww) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:export (<stairville-octagon-theater-cw-ww>)) @@ -29,22 +30,22 @@ <stairville-octagon-theater-cw-ww> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-continuous 'colour-temperature '(2800 6400) 3200) - (attr-list 'strobe '(#f #t) #f) + (attr-continuous intensity '(0 100) 0) + (attr-continuous colour-temperature '(2800 6400) 3200) + (attr-list strobe '(#f #t) #f) ;; FIXME: Strobe frequency is not stated in manual. ;; I've assumed that "slow" means 1 Hz, "fast" 25 Hz - (attr-continuous 'strobe-frequency '(1 25) 1)) + (attr-continuous strobe-frequency '(1 25) 1)) - (let ((coltemp (get-attr 'colour-temperature))) + (let ((coltemp (get-attr colour-temperature))) (set-chan8 1 (scale-and-clamp-to-range coltemp '(2800 6400) '(0 255))) (set-chan8 2 (scale-and-clamp-to-range coltemp '(2800 6400) '(255 0)))) - (if (get-attr 'strobe) + (if (get-attr strobe) (set-chan8 3 (scale-and-clamp-to-range - (get-attr 'strobe-frequency) + (get-attr strobe-frequency) '(1 25) '(16 255))) (set-chan8 3 0)) (set-chan8 3 0) ;; Strobe (set-chan8 4 0) ;; Mode (0-15 = direct control) - (set-chan8 5 (percent->dmxval8 (get-attr 'intensity)))) + (set-chan8 5 (percent->dmxval8 (get-attr intensity)))) diff --git a/guile/starlet/fixture-library/stairville/z120m.scm b/guile/starlet/fixture-library/stairville/z120m.scm index 46cd6cd..e1f40af 100644 --- a/guile/starlet/fixture-library/stairville/z120m.scm +++ b/guile/starlet/fixture-library/stairville/z120m.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture-library stairville z120m) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet utils) #:use-module (starlet colours) #:export (<stairville-z120m-6ch>)) @@ -30,27 +31,27 @@ <stairville-z120m-6ch> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white) - (attr-continuous 'strobe-frequency '(1 25) 1) - (attr-list 'strobe '(off on random) 'off)) + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white) + (attr-continuous strobe-frequency '(1 25) 1) + (attr-list strobe '(off on random) 'off)) - (let ((intensity (get-attr 'intensity)) - (rgbw (colour-as-rgbw (get-attr 'colour)))) + (let ((intensity (get-attr intensity)) + (rgbw (colour-as-rgbw (get-attr colour)))) (set-chan8 1 (percent->dmxval8 intensity)) (set-chan8 3 (percent->dmxval8 (car rgbw))) (set-chan8 4 (percent->dmxval8 (cadr rgbw))) (set-chan8 5 (percent->dmxval8 (caddr rgbw))) (set-chan8 6 (percent->dmxval8 (cadddr rgbw)))) (cond - ((eq? (get-attr 'strobe) 'on) + ((eq? (get-attr strobe) 'on) (set-chan8 2 (scale-and-clamp-to-range (get-attr 'strobe-frequency) '(1 25) '(106 165)))) - ((eq? (get-attr 'strobe) 'random) + ((eq? (get-attr strobe) 'random) (set-chan8 2 (scale-and-clamp-to-range - (get-attr 'strobe-frequency) + (get-attr strobe-frequency) '(1 25) '(181 240)))) (else (set-chan8 2 255)))) diff --git a/guile/starlet/fixture-library/tadm/led-bar.scm b/guile/starlet/fixture-library/tadm/led-bar.scm index 07ccff1..45c4e34 100644 --- a/guile/starlet/fixture-library/tadm/led-bar.scm +++ b/guile/starlet/fixture-library/tadm/led-bar.scm @@ -21,8 +21,10 @@ (define-module (starlet fixture-library tadm led-bar) #:use-module (starlet scanout) #:use-module (starlet fixture) + #:use-module (starlet attributes) #:use-module (starlet colours) #:use-module (starlet utils) + #:use-module (starlet attributes) #:export (<tadm-led-bar>)) (define-fixture @@ -30,11 +32,11 @@ <tadm-led-bar> (fixture-attributes - (attr-continuous 'intensity '(0 100) 0) - (attr-colour 'colour white)) + (attr-continuous intensity '(0 100) 0) + (attr-colour colour white)) - (let ((intensity (get-attr 'intensity)) - (rgb (colour-as-rgb (get-attr 'colour)))) + (let ((intensity (get-attr intensity)) + (rgb (colour-as-rgb (get-attr colour)))) (set-chan8 1 17) (set-chan8 2 (percent->dmxval8 intensity)) (set-chan8 3 0) diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm index 58616b3..b1a3e32 100644 --- a/guile/starlet/fixture.scm +++ b/guile/starlet/fixture.scm @@ -21,6 +21,7 @@ (define-module (starlet fixture) #:use-module (starlet colours) #:use-module (starlet utils) + #:use-module (starlet attributes) #:use-module (oop goops) #:use-module (ice-9 exceptions) #:use-module (srfi srfi-1) @@ -42,8 +43,7 @@ get-attr-range get-attr-home-val continuous-attribute? - colour-attribute? - intensity?)) + colour-attribute?)) (define-class <fixture-attribute> (<object>) @@ -138,7 +138,7 @@ (is-a? f <fixture>)) -(define-method (find-attr (fix <fixture>) (attr-name <symbol>)) +(define-method (find-attr (fix <fixture>) (attr-name <starlet-attribute>)) (find (lambda (a) (eq? (get-attr-name a) attr-name)) @@ -146,7 +146,7 @@ (define-method (find-attr (fix <fixture>) (attr-name <colour-component-id>)) - (find-attr fix 'colour)) + (find-attr fix colour)) (define-method (find-attr fix attr-name) @@ -156,7 +156,7 @@ (make-exception-with-irritants fix)))) -(define-method (get-attr-home-val (fix <fixture>) (attr <symbol>)) +(define-method (get-attr-home-val (fix <fixture>) (attr <starlet-attribute>)) (let ((attr-obj (find-attr fix attr))) (if attr-obj (attr-home-value attr-obj) @@ -165,14 +165,10 @@ (define-method (get-attr-home-val (fix <fixture>) (attr <colour-component-id>)) (extract-colour-component - (get-attr-home-val fix 'colour) + (get-attr-home-val fix colour) attr)) -(define (intensity? a) - (eq? 'intensity a)) - - (define (continuous-attribute? aobj) (eq? 'continuous (get-attr-type aobj))) diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm index df47b76..70cff66 100644 --- a/guile/starlet/midi-control/faders.scm +++ b/guile/starlet/midi-control/faders.scm @@ -25,6 +25,7 @@ #:use-module (starlet colours) #:use-module (starlet scanout) #:use-module (starlet utils) + #:use-module (starlet attributes) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index e7beb84..551c023 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -36,6 +36,7 @@ #:use-module (starlet cue-list) #:use-module (starlet colours) #:use-module (starlet transition-effect) + #:use-module (starlet attributes) #:export (make-playback cut-to-cue-number! get-playback-cue-number diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm index 6344cf7..8329668 100644 --- a/guile/starlet/scanout.scm +++ b/guile/starlet/scanout.scm @@ -23,6 +23,7 @@ #:use-module (starlet state) #:use-module (starlet utils) #:use-module (starlet colours) + #:use-module (starlet attributes) #:use-module (starlet guile-ola) #:use-module (oop goops) #:use-module (ice-9 threads) @@ -131,7 +132,7 @@ 'no-value))) -(define-method (current-value (fix <fixture>) (attr-name <symbol>)) +(define-method (current-value (fix <fixture>) (attr-name <starlet-attribute>)) (let ((programmer-val (state-find fix attr-name programmer-state))) (if (eq? 'no-value programmer-val) diff --git a/guile/starlet/snap-transition.scm b/guile/starlet/snap-transition.scm index dab6b05..e658b73 100644 --- a/guile/starlet/snap-transition.scm +++ b/guile/starlet/snap-transition.scm @@ -24,6 +24,7 @@ #:use-module (starlet state) #:use-module (starlet fixture) #:use-module (starlet transition-effect) + #:use-module (starlet attributes) #:export (snap)) diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm index b5b26cd..08b9c8d 100644 --- a/guile/starlet/state.scm +++ b/guile/starlet/state.scm @@ -22,6 +22,7 @@ #:use-module (starlet fixture) #:use-module (starlet colours) #:use-module (starlet utils) + #:use-module (starlet attributes) #:use-module (oop goops) #:use-module (ice-9 pretty-print) #:use-module (ice-9 atomic) @@ -66,7 +67,7 @@ ;; A "state" is an atomically-updating container for an immutable -;; hash table mapping (fixture-object . attribute-symbol) pairs to values +;; hash table mapping (fixture-object . attribute-name-object) pairs to values ;; which can be numbers, symbols, colours, boolean values and more ;; depending on the type of attribute. Values can also be ;; functions which provide the value. @@ -174,7 +175,7 @@ (define-method (set-in-state! (state <starlet-state>) (fix <fixture>) - (attr <symbol>) + (attr <starlet-attribute>) value source) (let* ((old-ht (atomic-box-ref (get-ht-box state))) @@ -194,7 +195,7 @@ (define-method (set-in-state! (state <starlet-state>) (fix <fixture>) - (attr <symbol>) + (attr <starlet-attribute>) value) (set-in-state! state fix attr value #f)) @@ -251,7 +252,7 @@ (define-method (state-find (fix <fixture>) - (attr <symbol>) + (attr <starlet-attribute>) (state <starlet-state>)) (hash-ref (atomic-box-ref (get-ht-box state)) (cons fix attr) @@ -350,7 +351,7 @@ pre-existing contents." (state-map->list (lambda (fix attr val) (list 'at (get-fixture-name fix) - (list 'quote attr) + (canonical-name attr) (clamp-to-attr-range fix attr val))) a))) @@ -386,55 +387,57 @@ pre-existing contents." (define fixture-has-attr? find-attr) -(define (set-fixtures fixtures attr-name value) +(define (set-fixtures fixtures attribute value) (for-each (lambda (fix) - (if (fixture-has-attr? fix attr-name) + (if (fixture-has-attr? fix attribute) (set-in-state! (current-state) fix - attr-name - (clamp-to-attr-range fix attr-name value)) - (error "Fixture does not have attribute"))) + attribute + (clamp-to-attr-range fix attribute value)) + (error "Fixture does not have attribute" + (get-fixture-name fix) + (canonical-name attribute)))) fixtures)) ;; (at <fixtures/groups> [<attribute>] <level> [<attribute> <level>...]) ;; (at fix1 100) <-- Set intensity of single fixture -;; (at fix1 'intensity 100) <-- Explicit attribute name +;; (at fix1 intensity 100) <-- Explicit attribute name ;; (at fix1 fix2 100) <-- Multiple fixtures -;; (at fix1 fix2 'pan 36) <-- Multiple fixtures + explicit attribute -;; (at group1 fix1 'intensity 100) <-- Groups can be used instead of fixtures -;; (at fix1 100 'pan 36) <-- Set multiple attributes -;; NB Can't set multiple fixtures and attributes: (at fix1 'pan 35 fix2 'tilt 22) +;; (at fix1 fix2 pan 36) <-- Multiple fixtures + explicit attribute +;; (at group1 fix1 intensity 100) <-- Groups can be used instead of fixtures +;; (at fix1 100 pan 36) <-- Set multiple attributes +;; NB Can't set multiple fixtures and attributes: (at fix1 pan 35 fix2 tilt 22) (define (at . args) - (receive (fixtures attr-name value) - (partition3 fixture? symbol? (flatten-sublists args)) + (receive (fixtures attribute value) + (partition3 fixture? attribute? (flatten-sublists args)) (cond ((nil? value) (error "at: Value not specified")) ((or (more-than-one value) - (more-than-one attr-name)) + (more-than-one attribute)) (error "at: Only one attribute or value name")) ((and (nil? fixtures) - (nil? attr-name)) + (nil? attribute)) (if (nil? selection) 'no-fixtures-selected - (set-fixtures selection 'intensity (car value)))) + (set-fixtures selection intensity (car value)))) - ((nil? attr-name) - (set-fixtures fixtures 'intensity (car value))) + ((nil? attribute) + (set-fixtures fixtures intensity (car value))) ((nil? fixtures) (if (nil? selection) 'no-fixtures-selected - (set-fixtures selection (car attr-name) (car value)))) + (set-fixtures selection (car attribute) (car value)))) (else - (set-fixtures fixtures (car attr-name) (car value)))))) + (set-fixtures fixtures (car attribute) (car value)))))) (define selection-hook (make-hook 1)) |