From 2219b335db665201705b437c1402f217a118a2a4 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sun, 11 Oct 2020 14:25:00 +0200 Subject: New way of doing cross-fades --- examples/demo.scm | 2 +- guile/starlet/base.scm | 32 ++--- guile/starlet/playback.scm | 348 +++++++++++++++++++++++++++------------------ 3 files changed, 228 insertions(+), 154 deletions(-) diff --git a/examples/demo.scm b/examples/demo.scm index d296e57..6553965 100644 --- a/examples/demo.scm +++ b/examples/demo.scm @@ -98,7 +98,7 @@ #:fade-down 1) (cue 3 - (cue-state (apply-state blackout-state)) + (cue-state (blackout (current-state))) #:fade-up 0 #:fade-down 2))) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index a59e91c..d72aa88 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -23,6 +23,7 @@ value->number merge-states-htp get-state-hash-table + set-state-hash-table! scanout-fixture attr-continuous attr-boolean @@ -31,9 +32,11 @@ lighting-state apply-state at - home-state - blackout-state - intensity?)) + blackout + home-val + intensity? + state-find + get-attr-type)) (define-class () (name @@ -101,7 +104,6 @@ value)) - ;; List of fixtures (define patched-fixture-list (make-atomic-box '())) @@ -109,8 +111,12 @@ ;; commanded otherwise (define home-state (make )) -;; Basic state which sets all intensities to zero -(define blackout-state (make )) +(define (blackout state) + (state-for-each + (lambda (fix attr val) + (when (intensity? attr) + (set-in-state! state fix attr 0.0))) + state)) (define (make-empty-state) (make )) @@ -133,6 +139,10 @@ (home-attr! state fix attr)) (slot-ref fix 'attributes))) +(define (home-val fix attr) + (state-find fix + attr + home-state)) (define (intensity? a) (eq? 'intensity (get-attr-name a))) @@ -155,12 +165,6 @@ (when attr (set-in-state! state fix attr value)))) -(define (fade-frac fade-time start-time time-now) - (min (/ (- time-now start-time) - fade-time) - 1.0)) - - ;; Patch a new fixture (define* (patch-fixture! class start-addr @@ -170,10 +174,6 @@ #:uni universe #:friendly-name friendly-name))) (home-all! home-state new-fixture) - (set-in-state! blackout-state - new-fixture - (find-attr new-fixture 'intensity) - 0.0) (atomic-box-set! patched-fixture-list (cons new-fixture (atomic-box-ref patched-fixture-list))) diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index aaf4727..160b4cf 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -11,18 +11,12 @@ run-cue-number! go! cue-list - cue-state - qnum)) + cue-state)) ;; A "playback" is a state which knows how to run cues ;; from a cue list (define-class () - (active-fade-list - #:init-value '() - #:getter get-active-fade-list - #:setter set-active-fade-list!) - (cue-list #:init-keyword #:cue-list #:getter get-playback-cue-list) @@ -32,25 +26,28 @@ #:getter get-next-cue-index #:setter set-next-cue-index!) - (hash-table - #:allocation #:virtual - #:getter get-state-hash-table - #:slot-ref (lambda (instance) - (merge-active-fades (hirestime) - (get-active-fade-list instance))) - #:slot-set! (lambda (instance new-val) - (error "Can't set hash table on playback")))) - - -(define-record-type - (make-fade state start-frac target-frac fade-time fade-delay start-time) - fade? - (start-frac get-fade-start-frac) - (target-frac get-fade-target-frac) - (fade-time get-fade-time) - (state get-fade-state) - (start-time get-fade-start-time) - (fade-delay get-fade-delay-time)) + (fade-params + #:init-form (make-hash-table) + #:getter get-fade-params + #:setter set-fade-params!)) + + +(define-record-type + (make-fade-params start-time + up-time + down-time + up-delay + down-delay + previous + target) + fade-params? + (start-time fade-start-time) + (up-time fade-up-time) + (down-time fade-down-time) + (up-delay fade-up-delay) + (down-delay fade-down-delay) + (previous fade-previous) + (target fade-target)) (define-record-type @@ -73,58 +70,6 @@ (track-intensities track-intensities)) -(define (wrap-scale scale-factor a) - (lambda (time) - (* (value->number a time) - scale-factor))) - - -(define (get-current-fraction fade current-time) - (let ((elapsed-fade-time (- current-time - (get-fade-start-time fade) - (get-fade-delay-time fade)))) - (cond - - ;; Before start of fade - ((< elapsed-fade-time 0) - (get-fade-start-frac fade)) - - ;; After end of fade - ((> elapsed-fade-time (get-fade-time fade)) - (get-fade-target-frac fade)) - - ;; During the fade - (else - (+ (get-fade-start-frac fade) - (* (- (get-fade-target-frac fade) - (get-fade-start-frac fade)) - - ;; Fraction of fade time elapsed - (/ elapsed-fade-time - (get-fade-time fade)))))))) - - -(define (scale-fade fade current-time) - (let ((state (make-empty-state)) - (scale-factor (get-current-fraction fade current-time))) - (state-for-each (lambda (fix attr value) - (if (intensity? attr) - (set-in-state! state - fix - attr - (wrap-scale scale-factor value)) - (set-in-state! state fix attr value))) - (get-fade-state fade)) - state)) - - -(define (merge-active-fades current-time list-of-fades) - (get-state-hash-table - (merge-states-htp - (map (lambda (fade) (scale-fade fade current-time)) - list-of-fades)))) - - (define (qnum a) (/ (inexact->exact (* a 1000)) 1000)) @@ -144,12 +89,29 @@ (define (cut-to-cue-number! pb cue-number) (let* ((cue-list (get-playback-cue-list pb)) - (cue-index (cue-number-to-index cue-list cue-number))) - (set-active-fade-list! pb - (list (make-fade - (realize-state cue-list cue-index) - 0.0 1.0 0.0 0.0 (hirestime)))) - (set-next-cue-index! pb (+ cue-index 1))) + (cue-index (cue-number-to-index cue-list (qnum cue-number)))) + (set-state-hash-table! pb (get-state-hash-table + (realize-state cue-list + cue-index))) + (set-next-cue-index! pb (+ cue-index 1)) + + ;; Wipe out the old fade params + (set-fade-params! pb (make-hash-table)) + + ;; Record fade params + (state-for-each + (lambda (fix attr val) + (hash-set! (get-fade-params pb) + (cons fix attr) + (make-fade-params (hirestime) + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + val))) + pb)) + (return-unspecified)) @@ -169,62 +131,174 @@ (define (run-cue! pb cue-index) (let* ((cue-list (get-playback-cue-list pb))) (unless (>= cue-index (vector-length cue-list)) - (let ((the-cue (vector-ref cue-list cue-index)) - (tnow (hirestime))) - (retire-old-fades! pb tnow) - (fade-down-all-active-states! pb - tnow - (down-time the-cue) - (down-delay the-cue)) - (add-fade! pb (make-fade-from-cue cue-list cue-index tnow))) + (run-cue-index! pb cue-list cue-index (hirestime)) (set-next-cue-index! pb (+ cue-index 1)))) ;; else at the end of the cue list (return-unspecified)) -(define (add-fade! pb fade) - (set-active-fade-list! pb - (cons fade - (get-active-fade-list pb)))) - - -(define (make-fade-from-cue cue-list cue-index time) - (let ((the-cue (vector-ref cue-list cue-index))) - (make-fade - (realize-state cue-list cue-index) - 0.0 - 1.0 - (up-time the-cue) - (up-delay the-cue) - time))) - - -(define (retire-old-fades! pb tnow) - (set-active-fade-list! - pb - (filter (lambda (a) - (or - (< tnow - (+ (get-fade-start-time a) - (get-fade-delay-time a) - (get-fade-time a))) - (> (get-fade-target-frac a) - 0.0))) - (get-active-fade-list pb)))) - - -(define (fade-down-all-active-states! pb tnow down-time down-delay) - (set-active-fade-list! - pb - (map (lambda (a) - (make-fade - (get-fade-state a) - (get-current-fraction a tnow) - 0.0 - down-time - down-delay - tnow)) - (get-active-fade-list pb)))) +(define (fade-func start-val end-val fade-time delay-time 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) + + ;; After end of fade + ((> 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 + fade-time + delay-time + tnow) + (lambda (time) + (fade-func (value->number start-val time) + (value->number end-val time) + fade-time + delay-time + tnow + time))) + + +;; Return a function for HTP mix of: +;; start-val fading down in down-time/down-delay +;; end-val fading up in up-time/up-delay +(define (wrap-xf start-val + end-val + up-time + down-time + up-delay + down-delay + tnow) + (lambda (time) + (max + (fade-func (value->number start-val time) + 0 + down-time + down-delay + tnow + time) + (fade-func 0 + (value->number end-val time) + up-time + up-delay + tnow + time)))) + + +(define (fade-start-val tnow pb old-fade-record fix attr val) + (cond + + ;; Attr not seen before in this playback: start fading from home + ((eq? old-fade-record #f) + (home-val fix attr)) + + ;; Attr seen in a finished fade + ((fade-finished? tnow old-fade-record) + (fade-target old-fade-record)) + + ;; Attr is currently fading: get the current state + ;; (NB it might be a function/effect) + (else + (let ((func (state-find fix attr pb))) + (func tnow))))) + + +(define (set-fade pb fix attr fade-record) + + (let ((prev-val (fade-previous fade-record)) + (target (fade-target fade-record))) + + (cond + + ;; Number to number, fading up + ((and (number? target) (number? prev-val) (> target prev-val)) + (set-in-state! pb fix attr (wrap-fade prev-val + target + (fade-up-time fade-record) + (fade-up-delay fade-record) + (fade-start-time fade-record)))) + + ;; Number to number, fading down + ((and (number? target) (number? prev-val) (< target prev-val)) + (set-in-state! pb fix attr (wrap-fade prev-val + target + (fade-down-time fade-record) + (fade-down-delay fade-record) + (fade-start-time fade-record)))) + + ;; Number to number, staying the same + ((and (number? target) (number? prev-val)) + (set-in-state! pb fix attr (wrap-fade prev-val + target + 0.0 + 0.0 + (fade-start-time fade-record)))) + + ;; Everything else, e.g. number to effect + (else + (set-in-state! pb fix attr (wrap-xf (fade-previous fade-record) + (fade-target fade-record) + (fade-up-time fade-record) + (fade-down-time fade-record) + (fade-up-delay fade-record) + (fade-down-delay fade-record) + (fade-start-time fade-record))))))) + + +(define (fade-finished? tnow fade-params) + (and + (> tnow + (+ (fade-start-time fade-params) + (fade-up-delay fade-params) + (fade-up-time fade-params))) + (> tnow + (+ (fade-start-time fade-params) + (fade-down-delay fade-params) + (fade-down-time fade-params))))) + + +(define (run-cue-index! pb cue-list cue-number tnow) + + (let ((the-cue-state (realize-state cue-list cue-number)) + (the-cue (vector-ref cue-list cue-number))) + + (state-for-each + (lambda (fix attr val) + + (let ((fade-record (hash-ref (get-fade-params pb) + (cons fix attr)))) + (let ((new-record (make-fade-params tnow + (up-time the-cue) + (down-time the-cue) + (up-delay the-cue) + (down-delay the-cue) + (fade-start-val tnow + pb + fade-record + fix + attr + val) + val))) + (hash-set! (get-fade-params pb) + (cons fix attr) + new-record) + (set-fade pb fix attr new-record)))) + + the-cue-state))) ;;; ******************** Cue lists ******************** @@ -256,7 +330,7 @@ (define (ensure-cue-zero-realized cue-list) (unless (get-realized-state (vector-ref cue-list 0)) (set-realized-state! (vector-ref cue-list 0) - home-state))) + (make )))) ;; Get the state for a cue, taking into account tracking etc @@ -271,7 +345,7 @@ (parameterize ((current-state (make-empty-state))) (apply-state previous-state) (unless (track-intensities the-cue) - (apply-state blackout-state)) + (blackout (current-state))) ((get-cue-state-function the-cue)) (set-realized-state! the-cue (current-state)) (current-state)))))) -- cgit v1.2.3