From bc87293c6a2cbcf246876e1a706e987af78dfc60 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Fri, 5 Mar 2021 19:00:18 +0100 Subject: Add "auto move while dark" --- guile/starlet/playback.scm | 210 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 168 insertions(+), 42 deletions(-) (limited to 'guile/starlet') diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index a480a1f..b702d43 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -52,14 +52,18 @@ attr-time up-delay down-delay - attr-delay) + attr-delay + preset-time + preset-delay) fade-times? (up-time get-fade-up-time) (down-time get-fade-down-time) (attr-time get-fade-attr-time) (up-delay get-fade-up-delay) (down-delay get-fade-down-delay) - (attr-delay get-fade-attr-delay)) + (attr-delay get-fade-attr-delay) + (preset-time get-fade-preset-time) + (preset-delay get-fade-preset-delay)) ;; Macro to avoid a profusion of (get-fade-xxx-time fade-times) @@ -72,13 +76,17 @@ (attr-time (datum->syntax x 'attr-time)) (up-delay (datum->syntax x 'up-delay)) (down-delay (datum->syntax x 'down-delay)) - (attr-delay (datum->syntax x 'attr-delay))) + (attr-delay (datum->syntax x 'attr-delay)) + (preset-time (datum->syntax x 'preset-time)) + (preset-delay (datum->syntax x 'preset-delay))) #'(let ((up-time (get-fade-up-time fade-times)) (down-time (get-fade-down-time fade-times)) (attr-time (get-fade-attr-time fade-times)) (up-delay (get-fade-up-delay fade-times)) (down-delay (get-fade-down-delay fade-times)) - (attr-delay (get-fade-attr-delay fade-times))) + (attr-delay (get-fade-attr-delay fade-times)) + (preset-time (get-fade-preset-time fade-times)) + (preset-delay (get-fade-preset-delay fade-times))) body ...)))))) @@ -86,12 +94,14 @@ (make-fade-record start-time fade-times previous - target) + target + preset) fade-record? (start-time fade-start-time) (fade-times get-fade-record-fade-times) (previous fade-previous) - (target fade-target)) + (target fade-target) + (preset fade-preset)) (define-record-type @@ -148,20 +158,28 @@ ;; Record fade params (state-for-each - (lambda (fix attr val) - (hash-set! (get-fade-records pb) - (cons fix attr) - (make-fade-record (hirestime) - (make-fade-times - 0.0 - 0.0 - 0.0 - 0.0 - 0.0 - 0.0) - 0.0 - val))) - pb)) + (lambda (fix attr val) + (let ((new-record (make-fade-record (hirestime) + (make-fade-times + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0) + 0.0 + val + (preset-val cue-list + cue-index + fix + attr)))) + (hash-set! (get-fade-records pb) + (cons fix attr) + new-record) + (set-fade pb fix attr new-record))) + pb)) *unspecified*) @@ -188,38 +206,65 @@ *unspecified*) -(define (fade-func start-val end-val fade-time delay-time start-time current-time) +(define (fade-func start-val + end-val + preset-val + fade-time + delay-time + preset-time + preset-delay + start-time + current-time) (let ((elapsed-fade-time (- current-time start-time delay-time))) (cond - ;; Before start of fade - ((< elapsed-fade-time 0) - start-val) + ;; Before start of fade + ((< elapsed-fade-time 0) + start-val) - ;; After end of fade - ((> elapsed-fade-time fade-time) - end-val) + ;; After both fade and preset fade + ((and preset-val + (> elapsed-fade-time (+ fade-time preset-delay preset-time))) + preset-val) - ;; During the fade - (else - (+ start-val - (* (- end-val start-val) - ;; Fraction of fade time elapsed - (/ elapsed-fade-time fade-time))))))) + ;; During preset fade + ((and preset-val + (> elapsed-fade-time (+ preset-delay fade-time))) + (+ end-val + (* (- preset-val end-val) + (/ (- elapsed-fade-time fade-time preset-delay) + preset-time)))) + + ;; After end of fade, but not long enough for auto-move + ((> elapsed-fade-time fade-time) + end-val) + + ;; During the fade + (else + (+ start-val + (* (- end-val start-val) + ;; Fraction of fade time elapsed + (/ elapsed-fade-time fade-time))))))) ;; Return a function to fade from start-val to end-val using the ;; specified fade time and delay, starting at tnow (define (wrap-fade start-val end-val + preset-val fade-time delay-time + preset-time + preset-delay tnow) (lambda (time) (fade-func (value->number start-val time) (value->number end-val time) + (value->number preset-val time) fade-time delay-time + preset-time + preset-delay tnow time))) @@ -237,14 +282,20 @@ (max (fade-func (value->number start-val time) 0 - down-time + #f ;; wrap-xf is only used for intensities, + down-time ;; so auto-move/preset is irrelevant down-delay + 0 + 0 tnow time) (fade-func 0 (value->number end-val time) + #f up-time up-delay + 0 + 0 tnow time))))) @@ -258,7 +309,8 @@ ;; Attr seen in a finished fade ((fade-finished? tnow old-fade-record) - (fade-target old-fade-record)) + (or (fade-preset old-fade-record) + (fade-target old-fade-record))) ;; Attr is currently fading: get the current state ;; (NB it might be a function/effect) @@ -280,30 +332,42 @@ ((not (intensity? attr)) (set-attr! pb fix attr (wrap-fade (fade-previous fade-record) (fade-target fade-record) + (fade-preset fade-record) attr-time attr-delay + preset-time + preset-delay (fade-start-time fade-record)))) ;; Number to number, fading up ((and (number? target) (number? prev-val) (> target prev-val)) (set-attr! pb fix attr (wrap-fade prev-val target + #f up-time up-delay + 0.0 + 0.0 (fade-start-time fade-record)))) ;; Number to number, fading down ((and (number? target) (number? prev-val) (< target prev-val)) (set-attr! pb fix attr (wrap-fade prev-val target + #f down-time down-delay + 0.0 + 0.0 (fade-start-time fade-record)))) ;; Number to number, staying the same ((and (number? target) (number? prev-val)) (set-attr! pb fix attr (wrap-fade prev-val target + #f + 0.0 + 0.0 0.0 0.0 (fade-start-time fade-record)))) @@ -331,7 +395,10 @@ (> tnow (+ (fade-start-time fade-record) attr-delay - attr-time))))) + attr-time + (if (fade-preset fade-record) + (+ preset-time preset-delay) + 0)))))) (define (match-fix-attr attr-el fix attr) @@ -376,6 +443,30 @@ (get-cue-fade-times the-cue)))) +(define (fixture-dark? fix the-cue) + (let ((val (state-find fix + (find-attr fix 'intensity) + (get-realized-state the-cue)))) + (or (not val) + (eqv? 0 val)))) + + +(define (next-value cue-list cue-index fix attr) + (if (>= cue-index (- (vector-length cue-list) 1)) + #f + (let ((the-cue-state (realize-state cue-list (+ 1 cue-index)))) + (state-find fix + attr + the-cue-state)))) + + +(define (preset-val cue-list cue-index fix attr) + (let ((the-cue (vector-ref cue-list cue-index))) + (if (fixture-dark? fix the-cue) + (next-value cue-list cue-index fix attr) + #f))) + + (define (run-cue-index! pb cue-list cue-number tnow) (let ((the-cue-state (realize-state cue-list cue-number)) @@ -394,7 +485,11 @@ fix attr val) - val))) + val + (preset-val cue-list + cue-number + fix + attr)))) (hash-set! (get-fade-records pb) (cons fix attr) new-record) @@ -426,7 +521,9 @@ (attr-time 3) (up-delay 0) (down-delay 0) - (attr-delay 0)) + (attr-delay 0) + (preset-time 1) + (preset-delay 1)) (make-cue-part attr-list (make-fade-times up-time @@ -434,7 +531,9 @@ attr-time up-delay down-delay - attr-delay))) + attr-delay + preset-time + preset-delay))) (define cue @@ -448,6 +547,8 @@ (up-delay 0) (down-delay 0) (attr-delay 0) + (preset-time 1) + (preset-delay 1) (track-intensities #f)) (make-cue (qnum number) @@ -459,15 +560,37 @@ attr-time up-delay down-delay - attr-delay) + attr-delay + preset-time + preset-delay) track-intensities cue-parts))))) +;; Put the non-intensity parameters from cue-index into the current state, +;; at their home values, but only if they are not already in the current state. +(define (apply-for-automove cue-list cue-index) + (unless (>= cue-index (vector-length cue-list)) + (let ((the-cue (vector-ref cue-list cue-index)) + (old-current-state (current-state))) + (parameterize ((current-state (make-empty-state))) + ((get-cue-state-function the-cue)) + (state-for-each (lambda (fix attr val) + (unless (intensity? attr) + (unless (state-find fix attr old-current-state) + (set-attr! old-current-state + fix + attr + (home-val fix attr))))) + (current-state)))))) + + (define (ensure-cue-zero-realized cue-list) (let ((cue-zero (vector-ref cue-list 0))) (unless (get-realized-state cue-zero) - (set-realized-state! cue-zero (make ))))) + (parameterize ((current-state (make-empty-state))) + (apply-for-automove cue-list 1) + (set-realized-state! cue-zero (current-state)))))) ;; Get the state for a cue, taking into account tracking etc @@ -484,6 +607,7 @@ (unless (track-intensities the-cue) (blackout (current-state))) ((get-cue-state-function the-cue)) + (apply-for-automove cue-list (+ cue-index 1)) (set-realized-state! the-cue (current-state)) (current-state)))))) @@ -495,5 +619,7 @@ (lambda () #f) ;; The real base state is in ensure-cue-zero-realized #:up-time 0 #:down-time 0 - #:attr-time 0) + #:attr-time 0 + #:preset-time 0 + #:preset-delay 0) body ...)))) -- cgit v1.2.3