diff options
-rw-r--r-- | examples/demo.scm | 5 | ||||
-rw-r--r-- | guile/starlet/base.scm | 13 | ||||
-rw-r--r-- | guile/starlet/playback.scm | 137 |
3 files changed, 72 insertions, 83 deletions
diff --git a/examples/demo.scm b/examples/demo.scm index 0bf14c1..74fa65f 100644 --- a/examples/demo.scm +++ b/examples/demo.scm @@ -79,7 +79,7 @@ (define my-cue-list (cue-list (cue 0 - (cue-state) + (cue-state (apply-state home-state)) #:fade-up 1 #:fade-down 1) @@ -95,7 +95,8 @@ #:down-delay 3) (cue 2.5 - (track-state (at dim1 'intensity 100)) + (cue-state (at dim1 'intensity 100)) + #:track-intensities #t #:fade-up 1 #:fade-down 1) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index fd4f9f7..1b1d699 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -30,7 +30,8 @@ current-state lighting-state apply-state - at)) + at + home-state)) (define-class <fixture-attribute> (<object>) (name @@ -133,13 +134,6 @@ (slot-ref fix 'attributes))) -;; Set the intensity of all patched fixtures to zero -(define (blackout state) - (for-each (lambda (fix) - (set-attr! state fix 'intensity 0)) - (atomic-box-ref patched-fixture-list))) - - (define (find-attr fix attr-name) (find (lambda (a) (eq? (get-attr-name a) @@ -191,7 +185,8 @@ (round-dmx (/ val 256))) (define (lsb val) - (round-dmx (logand (round val) #b11111111))) + (round-dmx (logand (inexact->exact (round val)) + #b11111111))) (define (state-for-each func state) diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index 45e651c..34564e5 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -53,19 +53,15 @@ (define-record-type <cue> - (make-cue number state up-time down-time up-delay down-delay) + (make-cue number state up-time down-time up-delay down-delay track-intensities) cue? (number get-cue-number) (state get-cue-state) (up-time up-time) (up-delay up-delay) (down-time down-time) - (down-delay down-delay)) - - -;; Get the state for a cue, taking into account tracking etc -(define (evaluate-cue-state cue) - ((get-cue-state cue))) + (down-delay down-delay) + (track-intensities track-intensities)) (define (wrap-scale scale-factor a) @@ -130,7 +126,7 @@ new-playback)) -(define (find-cue cue-list cue-number) +(define (cue-number-to-index cue-list cue-number) (vector-index (lambda (a) (eqv? (get-cue-number a) cue-number)) @@ -138,33 +134,42 @@ (define (cut-to-cue-number! pb cue-number) - (let ((cue-index (find-cue (get-playback-cue-list pb) - cue-number))) - (cut-to-cue! pb - (vector-ref (get-playback-cue-list pb) - cue-index)) + (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 + (evaluate-cue-state cue-list cue-index) + 0.0 1.0 0.0 0.0 (hirestime)))) (set-next-cue-index! pb (+ cue-index 1))) (return-unspecified)) -(define (cut-to-cue! pb cue) - (let ((state (evaluate-cue-state cue))) - ;; Flush everything out and just set the state - (set-active-fade-list! pb - (list (make-fade - state - 0.0 1.0 0.0 0.0 (hirestime)))))) +(define (go! pb) + (let ((cue-index (get-next-cue-index pb))) + (run-cue! pb cue-index)) + (return-unspecified)) (define (return-unspecified) (if #f 1)) +(define (run-cue-number! pb cue-number) + (let ((cue-index (cue-number-to-index (get-playback-cue-list pb) + cue-number))) + (run-cue! pb cue-index)) + (return-unspecified)) + -(define (go! pb) - (let ((cue-index (get-next-cue-index pb))) - (unless (>= cue-index (vector-length (get-playback-cue-list pb))) - (run-cue! pb - (vector-ref (get-playback-cue-list pb) - cue-index)) +(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))) (set-next-cue-index! pb (+ cue-index 1)))) ;; else at the end of the cue list (return-unspecified)) @@ -176,14 +181,15 @@ (get-active-fade-list pb)))) -(define (make-fade-from-cue cue time) - (make-fade - (evaluate-cue-state cue) - 0.0 - 1.0 - (up-time cue) - (up-delay cue) - time)) +(define (make-fade-from-cue cue-list cue-index time) + (let ((the-cue (vector-ref cue-list cue-index))) + (make-fade + (evaluate-cue-state cue-list cue-index) + 0.0 + 1.0 + (up-time the-cue) + (up-delay the-cue) + time))) (define (retire-old-fades! pb tnow) @@ -214,63 +220,50 @@ (get-active-fade-list pb)))) -(define (run-cue-number! pb cue-number) - (let ((cue-index (find-cue (get-playback-cue-list pb) - cue-number))) - (run-cue! pb (vector-ref (get-playback-cue-list pb) - cue-index)) - (set-next-cue-index! pb (+ cue-index 1))) - (return-unspecified)) - - -(define (run-cue! pb cue) - (let ((tnow (hirestime))) - (retire-old-fades! pb tnow) - (fade-down-all-active-states! pb - tnow - (down-time cue) - (down-delay cue)) - (add-fade! pb (make-fade-from-cue cue tnow)))) - - ;;; ******************** Cue lists ******************** (define-syntax cue-state (syntax-rules () - ((_) - make-empty-state) - ((_ body ...) (lambda () - (parameterize ((current-state (make-empty-state))) - body ... - (current-state)))))) + body ... + (current-state))))) (define* (cue number state - #:key (fade-up 5) (fade-down 5) (up-delay 0) (down-delay 0)) + #:key + (fade-up 5) + (fade-down 5) + (up-delay 0) + (down-delay 0) + (track-intensities #f)) (make-cue (qnum number) state fade-up fade-down up-delay - down-delay)) + down-delay + track-intensities)) + + +;; Return a state containing the values which should be +;; tracked through from previous cues up to cue-index +;; If cue-list[cue-index] has track-intensities set, +;; then intensities should be tracked through as well. +;; Non-intensity parameters are always tracked through. +(define (collate-tracking cue-list cue-index) + (let ((state (make-empty-state))) + state)) -(define (add-to-cue-list the-cue cue-list-so-far) - cue-list-so-far) +;; Get the state for a cue, taking into account tracking etc +(define (evaluate-cue-state cue-list cue-index) + (parameterize ((current-state (make-empty-state))) + (let ((the-cue (vector-ref cue-list cue-index))) + ((get-cue-state the-cue))))) (define-syntax cue-list (identifier-syntax vector)) - - -(define-syntax track-state - (syntax-rules () - ((_ body ...) - (lambda () - (parameterize ((current-state (clone-previous-state))) - body ... - (current-state)))))) |