diff options
Diffstat (limited to 'guile/starlet')
-rw-r--r-- | guile/starlet/crossfade.scm | 41 | ||||
-rw-r--r-- | guile/starlet/cue-list.scm | 77 | ||||
-rw-r--r-- | guile/starlet/cue-part.scm (renamed from guile/starlet/transition-effect.scm) | 40 | ||||
-rw-r--r-- | guile/starlet/playback.scm | 8 | ||||
-rw-r--r-- | guile/starlet/snap-transition.scm | 32 |
5 files changed, 73 insertions, 125 deletions
diff --git a/guile/starlet/crossfade.scm b/guile/starlet/crossfade.scm index 047fce9..65393b7 100644 --- a/guile/starlet/crossfade.scm +++ b/guile/starlet/crossfade.scm @@ -1,7 +1,7 @@ ;; ;; starlet/crossfade.scm ;; -;; Copyright © 2020-2021 Thomas White <taw@bitwiz.org.uk> +;; Copyright © 2020-2023 Thomas White <taw@bitwiz.org.uk> ;; ;; This file is part of Starlet. ;; @@ -24,13 +24,11 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (ice-9 exceptions) - #:use-module (starlet playback) #:use-module (starlet clock) - #:use-module (starlet cue-list) + #:use-module (starlet cue-part) #:use-module (starlet colours) #:use-module (starlet fixture) #:use-module (starlet state) - #:use-module (starlet transition-effect) #:use-module (starlet attributes) #:export (crossfade)) @@ -204,21 +202,18 @@ (make-exception-with-irritants type)))))) -(define* (crossfade up-time - #:optional - down-time - #:key - (attr-time #f) - (up-delay 0) - (down-delay 0) - (attr-delay 0)) - (let* ((real-down-time (if down-time down-time up-time)) - (real-attr-time (if attr-time attr-time (min up-time real-down-time)))) - (make-transition - (incoming-state current-state clock) +(define* (crossfade-real incoming-state up-time #:optional (down-time up-time) + #:key + (attr-time (min up-time down-time)) + (up-delay 0) + (down-delay 0) + (attr-delay 0)) + (cue-part + incoming-state + (lambda (incoming-state current-state clock) (let ((up-clock (make-delayed-clock clock up-delay up-time)) - (down-clock (make-delayed-clock clock down-delay real-down-time)) - (attribute-clock (make-delayed-clock clock attr-delay real-attr-time))) + (down-clock (make-delayed-clock clock down-delay down-time)) + (attribute-clock (make-delayed-clock clock attr-delay attr-time))) (let ((overlay-state (make-empty-state))) (state-for-each (lambda (fixture attr target-val) @@ -256,5 +251,11 @@ (values overlay-state (max (+ up-time up-delay) - (+ real-down-time down-delay) - (+ real-attr-time attr-delay)))))))) + (+ down-time down-delay) + (+ attr-time attr-delay)))))))) + + +;; Rearrange the arguments to put the lighting state (last argument) +;; at the beginning. This makes optional arguments in crossfade-real possible. +(define (crossfade . args) + (apply crossfade-real (last args) (drop-right args 1))) diff --git a/guile/starlet/cue-list.scm b/guile/starlet/cue-list.scm index 681158f..b029713 100644 --- a/guile/starlet/cue-list.scm +++ b/guile/starlet/cue-list.scm @@ -33,19 +33,16 @@ #:use-module (starlet clock) #:use-module (starlet utils) #:use-module (starlet attributes) - #:use-module (starlet transition-effect) + #:use-module (starlet cue-part) #:use-module (starlet snap-transition) #:use-module (starlet crossfade) #:export (cue - cue-part cue-list qnum get-cue-number get-cue-parts get-cue-clock get-preset-state - get-cue-part-state - get-cue-part-transition cue-number-to-index cue-index-to-number current-cue-clock @@ -54,14 +51,6 @@ #:re-export (snap crossfade)) -(define-record-type <cue-part> - (cue-part state transition) - cue-part? - (state get-cue-part-state - set-cue-part-state!) - (transition get-cue-part-transition)) - - (define-record-type <cue> (make-cue number preset-state @@ -72,7 +61,7 @@ (number get-cue-number) (preset-state get-preset-state set-preset-state!) - (track-intensities track-intensities) + (track-intensities track-intensities?) (cue-parts get-cue-parts) (cue-clock get-cue-clock)) @@ -113,53 +102,25 @@ (fix-attrs-in-state state))) -(define (cue-proc number . args) - (receive - (states transition-effects cue-parts rest) - (categorize args lighting-state? transition-effect? cue-part?) - - (let-keywords - rest - #f ;; allow-other-keys? - ((track-intensities #f)) - - (let ((n-tr-effs (length transition-effects)) - (n-states (length states))) - - (make-cue (qnum number) - #f ;; preset state, to be filled later - track-intensities - - ;; Create the list of cue parts - (cond - - ;; Only explicitly-stated cue parts - [(= 0 n-tr-effs n-states) - cue-parts] - - ;; Implicit first cue part - [(= 1 n-tr-effs n-states) - (cons - (cue-part (car states) - (car transition-effects)) - cue-parts)] - - ;; Wrong number of states or transition effects - [(not (= n-states 1)) - (error "Cue must contain exactly one state: " number)] - [(not (= n-tr-effs 1)) - (error "Cue must contain exactly one transition effect: " number)]) - - (current-cue-clock)))))) - (define current-cue-clock (make-parameter #f)) (define-syntax cue - (syntax-rules () - ((_ body ...) + (syntax-rules (track-intensities) + ((_ number track-intensities body ...) + (parameterize ((current-cue-clock (make-clock #:stopped #t))) + (make-cue (qnum number) + #f ;; preset state, to be filled later + #t ;; DO track intensities + (list body ...) + (current-cue-clock)))) + ((_ number body ...) (parameterize ((current-cue-clock (make-clock #:stopped #t))) - (cue-proc body ...))))) + (make-cue (qnum number) + #f ;; preset state, to be filled later + #f ;; don't track intensities + (list body ...) + (current-cue-clock)))))) (define (track-all-cues! the-cue-list) @@ -167,7 +128,7 @@ (lambda (idx prev-state the-cue) (let ((the-tracked-state (lighting-state (apply-state prev-state) - (unless (track-intensities the-cue) + (unless (track-intensities? the-cue) (blackout!)) (apply-state (get-cue-part-state @@ -242,9 +203,7 @@ (list->vector (remove unspecified? (list - (cue 0 - (make-empty-state) - (snap)) + (cue 0 (snap blackout)) body ...))))) (track-all-cues! the-cue-list) (preset-all-cues! the-cue-list) diff --git a/guile/starlet/transition-effect.scm b/guile/starlet/cue-part.scm index 43b7a6e..e98e422 100644 --- a/guile/starlet/transition-effect.scm +++ b/guile/starlet/cue-part.scm @@ -1,7 +1,7 @@ ;; -;; starlet/transition-effect.scm +;; starlet/cue-part ;; -;; Copyright © 2021-2022 Thomas White <taw@bitwiz.org.uk> +;; Copyright © 2020-2023 Thomas White <taw@bitwiz.org.uk> ;; ;; This file is part of Starlet. ;; @@ -18,28 +18,18 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; -(define-module (starlet transition-effect) - #:use-module (oop goops) - #:export (<transition-effect> - transition-effect? - transition-func - make-transition)) +(define-module (starlet cue-part) + #:use-module (srfi srfi-9) + #:export (cue-part + <cue-part> + get-cue-part-state + get-cue-part-transition + set-cue-part-state!)) -(define-class <transition-effect> (<object>) - (func - #:init-value #f - #:init-keyword #:func - #:getter transition-func)) - - -(define (transition-effect? a) - (is-a? a <transition-effect>)) - - -(define-syntax make-transition - (syntax-rules () - ((_ (a b c) expr ...) - (make <transition-effect> - #:func (lambda (a b c) - expr ...))))) +(define-record-type <cue-part> + (cue-part state transition) + cue-part? + (state get-cue-part-state + set-cue-part-state!) + (transition get-cue-part-transition)) diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index 2d20137..423abd2 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -34,8 +34,8 @@ #:use-module (starlet utils) #:use-module (starlet clock) #:use-module (starlet cue-list) + #:use-module (starlet cue-part) #:use-module (starlet colours) - #:use-module (starlet transition-effect) #:use-module (starlet attributes) #:export (make-playback cut-to-cue-number! @@ -303,8 +303,8 @@ ;; "main" transition effect (receive (overlay-part transition-time) - ((transition-func (get-cue-part-transition - (car (get-cue-parts the-cue)))) + ((get-cue-part-transition + (car (get-cue-parts the-cue))) (blank-everything pb) pb cue-clock) @@ -318,7 +318,7 @@ (lambda (part) (receive (overlay-part transition-time) - ((transition-func (get-cue-part-transition part)) + ((get-cue-part-transition part) (get-cue-part-state part) pb cue-clock) diff --git a/guile/starlet/snap-transition.scm b/guile/starlet/snap-transition.scm index e658b73..46993cd 100644 --- a/guile/starlet/snap-transition.scm +++ b/guile/starlet/snap-transition.scm @@ -1,7 +1,7 @@ ;; ;; starlet/snap-transition.scm ;; -;; Copyright © 2021 Thomas White <taw@bitwiz.org.uk> +;; Copyright © 2021-2023 Thomas White <taw@bitwiz.org.uk> ;; ;; This file is part of Starlet. ;; @@ -19,11 +19,8 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; (define-module (starlet snap-transition) - #:use-module (oop goops) - #:use-module (starlet playback) + #:use-module (starlet cue-part) #:use-module (starlet state) - #:use-module (starlet fixture) - #:use-module (starlet transition-effect) #:use-module (starlet attributes) #:export (snap)) @@ -39,15 +36,16 @@ out-state)) -(define (snap) - (make-transition - (incoming-state current-state clock) - (let ((overlay-state (blank-everything current-state))) - (state-for-each - (lambda (fix attr val) - (set-in-state! overlay-state - fix - attr - (lambda () val))) - incoming-state) - (values overlay-state 0)))) +(define (snap to-state) + (cue-part + to-state + (lambda (incoming-state current-state clock) + (let ((overlay-state (blank-everything current-state))) + (state-for-each + (lambda (fix attr val) + (set-in-state! overlay-state + fix + attr + (lambda () val))) + incoming-state) + (values overlay-state 0))))) |