From 03baaa73727f3a6ba720da5f2f9791e2b0e29c57 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Tue, 25 Jan 2022 18:06:55 +0100
Subject: Track time taken for cue transition

---
 guile/starlet/cue-list.scm          |  6 ------
 guile/starlet/playback.scm          | 33 ++++++++++++++++-----------------
 guile/starlet/snap-transition.scm   | 13 +++++++++++--
 guile/starlet/transition-effect.scm |  4 ++--
 4 files changed, 29 insertions(+), 27 deletions(-)

diff --git a/guile/starlet/cue-list.scm b/guile/starlet/cue-list.scm
index 016db5f..5a22251 100644
--- a/guile/starlet/cue-list.scm
+++ b/guile/starlet/cue-list.scm
@@ -117,10 +117,6 @@
                         params ...))))
 
 
-;; FIXME!
-(define (cue-total-time the-cue)
-  100)
-
 (define (cue-proc number . args)
   (receive
     (states transition-effects cue-parts rest)
@@ -145,8 +141,6 @@
                                cue-parts
                                (current-cue-clock))))
 
-        (set-clock-expiration-time! (current-cue-clock)
-                                    (cue-total-time the-cue))
         the-cue))))
 
 
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index 5052ad0..fda6b80 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -244,23 +244,22 @@
   (let* ((the-cue (vector-ref (get-playback-cue-list pb) cue-index))
          (this-cue-state (get-tracked-state the-cue))
          (overlay-state (make-empty-state))
-         (cue-clock (get-cue-clock the-cue)))
-
-    (atomically-overlay-state!
-      overlay-state
-      ((transition-func (get-transition-effect the-cue))
-       this-cue-state
-       cue-clock))
-
-    (for-each
-      (lambda (cue-part)
-        (atomically-overlay-state!
-          overlay-state
-          ((transition-func (get-transition-effect the-cue))
-           this-cue-state
-           cue-clock)))
-      (get-cue-parts the-cue))
-
+         (cue-clock (get-cue-clock the-cue))
+         (fade-time 0))
+
+    (receive
+      (overlay-part transition-time)
+      ((transition-func (get-transition-effect the-cue)) this-cue-state
+                                                         pb
+                                                         cue-clock)
+      (atomically-overlay-state!
+        overlay-state
+        overlay-part)
+      (set! fade-time (max fade-time transition-time)))
+
+    ;; FIXME: Same, for each cue part
+
+    (set-clock-expiration-time! cue-clock fade-time)
     (atomically-overlay-state! pb overlay-state)
     (set-pb-cue-clock! pb cue-clock)
     (set-running-cue! pb the-cue)
diff --git a/guile/starlet/snap-transition.scm b/guile/starlet/snap-transition.scm
index ed9df4b..8101890 100644
--- a/guile/starlet/snap-transition.scm
+++ b/guile/starlet/snap-transition.scm
@@ -21,10 +21,19 @@
 (define-module (starlet snap-transition)
   #:use-module (oop goops)
   #:use-module (starlet playback)
+  #:use-module (starlet state)
   #:use-module (starlet transition-effect)
   #:export (snap))
 
 (define (snap)
   (make-transition
-    (incoming-state clock)
-    incoming-state))
+    (incoming-state current-state clock)
+    (let ((overlay-state (make-empty-state)))
+      (state-for-each
+        (lambda (fix attr val)
+          (set-in-state! overlay-state
+                         fix
+                         attr
+                         (lambda () val)))
+        incoming-state)
+      (values overlay-state 0))))
diff --git a/guile/starlet/transition-effect.scm b/guile/starlet/transition-effect.scm
index 7594b05..43b7a6e 100644
--- a/guile/starlet/transition-effect.scm
+++ b/guile/starlet/transition-effect.scm
@@ -39,7 +39,7 @@
 
 (define-syntax make-transition
   (syntax-rules ()
-    ((_ (a b) expr ...)
+    ((_ (a b c) expr ...)
      (make <transition-effect>
-           #:func (lambda (a b)
+           #:func (lambda (a b c)
                     expr ...)))))
-- 
cgit v1.2.3