Fixture definition and scanout

2 files changed, 72 insertions, 14 deletions

diff --git a/guile/nanolight/fixture-library/generic.scm b/guile/nanolight/fixture-library/generic.scm
index b593004..2117e75 100644
--- a/guile/nanolight/fixture-library/generic.scm
+++ b/guile/nanolight/fixture-library/generic.scm
@@ -6,4 +6,8 @@
 
 (define (generic-dimmer)
   (list
-    (make <fixture-attribute> #:name 'intensity #:offset 0)))
+    (make <fixture-attribute> #:name 'intensity
+      #:range '(0 100) #:type 'continuous #:home-value 0
+      #:translator (lambda (universe start-addr value set-dmx)
+                     (set-dmx universe start-addr 1
+                       (percent->dmxval value))))))
diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
index 9bc0552..7a9ad98 100644
--- a/guile/nanolight/fixture.scm
+++ b/guile/nanolight/fixture.scm
@@ -1,8 +1,11 @@
 (define-module (nanolight fixture)
+  #:use-module (oop goops)
+  #:use-module (ice-9 threads)
   #:export (<fixture> <fixture-attribute>
-             patch-fixture
-             fixture-string get-address-string)
-  #:use-module (oop goops))
+             make-output
+             patch-fixture show-state
+             fixture-string get-address-string
+             percent->dmxval))
 
 
 (define-class <fixture-attribute> (<object>)
@@ -15,7 +18,18 @@
   (offset
     #:init-value 0
     #:init-keyword #:offset
-    #:getter offset))
+    #:getter offset)
+
+  (continuous
+    #:init-value #t
+    #:init-keyword #:continuous
+    #:getter continuous)
+
+  (steps
+    #:init-value '()
+    #:init-keyword #:steps
+    #:getter steps
+    #:setter set-steps!))
 
 
 (define-class <fixture> (<object>)
@@ -54,13 +68,6 @@
     #:slot-set! (lambda (a s) #f)))
 
 
-; List of all patched fixtures (for scanout)
-(define fixtures (list))
-
-(define (add-fixture-to-roster fixture)
-  (set! fixtures (cons fixture fixtures)))
-
-
 (define (fixture-string fixture)
   (string-append
     (get-friendly-name fixture)
@@ -68,11 +75,58 @@
     (get-address-string fixture)))
 
 
-(define (patch-fixture attributes universe start-addr friendly-name)
+(define (patch-fixture output attributes universe start-addr friendly-name)
   (let ((new-fixture (make <fixture>
                        #:attributes attributes
                        #:uni universe
                        #:sa start-addr
                        #:friendly-name friendly-name)))
-    (add-fixture-to-roster new-fixture)
+    (output 'add-fixture new-fixture)
     new-fixture))
+
+
+; FIXME: Clamp to range
+(define (percent->dmxval val)
+  (/ (* 256 val) 100))
+
+
+(define (show-state output state)
+  (output 'show-state state))
+
+
+(define (scanout fixture-list)
+
+  (define (set-dmx universe addr nbytes value)
+    #f)
+
+  (define (scanout-fixture fixture)
+    #f)
+
+  (for-each scanout-fixture fixture-list))
+
+
+(define (make-output)
+
+  ; List of all patched fixtures (for scanout)
+  (let ((fixtures '()))
+
+    (define (run-scanout)
+      (scanout fixtures)
+      (yield)
+      (run-scanout))
+
+    (make-thread run-scanout)
+
+    (define (show-state state)
+      (display "Applying state:\n"))
+
+    (define (add-fixture fixture)
+      (set! fixtures (cons fixture fixtures)))
+
+    (lambda args
+      (apply
+        (case (car args)
+          ((show-state) show-state)
+          ((add-fixture) add-fixture)
+          (else => (error "Invalid method")))
+        (cdr args)))))