aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-03-28 21:00:15 +0200
committerThomas White <taw@physics.org>2021-03-31 21:56:36 +0200
commit730bd4f092f36511533d384e57463c30f4e66519 (patch)
treeb842fcd49558ddeb9dbe1d5d3accfdc154b1189b
parent87c0652743d08f5d6b6f006c933cb692ed8f16d7 (diff)
Remove combined state from scanout loop
This gives only one remaining place where the state stack is combined. Soon, it will be made faster.
-rw-r--r--guile/starlet/base.scm113
1 files changed, 49 insertions, 64 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 9ee5e52..1d4bfd6 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -412,62 +412,50 @@ pre-existing contents."
(- addr 1) ; u8vector-set indexing starts from zero
(round-dmx value)))
- ;; Make a combined state
- (let* ((fixture-home-pair (atomic-box-ref fixtures))
- (combined-state (merge-states-ltp
- (list
- (merge-states-htp
- (atomic-box-ref state-list))
- programmer-state))))
-
- ;; Request all fixtures to output their DMX values
- (for-each (lambda (fix)
-
- (let ((univ (get-fixture-universe fix))
- (addr (get-fixture-addr fix)))
-
- ;; Helper function to get a value for this
- ;; fixture in the current state
- (define (get-attr attr-name)
- (let ((val (state-find fix attr-name combined-state)))
- (if (have-value val)
- (value->number val (hirestime))
- (get-attr-home-val fix attr-name))))
-
- ;; Helper function to set 8-bit DMX value
- (define (set-chan relative-channel-number value)
-
- (unless (number? value)
- (raise-exception (make-exception
- (make-exception-with-message
- "set-chan: value is not a number")
- (make-exception-with-irritants
- (list relative-channel-number value)))))
- (set-dmx univ
- (+ addr relative-channel-number -1)
- value))
-
- ;; Helper function to set 16-bit DMX value
- (define (set-chan-16bit relative-channel-number value)
- (unless (number? value)
- (raise-exception (make-exception
- (make-exception-with-message
- "set-chan16: value is not a number")
- (make-exception-with-irritants
- (list relative-channel-number
- value)))))
- (set-chan relative-channel-number (msb value))
- (set-chan (+ relative-channel-number 1) (lsb value)))
-
- (scanout-fixture fix get-attr set-chan set-chan-16bit)))
-
- (atomic-box-ref fixtures))
-
-
- ;; Send everything to OLA
- (for-each (lambda (a)
- (send-to-ola ola-uri ola-socket a))
- universes))
+ (for-each
+ (lambda (fix)
+
+ (let ((univ (get-fixture-universe fix))
+ (addr (get-fixture-addr fix)))
+
+ ;; Helper function to get a value for this
+ ;; fixture in the current state
+ (define (get-attr attr-name)
+ (current-value fix attr-name))
+
+ ;; Helper function to set 8-bit DMX value
+ (define (set-chan relative-channel-number value)
+
+ (unless (number? value)
+ (raise-exception (make-exception
+ (make-exception-with-message
+ "set-chan: value is not a number")
+ (make-exception-with-irritants
+ (list relative-channel-number value)))))
+ (set-dmx univ
+ (+ addr relative-channel-number -1)
+ value))
+
+ ;; Helper function to set 16-bit DMX value
+ (define (set-chan-16bit relative-channel-number value)
+ (unless (number? value)
+ (raise-exception (make-exception
+ (make-exception-with-message
+ "set-chan16: value is not a number")
+ (make-exception-with-irritants
+ (list relative-channel-number
+ value)))))
+ (set-chan relative-channel-number (msb value))
+ (set-chan (+ relative-channel-number 1) (lsb value)))
+
+ (scanout-fixture fix get-attr set-chan set-chan-16bit)))
+
+ (atomic-box-ref fixtures))
+
+ ;; Send everything to OLA
+ (for-each (lambda (a)
+ (send-to-ola ola-uri ola-socket a))
+ universes)
(usleep 10000)
@@ -504,15 +492,12 @@ pre-existing contents."
#:unwind? #f))))))
-
(define (current-value fix attr-name)
- ;; FIXME: Only need to track one fixture through the state stack
- (let* ((fixture-home-pair (atomic-box-ref fixtures))
- (combined-state (merge-states-ltp
- (list
- (merge-states-htp
- (atomic-box-ref state-list))
- programmer-state))))
+ (let ((combined-state (merge-states-ltp
+ (list
+ (merge-states-htp
+ (atomic-box-ref state-list))
+ programmer-state))))
(let ((val (state-find fix attr-name combined-state)))
(if (have-value val)
(value->number val 0)