From d0754c97ad7bd3d6d1acc39ce2dfb73db8fb217e Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 7 Jun 2020 19:13:10 +0200
Subject: Add 16-bit values, and add example fixture class

---
 guile/nanolight/fixture-library/robe.scm | 47 ++++++++++++++++++++++++++++++++
 guile/nanolight/fixture.scm              |  7 ++++-
 2 files changed, 53 insertions(+), 1 deletion(-)
 create mode 100644 guile/nanolight/fixture-library/robe.scm

diff --git a/guile/nanolight/fixture-library/robe.scm b/guile/nanolight/fixture-library/robe.scm
new file mode 100644
index 0000000..8a08185
--- /dev/null
+++ b/guile/nanolight/fixture-library/robe.scm
@@ -0,0 +1,47 @@
+(define-module (nanolight fixture-library robe)
+  #:use-module (oop goops)
+  #:use-module (nanolight fixture)
+  #:export (robe-dl7s-profile-mode1))
+
+
+(define (robe-dl7s-profile-mode1)
+  (list
+
+    (make <fixture-attribute> #:name 'pan
+      #:range '(0 540) #:type 'continuous #:home-value 270
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (let ((val16 (* value (/ 65536 540))))
+                       (set-dmx universe (chan 1 start-addr)
+                         (msb val16))
+                       (set-dmx universe (chan 2 start-addr)
+                         (lsb val16)))))
+
+    (make <fixture-attribute> #:name 'tilt
+      #:range '(0 270) #:type 'continuous #:home-value 135
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (let ((val16 (* value (/ 65536 270))))
+                       (set-dmx universe (chan 3 start-addr)
+                         (msb val16))
+                       (set-dmx universe (chan 4 start-addr)
+                         (lsb val16)))))
+
+    (make <fixture-attribute> #:name 'strobe
+      #:range '(#f #t) #:type 'step #:home-value #f
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (set-dmx universe (chan 49 start-addr)
+                       (if value 95 32))))
+
+    (make <fixture-attribute> #:name 'intensity
+      #:range '(0 100) #:type 'continuous #:home-value 0
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (let ((val16 (* value (/ 65536 100))))
+                       (set-dmx universe (chan 50 start-addr)
+                         (msb val16))
+                       (set-dmx universe (chan 51 start-addr)
+                         (lsb val16)))))
+
+    (make <fixture-attribute> #:name 'prism
+      #:range '(#f #t) #:type 'step #:home-value #f
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (set-dmx universe (chan 28 start-addr)
+                       (if value 50 0))))))
diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
index 0c67975..9bfa3d9 100644
--- a/guile/nanolight/fixture.scm
+++ b/guile/nanolight/fixture.scm
@@ -7,7 +7,7 @@
   #:export (<fixture> <fixture-attribute>
              make-output patch-fixture
              fixture-string fixture-address-string
-             percent->dmxval chan
+             percent->dmxval msb lsb chan
              start-addr universe
              assign-attr!))
 
@@ -133,6 +133,11 @@
 (define (percent->dmxval val)
   (round-dmx (/ (* 256 val) 100)))
 
+(define (msb val)
+  (round-dmx (/ val 256)))
+
+(define (lsb val)
+  (round-dmx (logand (round val) #b11111111)))
 
 (define (chan channel start-addr)
   (- (+ channel start-addr) 1))
-- 
cgit v1.2.3