define-fixture: Eliminate need to provide names for get-attr etc

This needed some rearranging, but I think the resulting code is a little
bit more efficient.

1 files changed, 19 insertions, 24 deletions

diff --git a/guile/starlet/fixture-library/robe/dl7s/mode1.scm b/guile/starlet/fixture-library/robe/dl7s/mode1.scm
index e9d5a9a..2a5eb46 100644
--- a/guile/starlet/fixture-library/robe/dl7s/mode1.scm
+++ b/guile/starlet/fixture-library/robe/dl7s/mode1.scm
@@ -25,22 +25,18 @@
   #:export (<robe-dl7s-mode1>))
 
 
-(define-class <robe-dl7s-mode1> (<fixture>)
-  (attributes
-   #:init-form (list
-                (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-list 'tungsten-watts-emulation '(750 1000 1200 2000 2500 #f) #f)
-                (attr-colour 'colour white)
-                (attr-continuous 'colour-temperature-correction '(2700 8000) 8000)
-                (attr-continuous 'green-correction '(-100 100) 0))))
+(define-fixture
 
+  <robe-dl7s-mode1>
 
-(define-method (scanout-fixture (fixture <robe-dl7s-mode1>)
-                                get-attr set-chan8 set-chan16)
+  (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))
 
   (set-chan16 50 (percent->dmxval16 (get-attr 'intensity)))
 
@@ -51,15 +47,14 @@
 
   (set-chan8 28 (if (get-attr 'prism) 50 0))
 
-  (set-chan8 7 (assv-ref '((750 . 82)
-                           (1000 . 88)
-                           (1200 . 92)
-                           (2000 . 97)
-                           (2500 . 102)
-                           (#f . 107))
-                         (get-attr 'tungsten-watts-emulation)))
+  (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)
+                                       '(8000 2700) '(0 255)))
 
   (let ((cmy (colour-as-cmy (get-attr 'colour))))
-    (set-chan8 9 (percent->dmxval8 (car cmy)))
-    (set-chan8 11 (percent->dmxval8 (cadr cmy)))
-    (set-chan8 13 (percent->dmxval8 (caddr cmy)))))
+    (set-chan16 9 (percent->dmxval16 (car cmy)))
+    (set-chan16 11 (percent->dmxval16 (cadr cmy)))
+    (set-chan16 13 (percent->dmxval16 (caddr cmy)))))