From 5f1f79c6d3fa853786bd10fe075780143ed76559 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Mon, 24 May 2021 16:12:50 +0200
Subject: Add hook for state changes on a playback

---
 guile/starlet/playback.scm | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 deletions(-)

(limited to 'guile/starlet/playback.scm')

diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index 96e52c3..7a83cfd 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 atomic)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-43)
@@ -65,6 +66,10 @@
     #:getter get-cue-clock
     #:setter set-cue-clock!)
 
+  (current-state
+    #:init-form (make-atomic-box 'ready)
+    #:getter state-box)
+
   (state-change-hook
     #:init-form (make-hook 1)
     #:getter state-change-hook))
@@ -146,6 +151,7 @@
     (clear-state! pb)
     (set-next-cue-index! pb (+ cue-index 1))
     (set-cue-clock! pb #f)
+    (atomic-box-set! (state-box  pb) 'ready)
     (run-hook (state-change-hook pb) 'ready)
     (let ((cue-state (calculate-tracking cue-list cue-index)))
       (state-for-each
@@ -195,7 +201,8 @@
 
         ;; Restart paused cue
         (begin (start-clock! clock)
-               (run-hook (state-change-hook pb) 'ready))
+               (atomic-box-set! (state-box pb) 'running)
+               (run-hook (state-change-hook pb) 'running))
 
         ;; Run next cue
         (let ((next-cue-index (get-next-cue-index pb)))
@@ -212,6 +219,7 @@
     (when (and clock
                (not (clock-expired? clock)))
       (stop-clock! (get-cue-clock pb))
+      (atomic-box-set! (state-box pb) 'pause)
       (run-hook (state-change-hook pb) 'pause))))
 
 
@@ -219,6 +227,7 @@
   (let ((prev-cue-index (- (get-next-cue-index pb) 2)))
     (if (>= prev-cue-index 0)
         (begin (cut-to-cue-index! pb prev-cue-index)
+               (atomic-box-set! (state-box pb) 'ready)
                (run-hook (state-change-hook pb) 'ready))
         'already-at-cue-zero)))
 
@@ -566,7 +575,8 @@
 
     (atomically-overlay-state! pb overlay-state)
     (set-cue-clock! pb cue-clock)
-    (run-hook (state-change-hook pb) 'ready)))
+    (atomic-box-set! (state-box pb) 'running)
+    (run-hook (state-change-hook pb) 'running)))
 
 
 (define (print-playback pb)
@@ -672,6 +682,16 @@
                 (current-state)))))))
 
 
+(define-method (update-state! (pb <starlet-playback>))
+  (when (and (get-cue-clock pb)
+             (clock-expired? (get-cue-clock pb))
+             (eq? 'running (atomic-box-ref (state-box pb))))
+    (when (eq? 'running (atomic-box-compare-and-swap! (state-box pb)
+                                                      'running
+                                                      'ready))
+      (run-hook (state-change-hook pb) 'ready))))
+
+
 (define-syntax cue-list
   (syntax-rules ()
     ((_ body ...)
-- 
cgit v1.2.3