From ec0e03a471a965291ac6fd24080bfb51904574c0 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sat, 8 Apr 2023 12:11:45 +0200 Subject: New transition effect syntax Instead of this: (cue 3 (lighting-state ...) (crossfade 3 5)) We now have this: (cue 3 (crossfade 3 5 (lighting-state ...))) This makes a simple snap blackout very succinct: (cue 6 (snap blackout)) --- guile/starlet/crossfade.scm | 41 ++++++++++---------- guile/starlet/cue-list.scm | 77 +++++++++---------------------------- guile/starlet/cue-part.scm | 35 +++++++++++++++++ guile/starlet/playback.scm | 8 ++-- guile/starlet/snap-transition.scm | 32 ++++++++------- guile/starlet/transition-effect.scm | 45 ---------------------- 6 files changed, 93 insertions(+), 145 deletions(-) create mode 100644 guile/starlet/cue-part.scm delete mode 100644 guile/starlet/transition-effect.scm (limited to 'guile') 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 +;; Copyright © 2020-2023 Thomas White ;; ;; 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 state transition) - cue-part? - (state get-cue-part-state - set-cue-part-state!) - (transition get-cue-part-transition)) - - (define-record-type (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/cue-part.scm b/guile/starlet/cue-part.scm new file mode 100644 index 0000000..e98e422 --- /dev/null +++ b/guile/starlet/cue-part.scm @@ -0,0 +1,35 @@ +;; +;; starlet/cue-part +;; +;; Copyright © 2020-2023 Thomas White +;; +;; This file is part of Starlet. +;; +;; Starlet is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +(define-module (starlet cue-part) + #:use-module (srfi srfi-9) + #:export (cue-part + + get-cue-part-state + get-cue-part-transition + set-cue-part-state!)) + + +(define-record-type + (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 +;; Copyright © 2021-2023 Thomas White ;; ;; This file is part of Starlet. ;; @@ -19,11 +19,8 @@ ;; along with this program. If not, see . ;; (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))))) diff --git a/guile/starlet/transition-effect.scm b/guile/starlet/transition-effect.scm deleted file mode 100644 index 43b7a6e..0000000 --- a/guile/starlet/transition-effect.scm +++ /dev/null @@ -1,45 +0,0 @@ -;; -;; starlet/transition-effect.scm -;; -;; Copyright © 2021-2022 Thomas White -;; -;; This file is part of Starlet. -;; -;; Starlet is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -(define-module (starlet transition-effect) - #:use-module (oop goops) - #:export ( - transition-effect? - transition-func - make-transition)) - - -(define-class () - (func - #:init-value #f - #:init-keyword #:func - #:getter transition-func)) - - -(define (transition-effect? a) - (is-a? a )) - - -(define-syntax make-transition - (syntax-rules () - ((_ (a b c) expr ...) - (make - #:func (lambda (a b c) - expr ...))))) -- cgit v1.2.3