aboutsummaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2022-11-12 11:13:53 +0100
committerThomas White <taw@physics.org>2022-11-12 11:37:03 +0100
commit5a02170f9e1952cd335b6b097e8ce33de7bb35b1 (patch)
treeca21feda4181e444e10e11ce863cc017c69461e7 /guile
parentf99311300912814ccaf4fdd6b3c753d1206e024c (diff)
Introduce new type for attribute names
There's a serious problem with the design so far, where symbols are used for attribute names (intensity, strobe, colour etc), and also for attribute values (on, off, random etc). There's no way for 'at' to tell the difference between the two. For example, this form is ambiguous: (at myfixture 'strobe 'on) This commit introduces a new class, <starlet-attribute>, to replace the use of symbols here. The attributes are enumerated in (starlet attributes), and new ones can be added later. The attribute objects remember their 'canonical' names, to allow states to be printed. Apart from solving the ambiguity problem, this has two further advantages. First, attribute names no longer need to be quoted everywhere. Second, multiple names can be used to refer to the same attribute. For example: (define color colour).
Diffstat (limited to 'guile')
-rw-r--r--guile/starlet/attributes.scm82
-rw-r--r--guile/starlet/crossfade.scm1
-rw-r--r--guile/starlet/cue-list.scm3
-rw-r--r--guile/starlet/effects.scm3
-rw-r--r--guile/starlet/fixture-library/adj/mega-tripar-profile.scm17
-rw-r--r--guile/starlet/fixture-library/chauvet/mav2.scm25
-rw-r--r--guile/starlet/fixture-library/generic/dimmer.scm5
-rw-r--r--guile/starlet/fixture-library/generic/rgb.scm9
-rw-r--r--guile/starlet/fixture-library/robe/dl7s.scm29
-rw-r--r--guile/starlet/fixture-library/robe/mmxspot.scm60
-rw-r--r--guile/starlet/fixture-library/robe/mmxwashbeam.scm61
-rw-r--r--guile/starlet/fixture-library/stairville/octagon-theater-cw-ww.scm17
-rw-r--r--guile/starlet/fixture-library/stairville/z120m.scm19
-rw-r--r--guile/starlet/fixture-library/tadm/led-bar.scm10
-rw-r--r--guile/starlet/fixture.scm16
-rw-r--r--guile/starlet/midi-control/faders.scm1
-rw-r--r--guile/starlet/playback.scm1
-rw-r--r--guile/starlet/scanout.scm3
-rw-r--r--guile/starlet/snap-transition.scm1
-rw-r--r--guile/starlet/state.scm51
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))