diff options
author | Thomas White <taw@physics.org> | 2021-05-02 18:38:58 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2021-05-03 09:37:51 +0200 |
commit | 40d564b7427f4e58b53962aeb1fea8d431bcca6f (patch) | |
tree | 58190175a48ecbe007fabb0942df1bb04eb2d935 | |
parent | f040a936d8f39148e81b9cd7716b1b0c466b65dd (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.scm | 22 |
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)))))) |