diff options
| author | Thomas White <taw@physics.org> | 2022-01-25 18:06:55 +0100 |
|---|---|---|
| committer | Thomas White <taw@physics.org> | 2022-01-25 23:23:01 +0100 |
| commit | 03baaa73727f3a6ba720da5f2f9791e2b0e29c57 (patch) | |
| tree | 475cf59422f945ff5ffbe52812af7af945926316 | |
| parent | bd8cf7df1c51230cf19f42408eb2dd79048774ce (diff) | |
Track time taken for cue transition
| -rw-r--r-- | guile/starlet/cue-list.scm | 6 | ||||
| -rw-r--r-- | guile/starlet/playback.scm | 33 | ||||
| -rw-r--r-- | guile/starlet/snap-transition.scm | 13 | ||||
| -rw-r--r-- | 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 ...))))) |