diff options
author | Thomas White <taw@physics.org> | 2022-01-30 11:48:11 +0100 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2022-01-30 11:48:11 +0100 |
commit | f8ba1e2224b408794382a22408cd07447c3ac700 (patch) | |
tree | cebb8d07d489c23af39ebbcfa668cb593de7a1f6 | |
parent | d09ae50745ccabbb4533857e3f5cfd26644e96e9 (diff) |
Remove states and transitions from cue (leave only cue parts)
-rw-r--r-- | guile/starlet/cue-list.scm | 98 | ||||
-rw-r--r-- | guile/starlet/playback.scm | 52 |
2 files changed, 84 insertions, 66 deletions
diff --git a/guile/starlet/cue-list.scm b/guile/starlet/cue-list.scm index 3ef1269..5821444 100644 --- a/guile/starlet/cue-list.scm +++ b/guile/starlet/cue-list.scm @@ -1,7 +1,7 @@ ;; ;; starlet/cue-list.scm ;; -;; Copyright © 2020-2021 Thomas White <taw@bitwiz.org.uk> +;; Copyright © 2020-2022 Thomas White <taw@bitwiz.org.uk> ;; ;; This file is part of Starlet. ;; @@ -41,9 +41,9 @@ qnum get-cue-parts get-cue-clock - get-tracked-state get-preset-state - get-transition-effect + get-cue-part-state + get-cue-part-transition cue-number-to-index cue-index-to-number current-cue-clock @@ -52,29 +52,23 @@ (define-record-type <cue-part> - (make-cue-part attr-list transition) + (cue-part state transition) cue-part? - (attr-list get-cue-part-attr-list) + (state get-cue-part-state + set-cue-part-state!) (transition get-cue-part-transition)) (define-record-type <cue> (make-cue number - state - tracked-state preset-state - transition-effect track-intensities cue-parts cue-clock) cue? (number get-cue-number) - (state get-cue-state) - (tracked-state get-tracked-state - set-tracked-state!) (preset-state get-preset-state set-preset-state!) - (transition-effect get-transition-effect) (track-intensities track-intensities) (cue-parts get-cue-parts) (cue-clock get-cue-clock)) @@ -111,13 +105,6 @@ (fix-attrs-in-state state))) -(define-syntax cue-part - (syntax-rules () - ((_ (fixtures ...) params ...) - (make-cue-part-obj (list fixtures ...) - params ...)))) - - (define (cue-proc number . args) (receive (states transition-effects cue-parts rest) @@ -134,12 +121,12 @@ (error "A cue can only contain one transition effect")) (let ((the-cue (make-cue (qnum number) - (car states) - #f ;; tracked state, to be filled later #f ;; preset state, to be filled later - (car transition-effects) track-intensities - cue-parts + (cons + (cue-part (car states) + (car transition-effects)) + cue-parts) (current-cue-clock)))) the-cue)))) @@ -161,8 +148,15 @@ (apply-state prev-state) (unless (track-intensities the-cue) (blackout!)) - (apply-state (get-cue-state the-cue))))) - (set-tracked-state! the-cue the-tracked-state) + (apply-state + (get-cue-part-state + (car (get-cue-parts the-cue))))))) + (set-cue-part-state! (car (get-cue-parts the-cue)) + the-tracked-state) + (for-each + (lambda (part) + (apply-state (get-cue-part-state part))) + (cdr (get-cue-parts the-cue))) the-tracked-state)) (make-empty-state) the-cue-list)) @@ -174,29 +168,49 @@ (< a 1)))) -(define (fixture-dark-in-state? fix state) - (dark? (state-find fix 'intensity state))) +(define (fixture-dark-in-cue? fix the-cue) + (every + (lambda (part) + (dark? (state-find fix 'intensity (get-cue-part-state part)))) + (get-cue-parts the-cue))) -(define (preset-all-cues! the-cue-list) - (vector-fold-right - (lambda (idx next-state the-cue) - (let ((preset-state (make-empty-state))) +(define-syntax for-each-cue-part + (syntax-rules () + ((_ the-cue (part) body ...) + (for-each + (lambda (part) + body ...) + (get-cue-parts the-cue))))) - (state-for-each - (lambda (fix attr val) - (unless (intensity? attr) - (when (fixture-dark-in-state? fix (get-tracked-state the-cue)) - (set-in-state! preset-state fix attr val)))) - next-state) - (set-preset-state! the-cue preset-state)) +(define-syntax for-every-attr-in-cue + (syntax-rules () + ((_ the-cue (fix attr val) body ...) + (for-each-cue-part + the-cue (part) + (state-for-each + (lambda (fix attr val) + body ...) + (get-cue-part-state part)))))) - ;; Pass the raw state from this cue to the previous one - (get-cue-state the-cue)) - (make-empty-state) - the-cue-list)) +(define (preset-all-cues! the-cue-list) + (let loop ((idx 0)) + (let ((the-cue (vector-ref the-cue-list idx)) + (next-cue (vector-ref the-cue-list (1+ idx))) + (preset-state (make-empty-state))) + (for-every-attr-in-cue + next-cue (fix attr val) + (unless (intensity? attr) + (when (fixture-dark-in-cue? fix the-cue) + (set-in-state! preset-state fix attr val)))) + (set-preset-state! the-cue preset-state)) + (if (< (+ 2 idx) (vector-length the-cue-list)) + (loop (1+ idx)) + (set-preset-state! + (vector-ref the-cue-list (1+ idx)) + (make-empty-state))))) (define-syntax cue-list diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index 392c9a5..c22da26 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -141,19 +141,22 @@ (set-running-cue! pb #f) (set-playback-state! pb 'ready) - ;; Set the actual state - (state-for-each - (lambda (fix attr val) - (set-in-state! pb fix attr (lambda () val))) - (get-tracked-state (vector-ref (get-playback-cue-list pb) - cue-index))) + (let ((the-cue (vector-ref (get-playback-cue-list pb) + cue-index))) + ;; Set the actual state + (for-each + (lambda (part) + (state-for-each + (lambda (fix attr val) + (set-in-state! pb fix attr (lambda () val))) + (get-cue-part-state part))) + (get-cue-parts the-cue)) - ;; Set the preset state on top - (state-for-each - (lambda (fix attr val) - (set-in-state! pb fix attr (lambda () val))) - (get-preset-state (vector-ref (get-playback-cue-list pb) - cue-index)))) + ;; Set the preset state on top + (state-for-each + (lambda (fix attr val) + (set-in-state! pb fix attr (lambda () val))) + (get-preset-state the-cue)))) (define (cut-to-cue-number! pb cue-number) @@ -242,22 +245,23 @@ (define (run-cue-index! pb cue-index) (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)) (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 + (for-each + (lambda (part) + (receive + (overlay-part transition-time) + ((transition-func (get-cue-part-transition part)) + (get-cue-part-state part) + pb + cue-clock) + (atomically-overlay-state! + overlay-state + overlay-part) + (set! fade-time (max fade-time transition-time)))) + (get-cue-parts the-cue)) (set-clock-expiration-time! cue-clock fade-time) (atomically-overlay-state! pb overlay-state) |