diff options
author | Thomas White <taw@physics.org> | 2022-01-25 20:14:20 +0100 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2022-01-25 23:23:01 +0100 |
commit | 0bdbc735f67eb96c3b15b0839ba262fe568e2a38 (patch) | |
tree | 2378d70b0031dbd462870da9df38fd904e0a9fd8 | |
parent | 03baaa73727f3a6ba720da5f2f9791e2b0e29c57 (diff) |
Implement crossfade
-rw-r--r-- | guile/starlet/crossfade.scm | 133 | ||||
-rw-r--r-- | guile/starlet/cue-list.scm | 3 |
2 files changed, 39 insertions, 97 deletions
diff --git a/guile/starlet/crossfade.scm b/guile/starlet/crossfade.scm index 4fe35d0..2c6efd5 100644 --- a/guile/starlet/crossfade.scm +++ b/guile/starlet/crossfade.scm @@ -20,7 +20,17 @@ ;; (define-module (starlet crossfade) #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (ice-9 exceptions) #:use-module (starlet playback) + #:use-module (starlet clock) + #:use-module (starlet cue-list) + #:use-module (starlet colours) + #:use-module (starlet fixture) + #:use-module (starlet state) + #:use-module (starlet transition-effect) #:export (crossfade)) @@ -163,41 +173,6 @@ clock)))) -(define (match-fix-attr attr-el fix attr) - (cond - - ((fixture? attr-el) - (eq? attr-el fix)) - - ((and (pair? attr-el) - (fixture? (car attr-el)) - (symbol? (cdr attr-el))) - (and (eq? (car attr-el) fix) - (eq? (cdr attr-el) attr))) - - ((list? attr-el) - (and (memq fix attr-el) - (memq attr attr-el))) - - (else #f))) - - -(define (in-cue-part? cue-part fix attr) - (find (lambda (p) (match-fix-attr p fix attr)) - (get-cue-part-attr-list cue-part))) - - -(define (cue-part-fade-times the-cue fix attr) - - (let ((the-cue-part - (find (lambda (p) (in-cue-part? p fix attr)) - (get-cue-parts the-cue)))) - - (if (cue-part? the-cue-part) - (get-cue-part-fade-times the-cue-part) - (get-cue-fade-times the-cue)))) - - (define (fade-start-val pb fix attr) (let ((val-in-pb (state-find fix attr pb))) (if (eq? val-in-pb 'no-value) @@ -216,26 +191,6 @@ (< a 1)))) -(define (longest-fade-time fade-times) - (max - (+ (get-fade-down-time fade-times) - (get-fade-down-delay fade-times)) - (+ (get-fade-up-time fade-times) - (get-fade-up-delay fade-times)) - (+ (get-fade-attr-time fade-times) - (get-fade-attr-delay fade-times)))) - - -;; Work out how long it will take before we can forget about this cue -(define (cue-total-time the-cue) - (let ((fade-times (cons (get-cue-fade-times the-cue) - (map get-cue-part-fade-times - (get-cue-parts the-cue))))) - (fold max - 0 - (map longest-fade-time fade-times)))) - - (define (fix-attr-eq fa1 fa2) (and (eq? (car fa1) (car fa2)) (eq? (cdr fa1) (cdr fa2)))) @@ -268,68 +223,54 @@ (make-exception-with-irritants type)))))) -(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))) - - (for-each - (lambda (fix-attr) +(define* (crossfade up-time + down-time + #:key + (attr-time 0) + (up-delay 0) + (down-delay 0) + (attr-delay 0)) + (make-transition + (incoming-state current-state clock) + (let ((overlay-state (make-empty-state))) + (state-for-each + (lambda (fixture attr target-val) - (let* ((fix (car fix-attr)) - (attr (cdr fix-attr)) - (fade-times (cue-part-fade-times the-cue fix attr)) + (let ((start-val (fade-start-val current-state fixture attr)) + (up-clock (make-delayed-clock clock up-delay up-time)) + (down-clock (make-delayed-clock clock down-delay down-time)) + (attribute-clock (make-delayed-clock clock attr-delay attr-time))) - ;; The values for fading - (start-val (fade-start-val pb fix attr)) - (target-val (state-find fix attr this-cue-state)) - ;; The clocks for things in this cue part - (up-clock (make-delayed-clock cue-clock - (get-fade-up-delay fade-times) - (get-fade-up-time fade-times))) - - (down-clock (make-delayed-clock cue-clock - (get-fade-down-delay fade-times) - (get-fade-down-time fade-times))) - - (attribute-clock (make-delayed-clock cue-clock - (get-fade-attr-delay fade-times) - (get-fade-attr-time fade-times)))) - - (if (intensity? attr) + (if (intensity? attr) ;; Intensity attribute - (set-in-state! overlay-state fix attr + (set-in-state! overlay-state fixture attr (make-intensity-fade start-val target-val up-clock down-clock)) ;; Non-intensity attribute - (let ((attribute-obj (find-attr fix attr))) + (let ((attribute-obj (find-attr fixture attr))) (unless attribute-obj (raise-exception (make-exception (make-exception-with-message "Attribute not found") (make-exception-with-irritants - (list fix attr))))) + (list fixture attr))))) (let* ((atype (get-attr-type attribute-obj)) (make-fade-func (make-fade-for-attribute-type atype))) - (set-in-state! overlay-state fix attr + (set-in-state! overlay-state fixture attr (make-fade-func start-val target-val attribute-clock))))))) - (fix-attrs-involved pb this-cue-state)) - - (atomically-overlay-state! pb overlay-state) - (set-pb-cue-clock! pb cue-clock) - (set-running-cue! pb the-cue) - (reset-clock! cue-clock) - (start-clock! cue-clock) - (set-playback-state! pb 'running))) - + incoming-state) + (values overlay-state + (max + (+ up-time up-delay) + (+ down-time down-delay) + (+ attr-time attr-delay)))))) diff --git a/guile/starlet/cue-list.scm b/guile/starlet/cue-list.scm index 5a22251..3ef1269 100644 --- a/guile/starlet/cue-list.scm +++ b/guile/starlet/cue-list.scm @@ -34,6 +34,7 @@ #:use-module (starlet utils) #:use-module (starlet transition-effect) #:use-module (starlet snap-transition) + #:use-module (starlet crossfade) #:export (cue cue-part cue-list @@ -47,7 +48,7 @@ cue-index-to-number current-cue-clock read-cue-list-file) - #:re-export (snap)) + #:re-export (snap crossfade)) (define-record-type <cue-part> |