aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-05-02 18:38:58 +0200
committerThomas White <taw@physics.org>2021-05-03 09:37:51 +0200
commit40d564b7427f4e58b53962aeb1fea8d431bcca6f (patch)
tree58190175a48ecbe007fabb0942df1bb04eb2d935
parentf040a936d8f39148e81b9cd7716b1b0c466b65dd (diff)
Don't hammer OLA with unnecessary updates
As well as reducing CPU load, this vastly reduces the number of problems caused by data frames being accidentally interleaved with RDM.
-rw-r--r--guile/starlet/base.scm22
1 files changed, 16 insertions, 6 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 57d7664..70ec741 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -459,7 +459,7 @@ pre-existing contents."
(define-generic scanout-fixture)
-(define (scanout-loop ola-client start-time count)
+(define (scanout-loop ola-client start-time count previous-universes)
(let ((universes '()))
@@ -504,8 +504,18 @@ pre-existing contents."
(atomic-box-ref fixtures))
;; Send everything to OLA
- (for-each (lambda (a)
- (send-to-ola ola-client a))
+ (for-each (lambda (uni-buf-pair)
+ (let ((uni (car uni-buf-pair))
+ (buf (cdr uni-buf-pair)))
+ (let ((prev-buf (assv-ref previous-universes uni)))
+
+ ;; Do not send exactly the same data every time,
+ ;; but do send an update once every 100 loops, just to
+ ;; make sure OLA does not forget about us.
+ (unless (and prev-buf
+ (ola-dmx-buffers-equal? buf prev-buf)
+ (not (= count 0)))
+ (send-streaming-dmx-data! ola-client uni buf)))))
universes)
(usleep 10000)
@@ -516,8 +526,8 @@ pre-existing contents."
(set! scanout-freq
(exact->inexact (/ 100
(- (hirestime) start-time))))
- (scanout-loop ola-client (hirestime) 0))
- (scanout-loop ola-client start-time (+ count 1)))))
+ (scanout-loop ola-client (hirestime) 0 universes))
+ (scanout-loop ola-client start-time (+ count 1) universes))))
(define ola-thread #f)
@@ -535,7 +545,7 @@ pre-existing contents."
(backtrace)
(raise-exception exn))
(lambda ()
- (scanout-loop ola-client start-time 0))
+ (scanout-loop ola-client start-time 0 '()))
#:unwind? #f))))))