summaryrefslogtreecommitdiff
path: root/guile/nanolight
diff options
context:
space:
mode:
Diffstat (limited to 'guile/nanolight')
-rw-r--r--guile/nanolight/fixture-library/robe.scm38
-rw-r--r--guile/nanolight/fixture.scm22
-rw-r--r--guile/nanolight/state.scm11
3 files changed, 53 insertions, 18 deletions
diff --git a/guile/nanolight/fixture-library/robe.scm b/guile/nanolight/fixture-library/robe.scm
new file mode 100644
index 0000000..dcdd30b
--- /dev/null
+++ b/guile/nanolight/fixture-library/robe.scm
@@ -0,0 +1,38 @@
+(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)
+ (set-dmx universe (+ 0 start-addr) 2
+ (percent->dmxval value))))
+
+ (make <fixture-attribute> #:name 'tilt
+ #:range '(0 270) #:type 'continuous #:home-value 135
+ #:translator (lambda (universe start-addr value set-dmx)
+ (set-dmx universe (+ 2 start-addr) 2
+ (percent->dmxval value))))
+
+ (make <fixture-attribute> #:name 'strobe
+ #:range '(#f #t) #:type 'step #:home-value #f
+ #:translator (lambda (universe start-addr value set-dmx)
+ (set-dmx universe (+ 48 start-addr) 1
+ (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)
+ (set-dmx universe (+ 49 start-addr) 2
+ (percent->dmxval value))))
+
+ (make <fixture-attribute> #:name 'prism
+ #:range '(#f #t) #:type 'step #:home-value #f
+ #:translator (lambda (universe start-addr value set-dmx)
+ (set-dmx universe (+ 27 start-addr) 1
+ (if value 50 0))))))
diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
index 4a530f7..df4b168 100644
--- a/guile/nanolight/fixture.scm
+++ b/guile/nanolight/fixture.scm
@@ -1,10 +1,9 @@
(define-module (nanolight fixture)
#:use-module (oop goops)
- #:use-module (nanolight state)
#:use-module (ice-9 threads)
#:export (<fixture> <fixture-attribute>
make-output
- patch-fixture show-state
+ patch-fixture
fixture-string get-address-string
percent->dmxval
get-start-addr get-universe))
@@ -112,8 +111,7 @@
(define (make-output)
- (let ((fixtures '())
- (current-state '()))
+ (let ((fixtures '()))
(define (run-scanout)
@@ -128,19 +126,13 @@
universes)))
(u8vector-set!
(assq-ref universes universe)
- addr (round-dmx value)))
-
- (define (execute-state-assignment state-assignment)
- (let ((attr (find-attribute
- (fixture state-assignment)
- (attribute state-assignment))))
- (when attr
- (let ((trans (translator attr)))
+ addr (round-dmx value)
+
(trans
(get-universe (fixture state-assignment))
(get-start-addr (fixture state-assignment))
((value-func state-assignment))
- set-dmx)))))
+ set-dmx)))
(for-each execute-state-assignment current-state)
@@ -155,16 +147,12 @@
(make-thread run-scanout)
; Method functions
- (define (show-state state)
- (set! current-state state))
-
(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)))))
diff --git a/guile/nanolight/state.scm b/guile/nanolight/state.scm
index 405a19c..bddff72 100644
--- a/guile/nanolight/state.scm
+++ b/guile/nanolight/state.scm
@@ -1,6 +1,6 @@
(define-module (nanolight state)
#:use-module (oop goops)
- #:export (print-state define-state
+ #:export (print-state define-state show-state
merge-states merge-rule-htp merge-rule-ltp
merge-htp merge-ltp
int flash pan tilt
@@ -97,6 +97,15 @@
'() (apply append list-of-states)))
+(define (show-state state)
+ (for-each (lambda (a)
+ (set-value-func!
+ (let ((attr (find-attribute)
+ (fixture state-assignment)
+ (attribute state-assignment))))))
+ (when attr
+ (let ((trans (translator attr)))))))
+
(define (compare-addr a b)
(or
(< (get-universe (fixture a)) (get-universe (fixture b)))