From 1fa25deedd48440dd17521f5e7d41a3e69bd3743 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Mon, 10 May 2021 20:54:53 +0200
Subject: Run cues as single atomic operations

This avoids a potential situation where one parameter of a fixture is
reconfigured before another, which could (in theory) lead to flickering
of lights.
---
 guile/starlet/playback.scm | 11 +++++++----
 guile/starlet/state.scm    | 20 +++++++++++++++++++-
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index c09e69b..f9f621f 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -522,7 +522,8 @@
   (let ((this-cue-state (calculate-tracking (get-playback-cue-list pb) cue-index))
         (next-cue-state (calculate-tracking (get-playback-cue-list pb) (+ cue-index 1)))
         (the-cue (vector-ref (get-playback-cue-list pb) cue-index))
-        (tnow (hirestime)))
+        (tnow (hirestime))
+        (overlay-state (make-empty-state)))
 
     (for-each
       (lambda (fix-attr)
@@ -537,7 +538,7 @@
           (if (intensity? attr)
 
               ;; Intensity attribute
-              (set-in-state! pb fix attr
+              (set-in-state! overlay-state fix attr
                              (make-intensity-fade start-val
                                                   target-val
                                                   fade-times
@@ -558,7 +559,7 @@
                        (fade-start-time (+ tnow (get-fade-attr-delay fade-times)))
                        (preset-start-time (+ tnow (calc-preset-start-time fix the-cue))))
 
-                  (set-in-state! pb fix attr
+                  (set-in-state! overlay-state fix attr
                                  (make-fade-func start-val
                                                  target-val
                                                  preset-val
@@ -570,7 +571,9 @@
       ;; Add the next cue to list of states to look at, only if it exists)
       (if next-cue-state
           (fix-attrs-involved pb this-cue-state next-cue-state)
-          (fix-attrs-involved pb this-cue-state)))))
+          (fix-attrs-involved pb this-cue-state)))
+
+    (atomically-overlay-state! pb overlay-state)))
 
 
 (define (print-playback pb)
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index 13888e8..a889d0c 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -48,7 +48,8 @@
             blackout
             sel
             selection-hook
-            value->number))
+            value->number
+            atomically-overlay-state!))
 
 
 ;; A "state" is an atomically-updating container for an immutable
@@ -231,6 +232,23 @@ pre-existing contents."
   (state-for-each at state))
 
 
+(define (atomically-overlay-state! state newbits)
+  "Apply 'newbits' within 'state', as a single atomic operation."
+  (let* ((old-ht (atomic-box-ref (get-ht-box state)))
+         (new-ht (copy-hash-table old-ht)))
+    (state-for-each (lambda (fix attr val)
+                      (hash-set! new-ht
+                                 (cons fix attr)
+                                 val))
+                    newbits)
+    (unless (eq? (atomic-box-compare-and-swap!
+                   (get-ht-box state)
+                   old-ht
+                   new-ht)
+                 old-ht)
+      (atomically-overlay-state! state newbits))))  ;; Try again
+
+
 (define current-state (make-parameter programmer-state))
 
 
-- 
cgit v1.2.3