From cd1e43183ac01466ecb91709671046a22036acf7 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sat, 24 Oct 2020 11:18:20 +0200 Subject: Implement cue parts with different fade times --- guile/starlet/base.scm | 7 ++++++- guile/starlet/playback.scm | 26 ++++++++++++++++++++++++-- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index d72aa88..21e9590 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -36,7 +36,8 @@ home-val intensity? state-find - get-attr-type)) + get-attr-type + fixture?)) (define-class () (name @@ -86,6 +87,10 @@ #:getter get-scanout-func)) +(define (fixture? f) + (is-a? f )) + + ;; A "state" is just a thin wrapper around a hash table ;; of (fixture . attribute) --> value (define-class () diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index 2b7415c..5a3c2a1 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -96,7 +96,7 @@ (realized-state get-realized-state set-realized-state!) (fade-times get-cue-fade-times) (track-intensities track-intensities) - (cue-parts cue-parts)) + (cue-parts get-cue-parts)) (define (qnum a) @@ -301,6 +301,28 @@ down-time))))) +(define (match-fix-attr attr-el fix attr) + (if (fixture? attr-el) + (eq? attr-el fix) + (eqv? attr-el (cons fix attr)))) + + +(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 (run-cue-index! pb cue-list cue-number tnow) (let ((the-cue-state (realize-state cue-list cue-number)) @@ -312,7 +334,7 @@ (let ((fade-record (hash-ref (get-fade-records pb) (cons fix attr)))) (let ((new-record (make-fade-record tnow - (get-cue-fade-times the-cue) + (cue-part-fade-times the-cue fix attr) (fade-start-val tnow pb fade-record -- cgit v1.2.3