Implement cue parts with different fade times

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 <fixture-attribute> (<object>)
   (name
@@ -86,6 +87,10 @@
     #:getter get-scanout-func))
 
 
+(define (fixture? f)
+  (is-a? f <fixture>))
+
+
 ;; A "state" is just a thin wrapper around a hash table
 ;; of (fixture . attribute)  -->  value
 (define-class <starlet-state> (<object>)
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