From 38107e9cc8628311154f569bd27c33b8c02814cf Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 19 Mar 2022 18:44:23 +0100
Subject: Set unused intensities to zero in transition effects

This becomes important when running cues out of order.
---
 guile/starlet/crossfade.scm       | 100 ++++++++++++++++++++++----------------
 guile/starlet/snap-transition.scm |  15 +++++-
 2 files changed, 72 insertions(+), 43 deletions(-)

(limited to 'guile')

diff --git a/guile/starlet/crossfade.scm b/guile/starlet/crossfade.scm
index b0bbd1e..4c32685 100644
--- a/guile/starlet/crossfade.scm
+++ b/guile/starlet/crossfade.scm
@@ -211,6 +211,22 @@
   (fold add-fix-attrs-to-list '() states))
 
 
+(define (blank-everything in-state down-clock)
+  (let ((out-state (make-empty-state)))
+    (state-for-each
+      (lambda (fix attr val)
+        (when (intensity? attr)
+          (set-in-state! out-state
+                         fix
+                         attr
+                         (lambda ()
+                           (simple-fade (val)
+                                        0.0
+                                        down-clock)))))
+      in-state)
+    out-state))
+
+
 (define (make-fade-for-attribute-type type)
   (cond
     ((eq? type 'continuous) (cut make-general-fade simple-fade <...>))
@@ -236,45 +252,45 @@
                      up-time)))
     (make-transition
       (incoming-state current-state clock)
-      (let ((overlay-state (make-empty-state)))
-        (state-for-each
-          (lambda (fixture attr target-val)
-
-            (let ((start-val (fade-start-val current-state fixture attr))
-                  (up-clock (make-delayed-clock clock up-delay up-time))
-                  (down-clock (make-delayed-clock clock down-delay down-time))
-                  (attribute-clock (make-delayed-clock clock attr-delay attr-time)))
-
-              (if (intensity? attr)
-
-                ;; Intensity attribute
-                (set-in-state! overlay-state fixture attr
-                               (make-intensity-fade start-val
-                                                    target-val
-                                                    up-clock
-                                                    down-clock))
-
-                ;; Non-intensity attribute
-                (let ((attribute-obj (find-attr fixture attr)))
-
-                  (unless attribute-obj
-                    (raise-exception (make-exception
-                                       (make-exception-with-message
-                                         "Attribute not found")
-                                       (make-exception-with-irritants
-                                         (list fixture attr)))))
-
-                  (let* ((atype (get-attr-type attribute-obj))
-                         (make-fade-func (make-fade-for-attribute-type atype)))
-
-                    (set-in-state! overlay-state fixture attr
-                                   (make-fade-func start-val
-                                                   target-val
-                                                   attribute-clock)))))))
-
-          incoming-state)
-        (values overlay-state
-                (max
-                  (+ up-time up-delay)
-                  (+ down-time down-delay)
-                  (+ attr-time attr-delay)))))))
+      (let ((up-clock (make-delayed-clock clock up-delay up-time))
+            (down-clock (make-delayed-clock clock down-delay down-time))
+            (attribute-clock (make-delayed-clock clock attr-delay attr-time)))
+        (let ((overlay-state (blank-everything current-state down-clock)))
+          (state-for-each
+            (lambda (fixture attr target-val)
+
+              (let ((start-val (fade-start-val current-state fixture attr)))
+
+                (if (intensity? attr)
+
+                  ;; Intensity attribute
+                  (set-in-state! overlay-state fixture attr
+                                 (make-intensity-fade start-val
+                                                      target-val
+                                                      up-clock
+                                                      down-clock))
+
+                  ;; Non-intensity attribute
+                  (let ((attribute-obj (find-attr fixture attr)))
+
+                    (unless attribute-obj
+                      (raise-exception (make-exception
+                                         (make-exception-with-message
+                                           "Attribute not found")
+                                         (make-exception-with-irritants
+                                           (list fixture attr)))))
+
+                    (let* ((atype (get-attr-type attribute-obj))
+                           (make-fade-func (make-fade-for-attribute-type atype)))
+
+                      (set-in-state! overlay-state fixture attr
+                                     (make-fade-func start-val
+                                                     target-val
+                                                     attribute-clock)))))))
+
+            incoming-state)
+          (values overlay-state
+                  (max
+                    (+ up-time up-delay)
+                    (+ down-time down-delay)
+                    (+ attr-time attr-delay))))))))
diff --git a/guile/starlet/snap-transition.scm b/guile/starlet/snap-transition.scm
index 8101890..dab6b05 100644
--- a/guile/starlet/snap-transition.scm
+++ b/guile/starlet/snap-transition.scm
@@ -22,13 +22,26 @@
   #:use-module (oop goops)
   #:use-module (starlet playback)
   #:use-module (starlet state)
+  #:use-module (starlet fixture)
   #:use-module (starlet transition-effect)
   #:export (snap))
 
+
+(define (blank-everything in-state)
+  (let ((out-state (make-empty-state)))
+    (state-for-each
+      (lambda (fix attr val)
+        (if (intensity? attr)
+          (set-in-state! out-state fix attr (lambda () 0.0))
+          (set-in-state! out-state fix attr (lambda () 'no-value))))
+      in-state)
+    out-state))
+
+
 (define (snap)
   (make-transition
     (incoming-state current-state clock)
-    (let ((overlay-state (make-empty-state)))
+    (let ((overlay-state (blank-everything current-state)))
       (state-for-each
         (lambda (fix attr val)
           (set-in-state! overlay-state
-- 
cgit v1.2.3