aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-05-24 16:12:50 +0200
committerThomas White <taw@physics.org>2021-05-24 16:12:50 +0200
commit5f1f79c6d3fa853786bd10fe075780143ed76559 (patch)
tree03051436ed223444d1cfe3fce68ac8ab596d912e
parent2a493a0122ca289d5aa3241cefd4dfac43e272f6 (diff)
Add hook for state changes on a playback
-rw-r--r--guile/starlet/playback.scm24
-rw-r--r--guile/starlet/scanout.scm2
-rw-r--r--guile/starlet/state.scm8
3 files changed, 31 insertions, 3 deletions
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 ...)
diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm
index 70698d4..4d38f0f 100644
--- a/guile/starlet/scanout.scm
+++ b/guile/starlet/scanout.scm
@@ -208,6 +208,8 @@
(- addr 1) ; OLA indexing starts from zero
(round-dmx value)))
+ (for-each update-state! (atomic-box-ref state-list))
+
(for-each
(lambda (fix)
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index 35db6bd..a9aa6b4 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -50,7 +50,8 @@
sel
selection-hook
value->number
- atomically-overlay-state!))
+ atomically-overlay-state!
+ update-state!))
;; A "state" is an atomically-updating container for an immutable
@@ -83,6 +84,11 @@
col)))
+(define-method (update-state! (state <starlet-state>))
+ ;; Basic state object needs no updates
+ #f)
+
+
(define-method (set-in-state! (state <starlet-state>)
(fix <fixture>)
(attr <colour-component-id>)